sysutils.pp 28 KB

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