sysutils.pp 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943
  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 Result, eax
  221. {$ENDIF}
  222. end ['eax', 'ebx', 'ecx', 'edx'];
  223. {$IFOPT H-}
  224. end;
  225. {$ENDIF}
  226. function FileCreate (const FileName: string): longint;
  227. {$IFOPT H+}
  228. assembler;
  229. {$ELSE}
  230. var FN: string;
  231. begin
  232. FN := FileName + #0;
  233. {$ENDIF}
  234. asm
  235. mov eax, 7F2Bh
  236. mov ecx, ofReadWrite or faCreate or doDenyRW (* Sharing to DenyAll *)
  237. {$IFOPT H+}
  238. mov edx, FileName
  239. {$ELSE}
  240. lea edx, FN
  241. inc edx
  242. {$ENDIF}
  243. call syscall
  244. {$IFOPT H-}
  245. mov Result, eax
  246. {$ENDIF}
  247. end ['eax', 'ebx', 'ecx', 'edx'];
  248. {$IFOPT H-}
  249. end;
  250. {$ENDIF}
  251. Function FileCreate (Const FileName : String; Mode:longint) : Longint;
  252. begin
  253. FileCreate:=FileCreate(FileName);
  254. end;
  255. function FileRead (Handle: longint; var Buffer; Count: longint): longint;
  256. assembler;
  257. asm
  258. mov eax, 3F00h
  259. mov ebx, Handle
  260. mov ecx, Count
  261. mov edx, Buffer
  262. call syscall
  263. jnc @FReadEnd
  264. mov eax, -1
  265. @FReadEnd:
  266. end ['eax', 'ebx', 'ecx', 'edx'];
  267. function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
  268. assembler;
  269. asm
  270. mov eax, 4000h
  271. mov ebx, Handle
  272. mov ecx, Count
  273. mov edx, Buffer
  274. call syscall
  275. jnc @FWriteEnd
  276. mov eax, -1
  277. @FWriteEnd:
  278. end ['eax', 'ebx', 'ecx', 'edx'];
  279. function FileSeek (Handle, FOffset, Origin: longint): longint; assembler;
  280. asm
  281. mov eax, Origin
  282. mov ah, 42h
  283. mov ebx, Handle
  284. mov edx, FOffset
  285. call syscall
  286. jnc @FSeekEnd
  287. mov eax, -1
  288. @FSeekEnd:
  289. end ['eax', 'ebx', 'edx'];
  290. Function FileSeek (Handle : Longint; FOffset,Origin : Int64) : Int64;
  291. begin
  292. {$warning need to add 64bit call }
  293. Result:=FileSeek(Handle,Longint(Foffset),Longint(Origin));
  294. end;
  295. procedure FileClose (Handle: longint);
  296. begin
  297. if Handle > 2 then
  298. asm
  299. push ebx
  300. mov eax, 3E00h
  301. mov ebx, Handle
  302. call syscall
  303. pop ebx
  304. end ['eax'];
  305. end;
  306. function FileTruncate (Handle, Size: longint): boolean; assembler;
  307. asm
  308. mov eax, 7F25h
  309. mov ebx, Handle
  310. mov edx, Size
  311. call syscall
  312. jc @FTruncEnd
  313. mov eax, 4202h
  314. mov ebx, Handle
  315. mov edx, 0
  316. call syscall
  317. mov eax, 0
  318. jnc @FTruncEnd
  319. dec eax
  320. @FTruncEnd:
  321. end ['eax', 'ebx', 'ecx', 'edx'];
  322. function FileAge (const FileName: string): longint;
  323. var Handle: longint;
  324. begin
  325. Handle := FileOpen (FileName, 0);
  326. if Handle <> -1 then
  327. begin
  328. Result := FileGetDate (Handle);
  329. FileClose (Handle);
  330. end
  331. else
  332. Result := -1;
  333. end;
  334. function FileExists (const FileName: string): boolean;
  335. {$IFOPT H+}
  336. assembler;
  337. {$ELSE}
  338. var FN: string;
  339. begin
  340. FN := FileName + #0;
  341. {$ENDIF}
  342. asm
  343. mov ax, 4300h
  344. {$IFOPT H+}
  345. mov edx, FileName
  346. {$ELSE}
  347. lea edx, FN
  348. inc edx
  349. {$ENDIF}
  350. call syscall
  351. mov eax, 0
  352. jc @FExistsEnd
  353. test cx, 18h
  354. jnz @FExistsEnd
  355. inc eax
  356. @FExistsEnd:
  357. {$IFOPT H-}
  358. mov Result, eax
  359. {$ENDIF}
  360. end ['eax', 'ecx', 'edx'];
  361. {$IFOPT H-}
  362. end;
  363. {$ENDIF}
  364. type TRec = record
  365. T, D: word;
  366. end;
  367. PSearchRec = ^SearchRec;
  368. function FindFirst (const Path: string; Attr: longint; var Rslt: TSearchRec): longint;
  369. var SR: PSearchRec;
  370. FStat: PFileFindBuf3;
  371. Count: cardinal;
  372. Err: longint;
  373. begin
  374. New (FStat);
  375. Rslt.FindHandle := $FFFFFFFF;
  376. Count := 1;
  377. Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
  378. Attr and FindResvdMask, FStat, SizeOf (FStat^), Count,
  379. ilStandard);
  380. if (Err = 0) and (Count = 0) then Err := 18;
  381. FindFirst := -Err;
  382. if Err = 0 then
  383. begin
  384. Rslt.Name := FStat^.Name;
  385. Rslt.Size := FStat^.FileSize;
  386. Rslt.Attr := FStat^.AttrFile;
  387. Rslt.ExcludeAttr := 0;
  388. TRec (Rslt.Time).T := FStat^.TimeLastWrite;
  389. TRec (Rslt.Time).D := FStat^.DateLastWrite;
  390. end;
  391. Dispose (FStat);
  392. end;
  393. function FindNext (var Rslt: TSearchRec): longint;
  394. var SR: PSearchRec;
  395. FStat: PFileFindBuf3;
  396. Count: cardinal;
  397. Err: longint;
  398. begin
  399. New (FStat);
  400. Count := 1;
  401. Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^),
  402. Count);
  403. if (Err = 0) and (Count = 0) then Err := 18;
  404. FindNext := -Err;
  405. if Err = 0 then
  406. begin
  407. Rslt.Name := FStat^.Name;
  408. Rslt.Size := FStat^.FileSize;
  409. Rslt.Attr := FStat^.AttrFile;
  410. Rslt.ExcludeAttr := 0;
  411. TRec (Rslt.Time).T := FStat^.TimeLastWrite;
  412. TRec (Rslt.Time).D := FStat^.DateLastWrite;
  413. end;
  414. Dispose (FStat);
  415. end;
  416. procedure FindClose (var F: TSearchrec);
  417. var SR: PSearchRec;
  418. begin
  419. DosFindClose (F.FindHandle);
  420. F.FindHandle := 0;
  421. end;
  422. function FileGetDate (Handle: longint): longint; assembler;
  423. asm
  424. mov ax, 5700h
  425. mov ebx, Handle
  426. call syscall
  427. mov eax, -1
  428. jc @FGetDateEnd
  429. mov ax, dx
  430. shld eax, ecx, 16
  431. @FGetDateEnd:
  432. end ['eax', 'ebx', 'ecx', 'edx'];
  433. function FileSetDate (Handle, Age: longint): longint;
  434. var FStat: PFileStatus0;
  435. RC: longint;
  436. begin
  437. New (FStat);
  438. RC := DosQueryFileInfo (Handle, ilStandard, FStat,
  439. SizeOf (FStat^));
  440. if RC <> 0 then
  441. FileSetDate := -1
  442. else
  443. begin
  444. FStat^.DateLastAccess := Hi (Age);
  445. FStat^.DateLastWrite := Hi (Age);
  446. FStat^.TimeLastAccess := Lo (Age);
  447. FStat^.TimeLastWrite := Lo (Age);
  448. RC := DosSetFileInfo (Handle, ilStandard, FStat,
  449. SizeOf (FStat^));
  450. if RC <> 0 then
  451. FileSetDate := -1
  452. else
  453. FileSetDate := 0;
  454. end;
  455. Dispose (FStat);
  456. end;
  457. function FileGetAttr (const FileName: string): longint;
  458. {$IFOPT H+}
  459. assembler;
  460. {$ELSE}
  461. var FN: string;
  462. begin
  463. FN := FileName + #0;
  464. {$ENDIF}
  465. asm
  466. mov ax, 4300h
  467. {$IFOPT H+}
  468. mov edx, FileName
  469. {$ELSE}
  470. lea edx, FN
  471. inc edx
  472. {$ENDIF}
  473. call syscall
  474. jnc @FGetAttrEnd
  475. mov eax, -1
  476. @FGetAttrEnd:
  477. {$IFOPT H-}
  478. mov Result, eax
  479. {$ENDIF}
  480. end ['eax', 'edx'];
  481. {$IFOPT H-}
  482. end;
  483. {$ENDIF}
  484. function FileSetAttr (const Filename: string; Attr: longint): longint;
  485. {$IFOPT H+}
  486. assembler;
  487. {$ELSE}
  488. var FN: string;
  489. begin
  490. FN := FileName + #0;
  491. {$ENDIF}
  492. asm
  493. mov ax, 4301h
  494. mov ecx, Attr
  495. {$IFOPT H+}
  496. mov edx, FileName
  497. {$ELSE}
  498. lea edx, FN
  499. inc edx
  500. {$ENDIF}
  501. call syscall
  502. mov eax, 0
  503. jnc @FSetAttrEnd
  504. mov eax, -1
  505. @FSetAttrEnd:
  506. {$IFOPT H-}
  507. mov Result, eax
  508. {$ENDIF}
  509. end ['eax', 'ecx', 'edx'];
  510. {$IFOPT H-}
  511. end;
  512. {$ENDIF}
  513. function DeleteFile (const FileName: string): boolean;
  514. {$IFOPT H+}
  515. assembler;
  516. {$ELSE}
  517. var FN: string;
  518. begin
  519. FN := FileName + #0;
  520. {$ENDIF}
  521. asm
  522. mov ax, 4100h
  523. {$IFOPT H+}
  524. mov edx, FileName
  525. {$ELSE}
  526. lea edx, FN
  527. inc edx
  528. {$ENDIF}
  529. call syscall
  530. mov eax, 0
  531. jc @FDeleteEnd
  532. inc eax
  533. @FDeleteEnd:
  534. {$IFOPT H-}
  535. mov Result, eax
  536. {$ENDIF}
  537. end ['eax', 'edx'];
  538. {$IFOPT H-}
  539. end;
  540. {$ENDIF}
  541. function RenameFile (const OldName, NewName: string): boolean;
  542. {$IFOPT H+}
  543. assembler;
  544. {$ELSE}
  545. var FN1, FN2: string;
  546. begin
  547. FN1 := OldName + #0;
  548. FN2 := NewName + #0;
  549. {$ENDIF}
  550. asm
  551. mov ax, 5600h
  552. {$IFOPT H+}
  553. mov edx, OldName
  554. mov edi, NewName
  555. {$ELSE}
  556. lea edx, FN1
  557. inc edx
  558. lea edi, FN2
  559. inc edi
  560. {$ENDIF}
  561. call syscall
  562. mov eax, 0
  563. jc @FRenameEnd
  564. inc eax
  565. @FRenameEnd:
  566. {$IFOPT H-}
  567. mov Result, eax
  568. {$ENDIF}
  569. end ['eax', 'edx', 'edi'];
  570. {$IFOPT H-}
  571. end;
  572. {$ENDIF}
  573. {****************************************************************************
  574. Disk Functions
  575. ****************************************************************************}
  576. {$ASMMODE ATT}
  577. function DiskFree (Drive: byte): int64;
  578. var FI: TFSinfo;
  579. RC: longint;
  580. begin
  581. {In OS/2, we use the filesystem information.}
  582. RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
  583. if RC = 0 then
  584. DiskFree := int64 (FI.Free_Clusters) *
  585. int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
  586. else
  587. DiskFree := -1;
  588. end;
  589. function DiskSize (Drive: byte): int64;
  590. var FI: TFSinfo;
  591. RC: longint;
  592. begin
  593. {In OS/2, we use the filesystem information.}
  594. RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
  595. if RC = 0 then
  596. DiskSize := int64 (FI.Total_Clusters) *
  597. int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
  598. else
  599. DiskSize := -1;
  600. end;
  601. function GetCurrentDir: string;
  602. begin
  603. GetDir (0, Result);
  604. end;
  605. function SetCurrentDir (const NewDir: string): boolean;
  606. begin
  607. {$I-}
  608. ChDir (NewDir);
  609. Result := (IOResult = 0);
  610. {$I+}
  611. end;
  612. function CreateDir (const NewDir: string): boolean;
  613. begin
  614. {$I-}
  615. MkDir (NewDir);
  616. Result := (IOResult = 0);
  617. {$I+}
  618. end;
  619. function RemoveDir (const Dir: string): boolean;
  620. begin
  621. {$I-}
  622. RmDir (Dir);
  623. Result := (IOResult = 0);
  624. {$I+}
  625. end;
  626. {$ASMMODE INTEL}
  627. function DirectoryExists (const Directory: string): boolean;
  628. {$IFOPT H+}
  629. assembler;
  630. {$ELSE}
  631. var FN: string;
  632. begin
  633. FN := Directory + #0;
  634. {$ENDIF}
  635. asm
  636. mov ax, 4300h
  637. {$IFOPT H+}
  638. mov edx, Directory
  639. {$ELSE}
  640. lea edx, FN
  641. inc edx
  642. {$ENDIF}
  643. call syscall
  644. mov eax, 0
  645. jc @FExistsEnd
  646. test cx, 10h
  647. jz @FExistsEnd
  648. inc eax
  649. @FExistsEnd:
  650. {$IFOPT H-}
  651. mov Result, eax
  652. {$ENDIF}
  653. end ['eax', 'ecx', 'edx'];
  654. {$IFOPT H-}
  655. end;
  656. {$ENDIF}
  657. {****************************************************************************
  658. Time Functions
  659. ****************************************************************************}
  660. procedure GetLocalTime (var SystemTime: TSystemTime); assembler;
  661. asm
  662. (* Expects the default record alignment (word)!!! *)
  663. mov ah, 2Ah
  664. call syscall
  665. mov edi, SystemTime
  666. mov ax, cx
  667. stosw
  668. xor eax, eax
  669. mov al, 10
  670. mul dl
  671. shl eax, 16
  672. mov al, dh
  673. stosd
  674. push edi
  675. mov ah, 2Ch
  676. call syscall
  677. pop edi
  678. xor eax, eax
  679. mov al, cl
  680. shl eax, 16
  681. mov al, ch
  682. stosd
  683. mov al, dl
  684. shl eax, 16
  685. mov al, dh
  686. stosd
  687. end ['eax', 'ecx', 'edx', 'edi'];
  688. {$asmmode default}
  689. {****************************************************************************
  690. Misc Functions
  691. ****************************************************************************}
  692. procedure Beep;
  693. begin
  694. end;
  695. {****************************************************************************
  696. Locale Functions
  697. ****************************************************************************}
  698. procedure InitAnsi;
  699. var I: byte;
  700. Country: TCountryCode;
  701. begin
  702. for I := 0 to 255 do
  703. UpperCaseTable [I] := Chr (I);
  704. Move (UpperCaseTable, LowerCaseTable, SizeOf (UpperCaseTable));
  705. FillChar (Country, SizeOf (Country), 0);
  706. DosMapCase (SizeOf (UpperCaseTable), Country, @UpperCaseTable);
  707. for I := 0 to 255 do
  708. if UpperCaseTable [I] <> Chr (I) then
  709. LowerCaseTable [Ord (UpperCaseTable [I])] := Chr (I);
  710. end;
  711. procedure InitInternational;
  712. var Country: TCountryCode;
  713. CtryInfo: TCountryInfo;
  714. Size: longint;
  715. RC: longint;
  716. begin
  717. Size := 0;
  718. FillChar (Country, SizeOf (Country), 0);
  719. FillChar (CtryInfo, SizeOf (CtryInfo), 0);
  720. RC := DosQueryCtryInfo (SizeOf (CtryInfo), Country, CtryInfo, Size);
  721. if RC = 0 then
  722. begin
  723. DateSeparator := CtryInfo.DateSeparator;
  724. case CtryInfo.DateFormat of
  725. 1: begin
  726. ShortDateFormat := 'd/m/y';
  727. LongDateFormat := 'dd" "mmmm" "yyyy';
  728. end;
  729. 2: begin
  730. ShortDateFormat := 'y/m/d';
  731. LongDateFormat := 'yyyy" "mmmm" "dd';
  732. end;
  733. 3: begin
  734. ShortDateFormat := 'm/d/y';
  735. LongDateFormat := 'mmmm" "dd" "yyyy';
  736. end;
  737. end;
  738. TimeSeparator := CtryInfo.TimeSeparator;
  739. DecimalSeparator := CtryInfo.DecimalSeparator;
  740. ThousandSeparator := CtryInfo.ThousandSeparator;
  741. CurrencyFormat := CtryInfo.CurrencyFormat;
  742. CurrencyString := PChar (CtryInfo.CurrencyUnit);
  743. end;
  744. InitAnsi;
  745. end;
  746. function SysErrorMessage(ErrorCode: Integer): String;
  747. begin
  748. Result:=Format(SUnknownErrorCode,[ErrorCode]);
  749. end;
  750. {****************************************************************************
  751. OS Utils
  752. ****************************************************************************}
  753. Function GetEnvironmentVariable(Const EnvVar : String) : String;
  754. begin
  755. GetEnvironmentVariable := StrPas (GetEnvPChar (EnvVar));
  756. end;
  757. {****************************************************************************
  758. Initialization code
  759. ****************************************************************************}
  760. Initialization
  761. InitExceptions; { Initialize exceptions. OS independent }
  762. InitInternational; { Initialize internationalization settings }
  763. Finalization
  764. DoneExceptions;
  765. end.
  766. {
  767. $Log$
  768. Revision 1.32 2003-10-08 05:22:47 yuri
  769. * Some emx code removed
  770. Revision 1.31 2003/10/07 21:26:34 hajny
  771. * stdcall fixes and asm routines cleanup
  772. Revision 1.30 2003/10/03 21:46:41 peter
  773. * stdcall fixes
  774. Revision 1.29 2003/06/06 23:34:40 hajny
  775. * better fix for bug 2518
  776. Revision 1.28 2003/06/06 23:31:17 hajny
  777. * fix for bug 2518 applied to OS/2 as well
  778. Revision 1.27 2003/04/01 15:57:41 peter
  779. * made THandle platform dependent and unique type
  780. Revision 1.26 2003/03/31 02:18:39 yuri
  781. FileClose bug fixed (again ;))
  782. Revision 1.25 2003/03/29 19:14:16 yuri
  783. * Directoryexists function header changed back.
  784. Revision 1.24 2003/03/29 18:53:10 yuri
  785. * Fixed DirectoryExists function header
  786. Revision 1.23 2003/03/29 15:01:20 hajny
  787. + DirectoryExists added for main branch OS/2 too
  788. Revision 1.22 2003/03/01 21:19:14 hajny
  789. * FileClose bug fixed
  790. Revision 1.21 2003/01/04 16:25:08 hajny
  791. * modified to make use of the common GetEnv code
  792. Revision 1.20 2003/01/03 20:41:04 peter
  793. * FileCreate(string,mode) overload added
  794. Revision 1.19 2002/11/18 19:51:00 hajny
  795. * another bunch of type corrections
  796. Revision 1.18 2002/09/23 17:42:37 hajny
  797. * AnsiString to PChar typecast
  798. Revision 1.17 2002/09/07 16:01:25 peter
  799. * old logs removed and tabs fixed
  800. Revision 1.16 2002/07/11 16:00:05 hajny
  801. * FindFirst fix (invalid attribute bits masked out)
  802. Revision 1.15 2002/01/25 16:23:03 peter
  803. * merged filesearch() fix
  804. }