sysutils.pp 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927
  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 EMX
  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. uses
  24. sysconst;
  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: cardinal; {Amount of space the file really
  45. occupies on disk.}
  46. end;
  47. PFileStatus0 = ^TFileStatus0;
  48. TFileStatus3 = object (TFileStatus)
  49. NextEntryOffset: cardinal; {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: cardinal; {Amount of space the file really
  58. occupies on disk.}
  59. AttrFile: cardinal; {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: cardinal;
  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: cardinal; {Code page to query info about (0=current).}
  90. end;
  91. PCountryCode=^TCountryCode;
  92. TTimeFmt = (Clock12, Clock24);
  93. TCountryInfo=record
  94. Country, CodePage: cardinal; {Country and codepage requested.}
  95. case byte of
  96. 0:
  97. (DateFormat: cardinal; {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: cardinal; {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: longint; InfoLevel: cardinal; AFileStatus: PFileStatus;
  159. FileStatusLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 218;
  160. function DosQueryFSInfo (DiskNum, InfoLevel: cardinal; var Buffer: TFSInfo;
  161. BufLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 278;
  162. function DosQueryFileInfo (Handle: longint; InfoLevel: cardinal;
  163. AFileStatus: PFileStatus; FileStatusLen: cardinal): cardinal; cdecl;
  164. external 'DOSCALLS' index 279;
  165. function DosScanEnv (Name: PChar; var Value: PChar): cardinal; cdecl;
  166. external 'DOSCALLS' index 227;
  167. function DosFindFirst (FileMask: PChar; var Handle: longint; Attrib: cardinal;
  168. AFileStatus: PFileStatus; FileStatusLen: cardinal;
  169. var Count: cardinal; InfoLevel: cardinal): cardinal; cdecl;
  170. external 'DOSCALLS' index 264;
  171. function DosFindNext (Handle: longint; AFileStatus: PFileStatus;
  172. FileStatusLen: cardinal; var Count: cardinal): cardinal; cdecl;
  173. external 'DOSCALLS' index 265;
  174. function DosFindClose (Handle: longint): cardinal; cdecl;
  175. external 'DOSCALLS' index 263;
  176. function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode;
  177. var Res: TCountryInfo; var ActualSize: cardinal): cardinal; cdecl;
  178. external 'NLS' index 5;
  179. function DosMapCase (Size: cardinal; var Country: TCountryCode;
  180. AString: PChar): cardinal; 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; assembler;
  196. asm
  197. push ebx
  198. mov eax, Mode
  199. (* DenyAll if sharing not specified. *)
  200. test eax, 112
  201. jnz @FOpen1
  202. or eax, 16
  203. @FOpen1:
  204. mov ecx, eax
  205. mov eax, 7F2Bh
  206. mov edx, FileName
  207. call syscall
  208. pop ebx
  209. end {['eax', 'ebx', 'ecx', 'edx']};
  210. function FileCreate (const FileName: string): longint; assembler;
  211. asm
  212. push ebx
  213. mov eax, 7F2Bh
  214. mov ecx, ofReadWrite or faCreate or doDenyRW (* Sharing to DenyAll *)
  215. mov edx, FileName
  216. call syscall
  217. pop ebx
  218. end {['eax', 'ebx', 'ecx', 'edx']};
  219. function FileCreate (const FileName: string; Mode: longint): longint;
  220. begin
  221. FileCreate:=FileCreate(FileName);
  222. end;
  223. function FileRead (Handle: longint; var Buffer; Count: longint): longint;
  224. assembler;
  225. asm
  226. push ebx
  227. mov eax, 3F00h
  228. mov ebx, Handle
  229. mov ecx, Count
  230. mov edx, Buffer
  231. call syscall
  232. jnc @FReadEnd
  233. mov eax, -1
  234. @FReadEnd:
  235. pop ebx
  236. end {['eax', 'ebx', 'ecx', 'edx']};
  237. function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
  238. assembler;
  239. asm
  240. push ebx
  241. mov eax, 4000h
  242. mov ebx, Handle
  243. mov ecx, Count
  244. mov edx, Buffer
  245. call syscall
  246. jnc @FWriteEnd
  247. mov eax, -1
  248. @FWriteEnd:
  249. pop ebx
  250. end {['eax', 'ebx', 'ecx', 'edx']};
  251. function FileSeek (Handle, FOffset, Origin: longint): longint; assembler;
  252. asm
  253. push ebx
  254. mov eax, Origin
  255. mov ah, 42h
  256. mov ebx, Handle
  257. mov edx, FOffset
  258. call syscall
  259. jnc @FSeekEnd
  260. mov eax, -1
  261. @FSeekEnd:
  262. pop ebx
  263. end {['eax', 'ebx', 'edx']};
  264. function FileSeek (Handle: longint; FOffset, Origin: Int64): Int64;
  265. begin
  266. {$warning need to add 64bit call }
  267. Result:=FileSeek(Handle,Longint(Foffset),Longint(Origin));
  268. end;
  269. procedure FileClose (Handle: longint);
  270. begin
  271. if (Handle > 4) or ((os_mode = osOS2) and (Handle > 2)) then
  272. asm
  273. push ebx
  274. mov eax, 3E00h
  275. mov ebx, Handle
  276. call syscall
  277. pop ebx
  278. end ['eax'];
  279. end;
  280. function FileTruncate (Handle, Size: longint): boolean; assembler;
  281. asm
  282. push ebx
  283. mov eax, 7F25h
  284. mov ebx, Handle
  285. mov edx, Size
  286. call syscall
  287. jc @FTruncEnd
  288. mov eax, 4202h
  289. mov ebx, Handle
  290. mov edx, 0
  291. call syscall
  292. mov eax, 0
  293. jnc @FTruncEnd
  294. dec eax
  295. @FTruncEnd:
  296. pop ebx
  297. end {['eax', 'ebx', 'ecx', 'edx']};
  298. function FileAge (const FileName: string): longint;
  299. var Handle: longint;
  300. begin
  301. Handle := FileOpen (FileName, 0);
  302. if Handle <> -1 then
  303. begin
  304. Result := FileGetDate (Handle);
  305. FileClose (Handle);
  306. end
  307. else
  308. Result := -1;
  309. end;
  310. function FileExists (const FileName: string): boolean; assembler;
  311. asm
  312. mov ax, 4300h
  313. mov edx, FileName
  314. call syscall
  315. mov eax, 0
  316. jc @FExistsEnd
  317. test cx, 18h
  318. jnz @FExistsEnd
  319. inc eax
  320. @FExistsEnd:
  321. end {['eax', 'ecx', 'edx']};
  322. type TRec = record
  323. T, D: word;
  324. end;
  325. PSearchRec = ^SearchRec;
  326. function FindFirst (const Path: string; Attr: longint; var Rslt: TSearchRec): longint;
  327. var SR: PSearchRec;
  328. FStat: PFileFindBuf3;
  329. Count: cardinal;
  330. Err: cardinal;
  331. begin
  332. if os_mode = osOS2 then
  333. begin
  334. New (FStat);
  335. Rslt.FindHandle := $FFFFFFFF;
  336. Count := 1;
  337. Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
  338. Attr and FindResvdMask, FStat, SizeOf (FStat^), Count,
  339. ilStandard);
  340. if (Err = 0) and (Count = 0) then Err := 18;
  341. FindFirst := -Err;
  342. if Err = 0 then
  343. begin
  344. Rslt.Name := FStat^.Name;
  345. Rslt.Size := FStat^.FileSize;
  346. Rslt.Attr := FStat^.AttrFile;
  347. Rslt.ExcludeAttr := 0;
  348. TRec (Rslt.Time).T := FStat^.TimeLastWrite;
  349. TRec (Rslt.Time).D := FStat^.DateLastWrite;
  350. end;
  351. Dispose (FStat);
  352. end
  353. else
  354. begin
  355. Err := DOS.DosError;
  356. GetMem (SR, SizeOf (SearchRec));
  357. Rslt.FindHandle := longint(SR);
  358. DOS.FindFirst (Path, Attr, SR^);
  359. FindFirst := -DOS.DosError;
  360. if DosError = 0 then
  361. begin
  362. Rslt.Time := SR^.Time;
  363. Rslt.Size := SR^.Size;
  364. Rslt.Attr := SR^.Attr;
  365. Rslt.ExcludeAttr := 0;
  366. Rslt.Name := SR^.Name;
  367. end;
  368. DOS.DosError := Err;
  369. end;
  370. end;
  371. function FindNext (var Rslt: TSearchRec): longint;
  372. var SR: PSearchRec;
  373. FStat: PFileFindBuf3;
  374. Count: cardinal;
  375. Err: cardinal;
  376. begin
  377. if os_mode = osOS2 then
  378. begin
  379. New (FStat);
  380. Count := 1;
  381. Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^),
  382. Count);
  383. if (Err = 0) and (Count = 0) then Err := 18;
  384. FindNext := -Err;
  385. if Err = 0 then
  386. begin
  387. Rslt.Name := FStat^.Name;
  388. Rslt.Size := FStat^.FileSize;
  389. Rslt.Attr := FStat^.AttrFile;
  390. Rslt.ExcludeAttr := 0;
  391. TRec (Rslt.Time).T := FStat^.TimeLastWrite;
  392. TRec (Rslt.Time).D := FStat^.DateLastWrite;
  393. end;
  394. Dispose (FStat);
  395. end
  396. else
  397. begin
  398. SR := PSearchRec (Rslt.FindHandle);
  399. if SR <> nil then
  400. begin
  401. DOS.FindNext (SR^);
  402. FindNext := -DosError;
  403. if DosError = 0 then
  404. begin
  405. Rslt.Time := SR^.Time;
  406. Rslt.Size := SR^.Size;
  407. Rslt.Attr := SR^.Attr;
  408. Rslt.ExcludeAttr := 0;
  409. Rslt.Name := SR^.Name;
  410. end;
  411. end;
  412. end;
  413. end;
  414. procedure FindClose (var F: TSearchrec);
  415. var SR: PSearchRec;
  416. begin
  417. if os_mode = osOS2 then
  418. begin
  419. DosFindClose (F.FindHandle);
  420. end
  421. else
  422. begin
  423. SR := PSearchRec (F.FindHandle);
  424. DOS.FindClose (SR^);
  425. FreeMem (SR, SizeOf (SearchRec));
  426. end;
  427. F.FindHandle := 0;
  428. end;
  429. function FileGetDate (Handle: longint): longint; assembler;
  430. asm
  431. push ebx
  432. mov ax, 5700h
  433. mov ebx, Handle
  434. call syscall
  435. mov eax, -1
  436. jc @FGetDateEnd
  437. mov ax, dx
  438. shld eax, ecx, 16
  439. @FGetDateEnd:
  440. pop ebx
  441. end {['eax', 'ebx', 'ecx', 'edx']};
  442. function FileSetDate (Handle, Age: longint): longint;
  443. var FStat: PFileStatus0;
  444. RC: cardinal;
  445. begin
  446. if os_mode = osOS2 then
  447. begin
  448. New (FStat);
  449. RC := DosQueryFileInfo (Handle, ilStandard, FStat,
  450. SizeOf (FStat^));
  451. if RC <> 0 then
  452. FileSetDate := -1
  453. else
  454. begin
  455. FStat^.DateLastAccess := Hi (Age);
  456. FStat^.DateLastWrite := Hi (Age);
  457. FStat^.TimeLastAccess := Lo (Age);
  458. FStat^.TimeLastWrite := Lo (Age);
  459. RC := DosSetFileInfo (Handle, ilStandard, FStat,
  460. SizeOf (FStat^));
  461. if RC <> 0 then
  462. FileSetDate := -1
  463. else
  464. FileSetDate := 0;
  465. end;
  466. Dispose (FStat);
  467. end
  468. else
  469. asm
  470. push ebx
  471. mov ax, 5701h
  472. mov ebx, Handle
  473. mov cx, word ptr [Age]
  474. mov dx, word ptr [Age + 2]
  475. call syscall
  476. jnc @FSetDateEnd
  477. mov eax, -1
  478. @FSetDateEnd:
  479. mov Result, eax
  480. pop ebx
  481. end ['eax', 'ecx', 'edx'];
  482. end;
  483. function FileGetAttr (const FileName: string): longint; assembler;
  484. asm
  485. mov ax, 4300h
  486. mov edx, FileName
  487. call syscall
  488. jnc @FGetAttrEnd
  489. mov eax, -1
  490. @FGetAttrEnd:
  491. end {['eax', 'edx']};
  492. function FileSetAttr (const Filename: string; Attr: longint): longint; assembler;
  493. asm
  494. mov ax, 4301h
  495. mov ecx, Attr
  496. mov edx, FileName
  497. call syscall
  498. mov eax, 0
  499. jnc @FSetAttrEnd
  500. mov eax, -1
  501. @FSetAttrEnd:
  502. end {['eax', 'ecx', 'edx']};
  503. function DeleteFile (const FileName: string): boolean; assembler;
  504. asm
  505. mov ax, 4100h
  506. mov edx, FileName
  507. call syscall
  508. mov eax, 0
  509. jc @FDeleteEnd
  510. inc eax
  511. @FDeleteEnd:
  512. end {['eax', 'edx']};
  513. function RenameFile (const OldName, NewName: string): boolean; assembler;
  514. asm
  515. push edi
  516. mov ax, 5600h
  517. mov edx, OldName
  518. mov edi, NewName
  519. call syscall
  520. mov eax, 0
  521. jc @FRenameEnd
  522. inc eax
  523. @FRenameEnd:
  524. pop edi
  525. end {['eax', 'edx', 'edi']};
  526. {****************************************************************************
  527. Disk Functions
  528. ****************************************************************************}
  529. {$ASMMODE ATT}
  530. function DiskFree (Drive: byte): int64;
  531. var FI: TFSinfo;
  532. RC: cardinal;
  533. begin
  534. if (os_mode = osDOS) or (os_mode = osDPMI) then
  535. {Function 36 is not supported in OS/2.}
  536. asm
  537. pushl %ebx
  538. movb Drive,%dl
  539. movb $0x36,%ah
  540. call syscall
  541. cmpw $-1,%ax
  542. je .LDISKFREE1
  543. mulw %cx
  544. mulw %bx
  545. shll $16,%edx
  546. movw %ax,%dx
  547. movl $0,%eax
  548. xchgl %edx,%eax
  549. jmp .LDISKFREE2
  550. .LDISKFREE1:
  551. cltd
  552. .LDISKFREE2:
  553. popl %ebx
  554. leave
  555. ret
  556. end
  557. else
  558. {In OS/2, we use the filesystem information.}
  559. begin
  560. RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
  561. if RC = 0 then
  562. DiskFree := int64 (FI.Free_Clusters) *
  563. int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
  564. else
  565. DiskFree := -1;
  566. end;
  567. end;
  568. function DiskSize (Drive: byte): int64;
  569. var FI: TFSinfo;
  570. RC: cardinal;
  571. begin
  572. if (os_mode = osDOS) or (os_mode = osDPMI) then
  573. {Function 36 is not supported in OS/2.}
  574. asm
  575. pushl %ebx
  576. movb Drive,%dl
  577. movb $0x36,%ah
  578. call syscall
  579. movw %dx,%bx
  580. cmpw $-1,%ax
  581. je .LDISKSIZE1
  582. mulw %cx
  583. mulw %bx
  584. shll $16,%edx
  585. movw %ax,%dx
  586. movl $0,%eax
  587. xchgl %edx,%eax
  588. jmp .LDISKSIZE2
  589. .LDISKSIZE1:
  590. cltd
  591. .LDISKSIZE2:
  592. popl %ebx
  593. leave
  594. ret
  595. end
  596. else
  597. {In OS/2, we use the filesystem information.}
  598. begin
  599. RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
  600. if RC = 0 then
  601. DiskSize := int64 (FI.Total_Clusters) *
  602. int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
  603. else
  604. DiskSize := -1;
  605. end;
  606. end;
  607. function GetCurrentDir: string;
  608. begin
  609. GetDir (0, Result);
  610. end;
  611. function SetCurrentDir (const NewDir: string): boolean;
  612. begin
  613. {$I-}
  614. ChDir (NewDir);
  615. Result := (IOResult = 0);
  616. {$I+}
  617. end;
  618. function CreateDir (const NewDir: string): boolean;
  619. begin
  620. {$I-}
  621. MkDir (NewDir);
  622. Result := (IOResult = 0);
  623. {$I+}
  624. end;
  625. function RemoveDir (const Dir: string): boolean;
  626. begin
  627. {$I-}
  628. RmDir (Dir);
  629. Result := (IOResult = 0);
  630. {$I+}
  631. end;
  632. {$ASMMODE INTEL}
  633. function DirectoryExists (const Directory: string): boolean; assembler;
  634. asm
  635. mov ax, 4300h
  636. mov edx, Directory
  637. call syscall
  638. mov eax, 0
  639. jc @FExistsEnd
  640. test cx, 10h
  641. jz @FExistsEnd
  642. inc eax
  643. @FExistsEnd:
  644. end {['eax', 'ecx', 'edx']};
  645. {****************************************************************************
  646. Time Functions
  647. ****************************************************************************}
  648. procedure GetLocalTime (var SystemTime: TSystemTime); assembler;
  649. asm
  650. (* Expects the default record alignment (word)!!! *)
  651. push edi
  652. mov ah, 2Ah
  653. call syscall
  654. mov edi, SystemTime
  655. mov ax, cx
  656. stosw
  657. xor eax, eax
  658. mov al, 10
  659. mul dl
  660. shl eax, 16
  661. mov al, dh
  662. stosd
  663. push edi
  664. mov ah, 2Ch
  665. call syscall
  666. pop edi
  667. xor eax, eax
  668. mov al, cl
  669. shl eax, 16
  670. mov al, ch
  671. stosd
  672. mov al, dl
  673. shl eax, 16
  674. mov al, dh
  675. stosd
  676. pop edi
  677. end {['eax', 'ecx', 'edx', 'edi']};
  678. {$asmmode default}
  679. {****************************************************************************
  680. Misc Functions
  681. ****************************************************************************}
  682. procedure Beep;
  683. begin
  684. end;
  685. {****************************************************************************
  686. Locale Functions
  687. ****************************************************************************}
  688. procedure InitAnsi;
  689. var I: byte;
  690. Country: TCountryCode;
  691. begin
  692. for I := 0 to 255 do
  693. UpperCaseTable [I] := Chr (I);
  694. Move (UpperCaseTable, LowerCaseTable, SizeOf (UpperCaseTable));
  695. if os_mode = osOS2 then
  696. begin
  697. FillChar (Country, SizeOf (Country), 0);
  698. DosMapCase (SizeOf (UpperCaseTable), Country, @UpperCaseTable);
  699. end
  700. else
  701. begin
  702. (* !!! TODO: DOS/DPMI mode support!!! *)
  703. end;
  704. for I := 0 to 255 do
  705. if UpperCaseTable [I] <> Chr (I) then
  706. LowerCaseTable [Ord (UpperCaseTable [I])] := Chr (I);
  707. end;
  708. procedure InitInternational;
  709. var Country: TCountryCode;
  710. CtryInfo: TCountryInfo;
  711. Size: cardinal;
  712. RC: cardinal;
  713. begin
  714. Size := 0;
  715. FillChar (Country, SizeOf (Country), 0);
  716. FillChar (CtryInfo, SizeOf (CtryInfo), 0);
  717. RC := DosQueryCtryInfo (SizeOf (CtryInfo), Country, CtryInfo, Size);
  718. if RC = 0 then
  719. begin
  720. DateSeparator := CtryInfo.DateSeparator;
  721. case CtryInfo.DateFormat of
  722. 1: begin
  723. ShortDateFormat := 'd/m/y';
  724. LongDateFormat := 'dd" "mmmm" "yyyy';
  725. end;
  726. 2: begin
  727. ShortDateFormat := 'y/m/d';
  728. LongDateFormat := 'yyyy" "mmmm" "dd';
  729. end;
  730. 3: begin
  731. ShortDateFormat := 'm/d/y';
  732. LongDateFormat := 'mmmm" "dd" "yyyy';
  733. end;
  734. end;
  735. TimeSeparator := CtryInfo.TimeSeparator;
  736. DecimalSeparator := CtryInfo.DecimalSeparator;
  737. ThousandSeparator := CtryInfo.ThousandSeparator;
  738. CurrencyFormat := CtryInfo.CurrencyFormat;
  739. CurrencyString := PChar (CtryInfo.CurrencyUnit);
  740. end;
  741. InitAnsi;
  742. end;
  743. function SysErrorMessage(ErrorCode: Integer): String;
  744. begin
  745. Result:=Format(SUnknownErrorCode,[ErrorCode]);
  746. end;
  747. {****************************************************************************
  748. OS Utils
  749. ****************************************************************************}
  750. Function GetEnvironmentVariable(Const EnvVar : String) : String;
  751. begin
  752. GetEnvironmentVariable := StrPas (GetEnvPChar (EnvVar));
  753. end;
  754. {****************************************************************************
  755. Initialization code
  756. ****************************************************************************}
  757. Initialization
  758. InitExceptions; { Initialize exceptions. OS independent }
  759. InitInternational; { Initialize internationalization settings }
  760. Finalization
  761. DoneExceptions;
  762. end.
  763. {
  764. $Log$
  765. Revision 1.13 2003-11-26 20:00:19 florian
  766. * error handling for Variants improved
  767. Revision 1.12 2003/10/19 09:35:28 hajny
  768. * fixes from OS/2 merged to EMX
  769. Revision 1.11 2003/10/14 21:15:20 hajny
  770. * longint2cardinal fixes merged
  771. Revision 1.10 2003/10/07 21:33:24 hajny
  772. * stdcall fixes and asm routines cleanup
  773. Revision 1.9 2003/10/04 17:53:08 hajny
  774. * stdcall changes merged to EMX
  775. Revision 1.8 2003/06/26 17:12:29 yuri
  776. * pmbidi added
  777. * some cosmetic changes
  778. Revision 1.7 2003/06/06 23:34:08 hajny
  779. * better fix for bug 2518
  780. Revision 1.6 2003/06/06 23:31:55 hajny
  781. * fix for bug 2518 applied to EMX as well
  782. Revision 1.5 2003/04/04 02:02:44 yuri
  783. * THandle added
  784. Revision 1.4 2003/04/02 21:06:41 hajny
  785. * Yuri's fix merged from os2
  786. Revision 1.3 2003/03/29 15:01:20 hajny
  787. + DirectoryExists added for main branch OS/2 too
  788. Revision 1.2 2003/03/23 23:11:17 hajny
  789. + emx target added
  790. Revision 1.1 2002/11/17 16:22:54 hajny
  791. + RTL for emx target
  792. }