2
0

sysutils.pp 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839
  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, Strings;
  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. function DosDelete(FileName:PChar): Longint; cdecl;
  180. external 'DOSCALLS' index 259;
  181. function DosMove(OldFile, NewFile:PChar): Longint; cdecl;
  182. external 'DOSCALLS' index 271;
  183. function DosQueryPathInfo(FileName:PChar;InfoLevel:cardinal;
  184. AFileStatus:PFileStatus;FileStatusLen:cardinal): Longint; cdecl;
  185. external 'DOSCALLS' index 223;
  186. function DosSetPathInfo(FileName:PChar;InfoLevel:longint;
  187. AFileStatus:PFileStatus;FileStatusLen,
  188. Options:longint):longint; cdecl;
  189. external 'DOSCALLS' index 219;
  190. type
  191. TDT=packed record
  192. Hour,
  193. Minute,
  194. Second,
  195. Sec100,
  196. Day,
  197. Month: byte;
  198. Year: word;
  199. TimeZone: smallint;
  200. WeekDay: byte;
  201. end;
  202. function DosGetDateTime(var Buf: TDT):longint; cdecl;
  203. external 'DOSCALLS' index 230;
  204. {****************************************************************************
  205. File Functions
  206. ****************************************************************************}
  207. const
  208. ofRead = $0000; {Open for reading}
  209. ofWrite = $0001; {Open for writing}
  210. ofReadWrite = $0002; {Open for reading/writing}
  211. doDenyRW = $0010; {DenyAll (no sharing)}
  212. faCreateNew = $00010000; {Create if file does not exist}
  213. faOpenReplace = $00040000; {Truncate if file exists}
  214. faCreate = $00050000; {Create if file does not exist, truncate otherwise}
  215. FindResvdMask = $00003737; {Allowed bits in attribute
  216. specification for DosFindFirst call.}
  217. {$ASMMODE INTEL}
  218. function FileOpen (const FileName: string; Mode: integer): longint; assembler;
  219. asm
  220. push ebx
  221. mov eax, Mode
  222. (* DenyAll if sharing not specified. *)
  223. test eax, 112
  224. jnz @FOpen1
  225. or eax, 16
  226. @FOpen1:
  227. mov ecx, eax
  228. mov eax, 7F2Bh
  229. mov edx, FileName
  230. call syscall
  231. pop ebx
  232. end {['eax', 'ebx', 'ecx', 'edx']};
  233. function FileCreate (const FileName: string): longint; assembler;
  234. asm
  235. push ebx
  236. mov eax, 7F2Bh
  237. mov ecx, ofReadWrite or faCreate or doDenyRW (* Sharing to DenyAll *)
  238. mov edx, FileName
  239. call syscall
  240. pop ebx
  241. end {['eax', 'ebx', 'ecx', 'edx']};
  242. function FileCreate (const FileName: string; Mode: longint): longint;
  243. begin
  244. FileCreate := FileCreate(FileName);
  245. end;
  246. function FileRead (Handle: longint; var Buffer; Count: longint): longint;
  247. assembler;
  248. asm
  249. push ebx
  250. mov eax, 3F00h
  251. mov ebx, Handle
  252. mov ecx, Count
  253. mov edx, Buffer
  254. call syscall
  255. jnc @FReadEnd
  256. mov eax, -1
  257. @FReadEnd:
  258. pop ebx
  259. end {['eax', 'ebx', 'ecx', 'edx']};
  260. function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
  261. assembler;
  262. asm
  263. push ebx
  264. mov eax, 4000h
  265. mov ebx, Handle
  266. mov ecx, Count
  267. mov edx, Buffer
  268. call syscall
  269. jnc @FWriteEnd
  270. mov eax, -1
  271. @FWriteEnd:
  272. pop ebx
  273. end {['eax', 'ebx', 'ecx', 'edx']};
  274. function FileSeek (Handle, FOffset, Origin: longint): longint; assembler;
  275. asm
  276. push ebx
  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. pop ebx
  286. end {['eax', 'ebx', 'edx']};
  287. function FileSeek (Handle: longint; FOffset, Origin: Int64): Int64;
  288. begin
  289. {$warning need to add 64bit call }
  290. Result:=FileSeek(Handle,Longint(Foffset),Longint(Origin));
  291. end;
  292. procedure FileClose (Handle: longint); assembler;
  293. asm
  294. push ebx
  295. mov eax, Handle
  296. cmp eax, 2
  297. jbe @FCloseEnd
  298. mov ebx, eax
  299. mov eax, 3E00h
  300. call syscall
  301. @FCloseEnd:
  302. pop ebx
  303. end {['eax', 'ebx']};
  304. function FileTruncate (Handle, Size: longint): boolean; assembler;
  305. asm
  306. push ebx
  307. mov eax, 7F25h
  308. mov ebx, Handle
  309. mov edx, Size
  310. call syscall
  311. jc @FTruncEnd
  312. mov eax, 4202h
  313. mov ebx, Handle
  314. mov edx, 0
  315. call syscall
  316. mov eax, 0
  317. jnc @FTruncEnd
  318. dec eax
  319. @FTruncEnd:
  320. pop ebx
  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. var
  336. SR: TSearchRec;
  337. begin
  338. FileExists:=False;
  339. if FindFirst(FileName, faAnyFile, SR)=0 then FileExists:=True;
  340. FindClose(SR);
  341. end;
  342. type TRec = record
  343. T, D: word;
  344. end;
  345. PSearchRec = ^SearchRec;
  346. function FindFirst (const Path: string; Attr: longint; var Rslt: TSearchRec): longint;
  347. var SR: PSearchRec;
  348. FStat: PFileFindBuf3;
  349. Count: cardinal;
  350. Err: cardinal;
  351. begin
  352. New (FStat);
  353. Rslt.FindHandle := $FFFFFFFF;
  354. Count := 1;
  355. Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
  356. Attr and FindResvdMask, FStat, SizeOf (FStat^), Count,
  357. ilStandard);
  358. if (Err = 0) and (Count = 0) then Err := 18;
  359. FindFirst := -Err;
  360. if Err = 0 then
  361. begin
  362. Rslt.Name := FStat^.Name;
  363. Rslt.Size := FStat^.FileSize;
  364. Rslt.Attr := FStat^.AttrFile;
  365. Rslt.ExcludeAttr := 0;
  366. TRec (Rslt.Time).T := FStat^.TimeLastWrite;
  367. TRec (Rslt.Time).D := FStat^.DateLastWrite;
  368. end;
  369. Dispose (FStat);
  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. 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. procedure FindClose (var F: TSearchrec);
  395. var SR: PSearchRec;
  396. begin
  397. DosFindClose (F.FindHandle);
  398. F.FindHandle := 0;
  399. end;
  400. function FileGetDate (Handle: longint): longint; assembler;
  401. asm
  402. push ebx
  403. mov ax, 5700h
  404. mov ebx, Handle
  405. call syscall
  406. mov eax, -1
  407. jc @FGetDateEnd
  408. mov ax, dx
  409. shld eax, ecx, 16
  410. @FGetDateEnd:
  411. pop ebx
  412. end {['eax', 'ebx', 'ecx', 'edx']};
  413. function FileSetDate (Handle, Age: longint): longint;
  414. var FStat: PFileStatus0;
  415. RC: cardinal;
  416. begin
  417. New (FStat);
  418. RC := DosQueryFileInfo (Handle, ilStandard, FStat,
  419. SizeOf (FStat^));
  420. if RC <> 0 then
  421. FileSetDate := -1
  422. else
  423. begin
  424. FStat^.DateLastAccess := Hi (Age);
  425. FStat^.DateLastWrite := Hi (Age);
  426. FStat^.TimeLastAccess := Lo (Age);
  427. FStat^.TimeLastWrite := Lo (Age);
  428. RC := DosSetFileInfo (Handle, ilStandard, FStat,
  429. SizeOf (FStat^));
  430. if RC <> 0 then
  431. FileSetDate := -1
  432. else
  433. FileSetDate := 0;
  434. end;
  435. Dispose (FStat);
  436. end;
  437. function FileGetAttr (const FileName: string): longint;
  438. var
  439. FS: PFileStatus3;
  440. S: PChar;
  441. begin
  442. New(FS);
  443. S:=StrAlloc(length(FileName)+1);
  444. StrPCopy(S, FileName);
  445. Result:=-DosQueryPathInfo(S, ilStandard, FS, SizeOf(FS^));
  446. StrDispose(S);
  447. If Result=0 Then Result:=FS^.attrFile;
  448. Dispose(FS);
  449. end;
  450. function FileSetAttr (const Filename: string; Attr: longint): longint;
  451. Var
  452. FS: PFileStatus3;
  453. S: PChar;
  454. Begin
  455. New(FS);
  456. FillChar(FS, SizeOf(FS^), 0);
  457. FS^.attrFile:=Attr;
  458. S:=StrAlloc(length(FileName)+1);
  459. StrPCopy(S, FileName);
  460. Result:=-DosSetPathInfo(S, ilStandard, FS, SizeOf(FS^), 0);
  461. StrDispose(S);
  462. Dispose(FS);
  463. end;
  464. function DeleteFile (const FileName: string): boolean;
  465. Var
  466. S: PChar;
  467. Begin
  468. S:=StrAlloc(length(FileName)+1);
  469. StrPCopy(S, FileName);
  470. Result:=(DosDelete(S)=0);
  471. StrDispose(S);
  472. End;
  473. function RenameFile (const OldName, NewName: string): boolean;
  474. Var
  475. S1, S2: PChar;
  476. Begin
  477. S1:=StrAlloc(length(OldName)+1);
  478. StrPCopy(S1, OldName);
  479. S2:=StrAlloc(length(NewName)+1);
  480. StrPCopy(S2, NewName);
  481. Result:=(DosMove(S1, S2)=0);
  482. StrDispose(S1);
  483. StrDispose(S2);
  484. End;
  485. {****************************************************************************
  486. Disk Functions
  487. ****************************************************************************}
  488. {$ASMMODE ATT}
  489. function DiskFree (Drive: byte): int64;
  490. var FI: TFSinfo;
  491. RC: cardinal;
  492. begin
  493. {In OS/2, we use the filesystem information.}
  494. RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
  495. if RC = 0 then
  496. DiskFree := int64 (FI.Free_Clusters) *
  497. int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
  498. else
  499. DiskFree := -1;
  500. end;
  501. function DiskSize (Drive: byte): int64;
  502. var FI: TFSinfo;
  503. RC: cardinal;
  504. begin
  505. {In OS/2, we use the filesystem information.}
  506. RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
  507. if RC = 0 then
  508. DiskSize := int64 (FI.Total_Clusters) *
  509. int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
  510. else
  511. DiskSize := -1;
  512. end;
  513. function GetCurrentDir: string;
  514. begin
  515. GetDir (0, Result);
  516. end;
  517. function SetCurrentDir (const NewDir: string): boolean;
  518. begin
  519. {$I-}
  520. ChDir (NewDir);
  521. Result := (IOResult = 0);
  522. {$I+}
  523. end;
  524. function CreateDir (const NewDir: string): boolean;
  525. begin
  526. {$I-}
  527. MkDir (NewDir);
  528. Result := (IOResult = 0);
  529. {$I+}
  530. end;
  531. function RemoveDir (const Dir: string): boolean;
  532. begin
  533. {$I-}
  534. RmDir (Dir);
  535. Result := (IOResult = 0);
  536. {$I+}
  537. end;
  538. {$ASMMODE INTEL}
  539. function DirectoryExists (const Directory: string): boolean; assembler;
  540. asm
  541. mov ax, 4300h
  542. mov edx, Directory
  543. call syscall
  544. mov eax, 0
  545. jc @FExistsEnd
  546. test cx, 10h
  547. jz @FExistsEnd
  548. inc eax
  549. @FExistsEnd:
  550. end {['eax', 'ecx', 'edx']};
  551. {****************************************************************************
  552. Time Functions
  553. ****************************************************************************}
  554. procedure GetLocalTime (var SystemTime: TSystemTime);
  555. var
  556. DT: TDT;
  557. begin
  558. DosGetDateTime(DT);
  559. with SystemTime do
  560. begin
  561. Year:=DT.Year;
  562. Month:=DT.Month;
  563. Day:=DT.Day;
  564. Hour:=DT.Hour;
  565. Minute:=DT.Minute;
  566. Second:=DT.Second;
  567. MilliSecond:=DT.Sec100;
  568. end;
  569. end;
  570. {$asmmode default}
  571. {****************************************************************************
  572. Misc Functions
  573. ****************************************************************************}
  574. procedure Beep;
  575. begin
  576. end;
  577. {****************************************************************************
  578. Locale Functions
  579. ****************************************************************************}
  580. procedure InitAnsi;
  581. var I: byte;
  582. Country: TCountryCode;
  583. begin
  584. for I := 0 to 255 do
  585. UpperCaseTable [I] := Chr (I);
  586. Move (UpperCaseTable, LowerCaseTable, SizeOf (UpperCaseTable));
  587. FillChar (Country, SizeOf (Country), 0);
  588. DosMapCase (SizeOf (UpperCaseTable), Country, @UpperCaseTable);
  589. for I := 0 to 255 do
  590. if UpperCaseTable [I] <> Chr (I) then
  591. LowerCaseTable [Ord (UpperCaseTable [I])] := Chr (I);
  592. end;
  593. procedure InitInternational;
  594. var Country: TCountryCode;
  595. CtryInfo: TCountryInfo;
  596. Size: cardinal;
  597. RC: cardinal;
  598. begin
  599. Size := 0;
  600. FillChar (Country, SizeOf (Country), 0);
  601. FillChar (CtryInfo, SizeOf (CtryInfo), 0);
  602. RC := DosQueryCtryInfo (SizeOf (CtryInfo), Country, CtryInfo, Size);
  603. if RC = 0 then
  604. begin
  605. DateSeparator := CtryInfo.DateSeparator;
  606. case CtryInfo.DateFormat of
  607. 1: begin
  608. ShortDateFormat := 'd/m/y';
  609. LongDateFormat := 'dd" "mmmm" "yyyy';
  610. end;
  611. 2: begin
  612. ShortDateFormat := 'y/m/d';
  613. LongDateFormat := 'yyyy" "mmmm" "dd';
  614. end;
  615. 3: begin
  616. ShortDateFormat := 'm/d/y';
  617. LongDateFormat := 'mmmm" "dd" "yyyy';
  618. end;
  619. end;
  620. TimeSeparator := CtryInfo.TimeSeparator;
  621. DecimalSeparator := CtryInfo.DecimalSeparator;
  622. ThousandSeparator := CtryInfo.ThousandSeparator;
  623. CurrencyFormat := CtryInfo.CurrencyFormat;
  624. CurrencyString := PChar (CtryInfo.CurrencyUnit);
  625. end;
  626. InitAnsi;
  627. end;
  628. function SysErrorMessage(ErrorCode: Integer): String;
  629. begin
  630. Result:=Format(SUnknownErrorCode,[ErrorCode]);
  631. end;
  632. {****************************************************************************
  633. OS Utils
  634. ****************************************************************************}
  635. Function GetEnvironmentVariable(Const EnvVar : String) : String;
  636. begin
  637. GetEnvironmentVariable := StrPas (GetEnvPChar (EnvVar));
  638. end;
  639. {****************************************************************************
  640. Initialization code
  641. ****************************************************************************}
  642. Initialization
  643. InitExceptions; { Initialize exceptions. OS independent }
  644. InitInternational; { Initialize internationalization settings }
  645. Finalization
  646. DoneExceptions;
  647. end.
  648. {
  649. $Log$
  650. Revision 1.36 2003-10-27 12:19:20 yuri
  651. * GetLocatTime now also native
  652. Revision 1.35 2003/10/27 11:43:40 yuri
  653. * New set of native functions
  654. Revision 1.34 2003/10/18 16:58:39 hajny
  655. * stdcall fixes again
  656. Revision 1.33 2003/10/13 21:17:31 hajny
  657. * longint to cardinal corrections
  658. Revision 1.32 2003/10/08 05:22:47 yuri
  659. * Some emx code removed
  660. Revision 1.31 2003/10/07 21:26:34 hajny
  661. * stdcall fixes and asm routines cleanup
  662. Revision 1.30 2003/10/03 21:46:41 peter
  663. * stdcall fixes
  664. Revision 1.29 2003/06/06 23:34:40 hajny
  665. * better fix for bug 2518
  666. Revision 1.28 2003/06/06 23:31:17 hajny
  667. * fix for bug 2518 applied to OS/2 as well
  668. Revision 1.27 2003/04/01 15:57:41 peter
  669. * made THandle platform dependent and unique type
  670. Revision 1.26 2003/03/31 02:18:39 yuri
  671. FileClose bug fixed (again ;))
  672. Revision 1.25 2003/03/29 19:14:16 yuri
  673. * Directoryexists function header changed back.
  674. Revision 1.24 2003/03/29 18:53:10 yuri
  675. * Fixed DirectoryExists function header
  676. Revision 1.23 2003/03/29 15:01:20 hajny
  677. + DirectoryExists added for main branch OS/2 too
  678. Revision 1.22 2003/03/01 21:19:14 hajny
  679. * FileClose bug fixed
  680. Revision 1.21 2003/01/04 16:25:08 hajny
  681. * modified to make use of the common GetEnv code
  682. Revision 1.20 2003/01/03 20:41:04 peter
  683. * FileCreate(string,mode) overload added
  684. Revision 1.19 2002/11/18 19:51:00 hajny
  685. * another bunch of type corrections
  686. Revision 1.18 2002/09/23 17:42:37 hajny
  687. * AnsiString to PChar typecast
  688. Revision 1.17 2002/09/07 16:01:25 peter
  689. * old logs removed and tabs fixed
  690. Revision 1.16 2002/07/11 16:00:05 hajny
  691. * FindFirst fix (invalid attribute bits masked out)
  692. Revision 1.15 2002/01/25 16:23:03 peter
  693. * merged filesearch() fix
  694. }