sysutils.pp 25 KB

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