sysutils.pp 26 KB

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