sysutils.pp 28 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by Florian Klaempfl
  5. member of the Free Pascal development team
  6. Sysutils unit for OS/2
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. unit sysutils;
  14. interface
  15. {$MODE objfpc}
  16. { force ansistrings }
  17. {$H+}
  18. uses
  19. Dos;
  20. { Include platform independent interface part }
  21. {$i sysutilh.inc}
  22. implementation
  23. { Include platform independent implementation part }
  24. {$i sysutils.inc}
  25. {****************************************************************************
  26. System (imported) calls
  27. ****************************************************************************}
  28. (* "uses DosCalls" could not be used here due to type *)
  29. (* conflicts, so needed parts had to be redefined here). *)
  30. type
  31. TFileStatus = object
  32. end;
  33. PFileStatus = ^TFileStatus;
  34. TFileStatus0 = object (TFileStatus)
  35. DateCreation, {Date of file creation.}
  36. TimeCreation, {Time of file creation.}
  37. DateLastAccess, {Date of last access to file.}
  38. TimeLastAccess, {Time of last access to file.}
  39. DateLastWrite, {Date of last modification of file.}
  40. TimeLastWrite: word; {Time of last modification of file.}
  41. FileSize, {Size of file.}
  42. FileAlloc: longint; {Amount of space the file really
  43. occupies on disk.}
  44. end;
  45. PFileStatus0 = ^TFileStatus0;
  46. TFileStatus3 = object (TFileStatus)
  47. NextEntryOffset: longint; {Offset of next entry}
  48. DateCreation, {Date of file creation.}
  49. TimeCreation, {Time of file creation.}
  50. DateLastAccess, {Date of last access to file.}
  51. TimeLastAccess, {Time of last access to file.}
  52. DateLastWrite, {Date of last modification of file.}
  53. TimeLastWrite: word; {Time of last modification of file.}
  54. FileSize, {Size of file.}
  55. FileAlloc: longint; {Amount of space the file really
  56. occupies on disk.}
  57. AttrFile: longint; {Attributes of file.}
  58. end;
  59. PFileStatus3 = ^TFileStatus3;
  60. TFileFindBuf3 = object (TFileStatus3)
  61. Name: ShortString; {Also possible to use as ASCIIZ.
  62. The byte following the last string
  63. character is always zero.}
  64. end;
  65. PFileFindBuf3 = ^TFileFindBuf3;
  66. TFSInfo = record
  67. case word of
  68. 1:
  69. (File_Sys_ID,
  70. Sectors_Per_Cluster,
  71. Total_Clusters,
  72. Free_Clusters: longint;
  73. Bytes_Per_Sector: word);
  74. 2: {For date/time description,
  75. see file searching realted
  76. routines.}
  77. (Label_Date, {Date when volume label was created.}
  78. Label_Time: word; {Time when volume label was created.}
  79. VolumeLabel: ShortString); {Volume label. Can also be used
  80. as ASCIIZ, because the byte
  81. following the last character of
  82. the string is always zero.}
  83. end;
  84. PFSInfo = ^TFSInfo;
  85. TCountryCode=record
  86. Country, {Country to query info about (0=current).}
  87. CodePage: longint; {Code page to query info about (0=current).}
  88. end;
  89. PCountryCode=^TCountryCode;
  90. TTimeFmt = (Clock12, Clock24);
  91. TCountryInfo=record
  92. Country, CodePage: longint; {Country and codepage requested.}
  93. case byte of
  94. 0:
  95. (DateFormat: longint; {1=ddmmyy 2=yymmdd 3=mmddyy}
  96. CurrencyUnit: array [0..4] of char;
  97. ThousandSeparator: char; {Thousands separator.}
  98. Zero1: byte; {Always zero.}
  99. DecimalSeparator: char; {Decimals separator,}
  100. Zero2: byte;
  101. DateSeparator: char; {Date separator.}
  102. Zero3: byte;
  103. TimeSeparator: char; {Time separator.}
  104. Zero4: byte;
  105. CurrencyFormat, {Bit field:
  106. Bit 0: 0=indicator before value
  107. 1=indicator after value
  108. Bit 1: 1=insert space after
  109. indicator.
  110. Bit 2: 1=Ignore bit 0&1, replace
  111. decimal separator with
  112. indicator.}
  113. DecimalPlace: byte; {Number of decimal places used in
  114. currency indication.}
  115. TimeFormat: TTimeFmt; {12/24 hour.}
  116. Reserve1: array [0..1] of word;
  117. DataSeparator: char; {Data list separator}
  118. Zero5: byte;
  119. Reserve2: array [0..4] of word);
  120. 1:
  121. (fsDateFmt: longint; {1=ddmmyy 2=yymmdd 3=mmddyy}
  122. szCurrency: array [0..4] of char;
  123. {null terminated currency symbol}
  124. szThousandsSeparator: array [0..1] of char;
  125. {Thousands separator + #0}
  126. szDecimal: array [0..1] of char;
  127. {Decimals separator + #0}
  128. szDateSeparator: array [0..1] of char;
  129. {Date separator + #0}
  130. szTimeSeparator: array [0..1] of char;
  131. {Time separator + #0}
  132. fsCurrencyFmt, {Bit field:
  133. Bit 0: 0=indicator before value
  134. 1=indicator after value
  135. Bit 1: 1=insert space after
  136. indicator.
  137. Bit 2: 1=Ignore bit 0&1, replace
  138. decimal separator with
  139. indicator}
  140. cDecimalPlace: byte; {Number of decimal places used in
  141. currency indication}
  142. fsTimeFmt: byte; {0=12,1=24 hours}
  143. abReserved1: array [0..1] of word;
  144. szDataSeparator: array [0..1] of char;
  145. {Data list separator + #0}
  146. abReserved2: array [0..4] of word);
  147. end;
  148. PCountryInfo=^TCountryInfo;
  149. const
  150. ilStandard = 1;
  151. ilQueryEAsize = 2;
  152. ilQueryEAs = 3;
  153. ilQueryFullName = 5;
  154. {This is the correct way to call external assembler procedures.}
  155. procedure syscall;external name '___SYSCALL';
  156. function DosSetFileInfo (Handle, InfoLevel: longint; AFileStatus: PFileStatus;
  157. FileStatusLen: longint): longint; cdecl; external 'DOSCALLS' index 218;
  158. function DosQueryFSInfo (DiskNum, InfoLevel: longint; var Buffer: TFSInfo;
  159. BufLen: longint): longint; cdecl; external 'DOSCALLS' index 278;
  160. function DosQueryFileInfo (Handle, InfoLevel: longint;
  161. AFileStatus: PFileStatus; FileStatusLen: longint): longint; cdecl;
  162. external 'DOSCALLS' index 279;
  163. function DosScanEnv (Name: PChar; var Value: PChar): longint; cdecl;
  164. external 'DOSCALLS' index 227;
  165. function DosFindFirst (FileMask: PChar; var Handle: longint; Attrib: longint;
  166. AFileStatus: PFileStatus; FileStatusLen: cardinal;
  167. var Count: cardinal; InfoLevel: cardinal): longint; cdecl;
  168. external 'DOSCALLS' index 264;
  169. function DosFindNext (Handle: longint; AFileStatus: PFileStatus;
  170. FileStatusLen: cardinal; var Count: cardinal): longint; cdecl;
  171. external 'DOSCALLS' index 265;
  172. function DosFindClose (Handle: longint): longint; cdecl;
  173. external 'DOSCALLS' index 263;
  174. function DosQueryCtryInfo (Size: longint; var Country: TCountryCode;
  175. var Res: TCountryInfo; var ActualSize: longint): longint; cdecl;
  176. external 'NLS' index 5;
  177. function DosMapCase (Size: longint; var Country: TCountryCode;
  178. AString: PChar): longint; cdecl; external 'NLS' index 7;
  179. {****************************************************************************
  180. File Functions
  181. ****************************************************************************}
  182. const
  183. ofRead = $0000; {Open for reading}
  184. ofWrite = $0001; {Open for writing}
  185. ofReadWrite = $0002; {Open for reading/writing}
  186. doDenyRW = $0010; {DenyAll (no sharing)}
  187. faCreateNew = $00010000; {Create if file does not exist}
  188. faOpenReplace = $00040000; {Truncate if file exists}
  189. faCreate = $00050000; {Create if file does not exist, truncate otherwise}
  190. FindResvdMask = $00003737; {Allowed bits in attribute
  191. specification for DosFindFirst call.}
  192. {$ASMMODE INTEL}
  193. function FileOpen (const FileName: string; Mode: integer): longint;
  194. {$IFOPT H+}
  195. assembler;
  196. {$ELSE}
  197. var FN: string;
  198. begin
  199. FN := FileName + #0;
  200. {$ENDIF}
  201. asm
  202. mov eax, Mode
  203. (* DenyAll if sharing not specified. *)
  204. test eax, 112
  205. jnz @FOpen1
  206. or eax, 16
  207. @FOpen1:
  208. mov ecx, eax
  209. mov eax, 7F2Bh
  210. {$IFOPT H+}
  211. mov edx, FileName
  212. {$ELSE}
  213. lea edx, FN
  214. inc edx
  215. {$ENDIF}
  216. call syscall
  217. {$IFOPT H-}
  218. mov [ebp - 4], eax
  219. end;
  220. {$ENDIF}
  221. end;
  222. function FileCreate (const FileName: string): longint;
  223. {$IFOPT H+}
  224. assembler;
  225. {$ELSE}
  226. var FN: string;
  227. begin
  228. FN := FileName + #0;
  229. {$ENDIF}
  230. asm
  231. mov eax, 7F2Bh
  232. mov ecx, ofReadWrite or faCreate or doDenyRW (* Sharing to DenyAll *)
  233. {$IFOPT H+}
  234. mov edx, FileName
  235. {$ELSE}
  236. lea edx, FN
  237. inc edx
  238. {$ENDIF}
  239. call syscall
  240. {$IFOPT H-}
  241. mov [ebp - 4], eax
  242. end;
  243. {$ENDIF}
  244. end;
  245. Function FileCreate (Const FileName : String; Mode:longint) : Longint;
  246. begin
  247. FileCreate:=FileCreate(FileName);
  248. end;
  249. function FileRead (Handle: longint; var Buffer; Count: longint): longint;
  250. assembler;
  251. asm
  252. mov eax, 3F00h
  253. mov ebx, Handle
  254. mov ecx, Count
  255. mov edx, Buffer
  256. call syscall
  257. jnc @FReadEnd
  258. mov eax, -1
  259. @FReadEnd:
  260. end;
  261. function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
  262. assembler;
  263. asm
  264. mov eax, 4000h
  265. mov ebx, Handle
  266. mov ecx, Count
  267. mov edx, Buffer
  268. call syscall
  269. jnc @FWriteEnd
  270. mov eax, -1
  271. @FWriteEnd:
  272. end;
  273. function FileSeek (Handle, FOffset, Origin: longint): longint; assembler;
  274. asm
  275. mov eax, Origin
  276. mov ah, 42h
  277. mov ebx, Handle
  278. mov edx, FOffset
  279. call syscall
  280. jnc @FSeekEnd
  281. mov eax, -1
  282. @FSeekEnd:
  283. end;
  284. Function FileSeek (Handle : Longint; FOffset,Origin : Int64) : Int64;
  285. begin
  286. {$warning need to add 64bit call }
  287. Result:=FileSeek(Handle,Longint(Foffset),Longint(Origin));
  288. end;
  289. procedure FileClose (Handle: longint);
  290. begin
  291. if (Handle > 4) or (os_mode = osOS2) and (Handle > 2) then
  292. asm
  293. mov eax, 3E00h
  294. mov ebx, Handle
  295. call syscall
  296. end;
  297. end;
  298. function FileTruncate (Handle, Size: longint): boolean; assembler;
  299. asm
  300. mov eax, 7F25h
  301. mov ebx, Handle
  302. mov edx, Size
  303. call syscall
  304. jc @FTruncEnd
  305. mov eax, 4202h
  306. mov ebx, Handle
  307. mov edx, 0
  308. call syscall
  309. mov eax, 0
  310. jnc @FTruncEnd
  311. dec eax
  312. @FTruncEnd:
  313. end;
  314. function FileAge (const FileName: string): longint;
  315. var Handle: longint;
  316. begin
  317. Handle := FileOpen (FileName, 0);
  318. if Handle <> -1 then
  319. begin
  320. Result := FileGetDate (Handle);
  321. FileClose (Handle);
  322. end
  323. else
  324. Result := -1;
  325. end;
  326. function FileExists (const FileName: string): boolean;
  327. {$IFOPT H+}
  328. assembler;
  329. {$ELSE}
  330. var FN: string;
  331. begin
  332. FN := FileName + #0;
  333. {$ENDIF}
  334. asm
  335. mov ax, 4300h
  336. {$IFOPT H+}
  337. mov edx, FileName
  338. {$ELSE}
  339. lea edx, FN
  340. inc edx
  341. {$ENDIF}
  342. call syscall
  343. mov eax, 0
  344. jc @FExistsEnd
  345. test cx, 18h
  346. jnz @FExistsEnd
  347. inc eax
  348. @FExistsEnd:
  349. {$IFOPT H-}
  350. end;
  351. {$ENDIF}
  352. end;
  353. type TRec = record
  354. T, D: word;
  355. end;
  356. PSearchRec = ^SearchRec;
  357. function FindFirst (const Path: string; Attr: longint; var Rslt: TSearchRec): longint;
  358. var SR: PSearchRec;
  359. FStat: PFileFindBuf3;
  360. Count: cardinal;
  361. Err: longint;
  362. begin
  363. if os_mode = osOS2 then
  364. begin
  365. New (FStat);
  366. Rslt.FindHandle := $FFFFFFFF;
  367. Count := 1;
  368. Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
  369. Attr and FindResvdMask, FStat, SizeOf (FStat^), Count,
  370. ilStandard);
  371. if (Err = 0) and (Count = 0) then Err := 18;
  372. FindFirst := -Err;
  373. if Err = 0 then
  374. begin
  375. Rslt.Name := FStat^.Name;
  376. Rslt.Size := FStat^.FileSize;
  377. Rslt.Attr := FStat^.AttrFile;
  378. Rslt.ExcludeAttr := 0;
  379. TRec (Rslt.Time).T := FStat^.TimeLastWrite;
  380. TRec (Rslt.Time).D := FStat^.DateLastWrite;
  381. end;
  382. Dispose (FStat);
  383. end
  384. else
  385. begin
  386. Err := DOS.DosError;
  387. GetMem (SR, SizeOf (SearchRec));
  388. Rslt.FindHandle := longint(SR);
  389. DOS.FindFirst (Path, Attr, SR^);
  390. FindFirst := -DOS.DosError;
  391. if DosError = 0 then
  392. begin
  393. Rslt.Time := SR^.Time;
  394. Rslt.Size := SR^.Size;
  395. Rslt.Attr := SR^.Attr;
  396. Rslt.ExcludeAttr := 0;
  397. Rslt.Name := SR^.Name;
  398. end;
  399. DOS.DosError := Err;
  400. end;
  401. end;
  402. function FindNext (var Rslt: TSearchRec): longint;
  403. var SR: PSearchRec;
  404. FStat: PFileFindBuf3;
  405. Count: cardinal;
  406. Err: longint;
  407. begin
  408. if os_mode = osOS2 then
  409. begin
  410. New (FStat);
  411. Count := 1;
  412. Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^),
  413. Count);
  414. if (Err = 0) and (Count = 0) then Err := 18;
  415. FindNext := -Err;
  416. if Err = 0 then
  417. begin
  418. Rslt.Name := FStat^.Name;
  419. Rslt.Size := FStat^.FileSize;
  420. Rslt.Attr := FStat^.AttrFile;
  421. Rslt.ExcludeAttr := 0;
  422. TRec (Rslt.Time).T := FStat^.TimeLastWrite;
  423. TRec (Rslt.Time).D := FStat^.DateLastWrite;
  424. end;
  425. Dispose (FStat);
  426. end
  427. else
  428. begin
  429. SR := PSearchRec (Rslt.FindHandle);
  430. if SR <> nil then
  431. begin
  432. DOS.FindNext (SR^);
  433. FindNext := -DosError;
  434. if DosError = 0 then
  435. begin
  436. Rslt.Time := SR^.Time;
  437. Rslt.Size := SR^.Size;
  438. Rslt.Attr := SR^.Attr;
  439. Rslt.ExcludeAttr := 0;
  440. Rslt.Name := SR^.Name;
  441. end;
  442. end;
  443. end;
  444. end;
  445. procedure FindClose (var F: TSearchrec);
  446. var SR: PSearchRec;
  447. begin
  448. if os_mode = osOS2 then
  449. begin
  450. DosFindClose (F.FindHandle);
  451. end
  452. else
  453. begin
  454. SR := PSearchRec (F.FindHandle);
  455. DOS.FindClose (SR^);
  456. FreeMem (SR, SizeOf (SearchRec));
  457. end;
  458. F.FindHandle := 0;
  459. end;
  460. function FileGetDate (Handle: longint): longint; assembler;
  461. asm
  462. mov ax, 5700h
  463. mov ebx, Handle
  464. call syscall
  465. mov eax, -1
  466. jc @FGetDateEnd
  467. mov ax, dx
  468. shld eax, ecx, 16
  469. @FGetDateEnd:
  470. end;
  471. function FileSetDate (Handle, Age: longint): longint;
  472. var FStat: PFileStatus0;
  473. RC: longint;
  474. begin
  475. if os_mode = osOS2 then
  476. begin
  477. New (FStat);
  478. RC := DosQueryFileInfo (Handle, ilStandard, FStat,
  479. SizeOf (FStat^));
  480. if RC <> 0 then
  481. FileSetDate := -1
  482. else
  483. begin
  484. FStat^.DateLastAccess := Hi (Age);
  485. FStat^.DateLastWrite := Hi (Age);
  486. FStat^.TimeLastAccess := Lo (Age);
  487. FStat^.TimeLastWrite := Lo (Age);
  488. RC := DosSetFileInfo (Handle, ilStandard, FStat,
  489. SizeOf (FStat^));
  490. if RC <> 0 then
  491. FileSetDate := -1
  492. else
  493. FileSetDate := 0;
  494. end;
  495. Dispose (FStat);
  496. end
  497. else
  498. asm
  499. mov ax, 5701h
  500. mov ebx, Handle
  501. mov cx, word ptr [Age]
  502. mov dx, word ptr [Age + 2]
  503. call syscall
  504. jnc @FSetDateEnd
  505. mov eax, -1
  506. @FSetDateEnd:
  507. mov [ebp - 4], eax
  508. end;
  509. end;
  510. function FileGetAttr (const FileName: string): longint;
  511. {$IFOPT H+}
  512. assembler;
  513. {$ELSE}
  514. var FN: string;
  515. begin
  516. FN := FileName + #0;
  517. {$ENDIF}
  518. asm
  519. mov ax, 4300h
  520. {$IFOPT H+}
  521. mov edx, FileName
  522. {$ELSE}
  523. lea edx, FN
  524. inc edx
  525. {$ENDIF}
  526. call syscall
  527. jnc @FGetAttrEnd
  528. mov eax, -1
  529. @FGetAttrEnd:
  530. {$IFOPT H-}
  531. mov [ebp - 4], eax
  532. end;
  533. {$ENDIF}
  534. end;
  535. function FileSetAttr (const Filename: string; Attr: longint): longint;
  536. {$IFOPT H+}
  537. assembler;
  538. {$ELSE}
  539. var FN: string;
  540. begin
  541. FN := FileName + #0;
  542. {$ENDIF}
  543. asm
  544. mov ax, 4301h
  545. mov ecx, Attr
  546. {$IFOPT H+}
  547. mov edx, FileName
  548. {$ELSE}
  549. lea edx, FN
  550. inc edx
  551. {$ENDIF}
  552. call syscall
  553. mov eax, 0
  554. jnc @FSetAttrEnd
  555. mov eax, -1
  556. @FSetAttrEnd:
  557. {$IFOPT H-}
  558. mov [ebp - 4], eax
  559. end;
  560. {$ENDIF}
  561. end;
  562. function DeleteFile (const FileName: string): boolean;
  563. {$IFOPT H+}
  564. assembler;
  565. {$ELSE}
  566. var FN: string;
  567. begin
  568. FN := FileName + #0;
  569. {$ENDIF}
  570. asm
  571. mov ax, 4100h
  572. {$IFOPT H+}
  573. mov edx, FileName
  574. {$ELSE}
  575. lea edx, FN
  576. inc edx
  577. {$ENDIF}
  578. call syscall
  579. mov eax, 0
  580. jc @FDeleteEnd
  581. inc eax
  582. @FDeleteEnd:
  583. {$IFOPT H-}
  584. mov [ebp - 4], eax
  585. end;
  586. {$ENDIF}
  587. end;
  588. function RenameFile (const OldName, NewName: string): boolean;
  589. {$IFOPT H+}
  590. assembler;
  591. {$ELSE}
  592. var FN1, FN2: string;
  593. begin
  594. FN1 := OldName + #0;
  595. FN2 := NewName + #0;
  596. {$ENDIF}
  597. asm
  598. mov ax, 5600h
  599. {$IFOPT H+}
  600. mov edx, OldName
  601. mov edi, NewName
  602. {$ELSE}
  603. lea edx, FN1
  604. inc edx
  605. lea edi, FN2
  606. inc edi
  607. {$ENDIF}
  608. call syscall
  609. mov eax, 0
  610. jc @FRenameEnd
  611. inc eax
  612. @FRenameEnd:
  613. {$IFOPT H-}
  614. mov [ebp - 4], eax
  615. end;
  616. {$ENDIF}
  617. end;
  618. {****************************************************************************
  619. Disk Functions
  620. ****************************************************************************}
  621. {$ASMMODE ATT}
  622. function DiskFree (Drive: byte): int64;
  623. var FI: TFSinfo;
  624. RC: longint;
  625. begin
  626. if (os_mode = osDOS) or (os_mode = osDPMI) then
  627. {Function 36 is not supported in OS/2.}
  628. asm
  629. movb Drive,%dl
  630. movb $0x36,%ah
  631. call syscall
  632. cmpw $-1,%ax
  633. je .LDISKFREE1
  634. mulw %cx
  635. mulw %bx
  636. shll $16,%edx
  637. movw %ax,%dx
  638. movl $0,%eax
  639. xchgl %edx,%eax
  640. leave
  641. ret
  642. .LDISKFREE1:
  643. cltd
  644. leave
  645. ret
  646. end
  647. else
  648. {In OS/2, we use the filesystem information.}
  649. begin
  650. RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
  651. if RC = 0 then
  652. DiskFree := int64 (FI.Free_Clusters) *
  653. int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
  654. else
  655. DiskFree := -1;
  656. end;
  657. end;
  658. function DiskSize (Drive: byte): int64;
  659. var FI: TFSinfo;
  660. RC: longint;
  661. begin
  662. if (os_mode = osDOS) or (os_mode = osDPMI) then
  663. {Function 36 is not supported in OS/2.}
  664. asm
  665. movb Drive,%dl
  666. movb $0x36,%ah
  667. call syscall
  668. movw %dx,%bx
  669. cmpw $-1,%ax
  670. je .LDISKSIZE1
  671. mulw %cx
  672. mulw %bx
  673. shll $16,%edx
  674. movw %ax,%dx
  675. movl $0,%eax
  676. xchgl %edx,%eax
  677. leave
  678. ret
  679. .LDISKSIZE1:
  680. cltd
  681. leave
  682. ret
  683. end
  684. else
  685. {In OS/2, we use the filesystem information.}
  686. begin
  687. RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
  688. if RC = 0 then
  689. DiskSize := int64 (FI.Total_Clusters) *
  690. int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
  691. else
  692. DiskSize := -1;
  693. end;
  694. end;
  695. function GetCurrentDir: string;
  696. begin
  697. GetDir (0, Result);
  698. end;
  699. function SetCurrentDir (const NewDir: string): boolean;
  700. begin
  701. {$I-}
  702. ChDir (NewDir);
  703. Result := (IOResult = 0);
  704. {$I+}
  705. end;
  706. function CreateDir (const NewDir: string): boolean;
  707. begin
  708. {$I-}
  709. MkDir (NewDir);
  710. Result := (IOResult = 0);
  711. {$I+}
  712. end;
  713. function RemoveDir (const Dir: string): boolean;
  714. begin
  715. {$I-}
  716. RmDir (Dir);
  717. Result := (IOResult = 0);
  718. {$I+}
  719. end;
  720. {$ASMMODE INTEL}
  721. function DirectoryExists (const Directory: string): boolean;
  722. {$IFOPT H+}
  723. assembler;
  724. {$ELSE}
  725. var FN: string;
  726. begin
  727. FN := Directory + #0;
  728. {$ENDIF}
  729. asm
  730. mov ax, 4300h
  731. {$IFOPT H+}
  732. mov edx, Directory
  733. {$ELSE}
  734. lea edx, FN
  735. inc edx
  736. {$ENDIF}
  737. call syscall
  738. mov eax, 0
  739. jc @FExistsEnd
  740. test cx, 10h
  741. jz @FExistsEnd
  742. inc eax
  743. @FExistsEnd:
  744. {$IFOPT H-}
  745. end;
  746. {$ENDIF}
  747. end;
  748. {****************************************************************************
  749. Time Functions
  750. ****************************************************************************}
  751. procedure GetLocalTime (var SystemTime: TSystemTime); assembler;
  752. asm
  753. (* Expects the default record alignment (word)!!! *)
  754. mov ah, 2Ah
  755. call syscall
  756. mov edi, SystemTime
  757. mov ax, cx
  758. stosw
  759. xor eax, eax
  760. mov al, dl
  761. shl eax, 16
  762. mov al, dh
  763. stosd
  764. push edi
  765. mov ah, 2Ch
  766. call syscall
  767. pop edi
  768. xor eax, eax
  769. mov al, cl
  770. shl eax, 16
  771. mov al, ch
  772. stosd
  773. mov al, dl
  774. shl eax, 16
  775. mov al, dh
  776. stosd
  777. end;
  778. {$asmmode default}
  779. {****************************************************************************
  780. Misc Functions
  781. ****************************************************************************}
  782. procedure Beep;
  783. begin
  784. end;
  785. {****************************************************************************
  786. Locale Functions
  787. ****************************************************************************}
  788. procedure InitAnsi;
  789. var I: byte;
  790. Country: TCountryCode;
  791. begin
  792. for I := 0 to 255 do
  793. UpperCaseTable [I] := Chr (I);
  794. Move (UpperCaseTable, LowerCaseTable, SizeOf (UpperCaseTable));
  795. if os_mode = osOS2 then
  796. begin
  797. FillChar (Country, SizeOf (Country), 0);
  798. DosMapCase (SizeOf (UpperCaseTable), Country, @UpperCaseTable);
  799. end
  800. else
  801. begin
  802. (* !!! TODO: DOS/DPMI mode support!!! *)
  803. end;
  804. for I := 0 to 255 do
  805. if UpperCaseTable [I] <> Chr (I) then
  806. LowerCaseTable [Ord (UpperCaseTable [I])] := Chr (I);
  807. end;
  808. procedure InitInternational;
  809. var Country: TCountryCode;
  810. CtryInfo: TCountryInfo;
  811. Size: longint;
  812. RC: longint;
  813. begin
  814. Size := 0;
  815. FillChar (Country, SizeOf (Country), 0);
  816. FillChar (CtryInfo, SizeOf (CtryInfo), 0);
  817. RC := DosQueryCtryInfo (SizeOf (CtryInfo), Country, CtryInfo, Size);
  818. if RC = 0 then
  819. begin
  820. DateSeparator := CtryInfo.DateSeparator;
  821. case CtryInfo.DateFormat of
  822. 1: begin
  823. ShortDateFormat := 'd/m/y';
  824. LongDateFormat := 'dd" "mmmm" "yyyy';
  825. end;
  826. 2: begin
  827. ShortDateFormat := 'y/m/d';
  828. LongDateFormat := 'yyyy" "mmmm" "dd';
  829. end;
  830. 3: begin
  831. ShortDateFormat := 'm/d/y';
  832. LongDateFormat := 'mmmm" "dd" "yyyy';
  833. end;
  834. end;
  835. TimeSeparator := CtryInfo.TimeSeparator;
  836. DecimalSeparator := CtryInfo.DecimalSeparator;
  837. ThousandSeparator := CtryInfo.ThousandSeparator;
  838. CurrencyFormat := CtryInfo.CurrencyFormat;
  839. CurrencyString := PChar (CtryInfo.CurrencyUnit);
  840. end;
  841. InitAnsi;
  842. end;
  843. function SysErrorMessage(ErrorCode: Integer): String;
  844. begin
  845. Result:=Format(SUnknownErrorCode,[ErrorCode]);
  846. end;
  847. {****************************************************************************
  848. OS Utils
  849. ****************************************************************************}
  850. Function GetEnvironmentVariable(Const EnvVar : String) : String;
  851. begin
  852. GetEnvironmentVariable := StrPas (GetEnvPChar (EnvVar));
  853. end;
  854. {****************************************************************************
  855. Initialization code
  856. ****************************************************************************}
  857. Initialization
  858. InitExceptions; { Initialize exceptions. OS independent }
  859. InitInternational; { Initialize internationalization settings }
  860. Finalization
  861. DoneExceptions;
  862. end.
  863. {
  864. $Log$
  865. Revision 1.25 2003-03-29 19:14:16 yuri
  866. * Directoryexists function header changed back.
  867. Revision 1.24 2003/03/29 18:53:10 yuri
  868. * Fixed DirectoryExists function header
  869. Revision 1.23 2003/03/29 15:01:20 hajny
  870. + DirectoryExists added for main branch OS/2 too
  871. Revision 1.22 2003/03/01 21:19:14 hajny
  872. * FileClose bug fixed
  873. Revision 1.21 2003/01/04 16:25:08 hajny
  874. * modified to make use of the common GetEnv code
  875. Revision 1.20 2003/01/03 20:41:04 peter
  876. * FileCreate(string,mode) overload added
  877. Revision 1.19 2002/11/18 19:51:00 hajny
  878. * another bunch of type corrections
  879. Revision 1.18 2002/09/23 17:42:37 hajny
  880. * AnsiString to PChar typecast
  881. Revision 1.17 2002/09/07 16:01:25 peter
  882. * old logs removed and tabs fixed
  883. Revision 1.16 2002/07/11 16:00:05 hajny
  884. * FindFirst fix (invalid attribute bits masked out)
  885. Revision 1.15 2002/01/25 16:23:03 peter
  886. * merged filesearch() fix
  887. }