sysutils.pp 25 KB

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