sysutils.pp 29 KB

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