sysutils.pp 28 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007
  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: longint; {Amount of space the file really
  43. occupies on disk.}
  44. end;
  45. PFileStatus0 = ^TFileStatus0;
  46. TFileStatus3 = object (TFileStatus)
  47. NextEntryOffset: longint; {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: longint; {Amount of space the file really
  56. occupies on disk.}
  57. AttrFile: longint; {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: longint;
  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: longint; {Code page to query info about (0=current).}
  88. end;
  89. PCountryCode=^TCountryCode;
  90. TTimeFmt = (Clock12, Clock24);
  91. TCountryInfo=record
  92. Country, CodePage: longint; {Country and codepage requested.}
  93. case byte of
  94. 0:
  95. (DateFormat: longint; {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: longint; {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, InfoLevel: longint; AFileStatus: PFileStatus;
  157. FileStatusLen: longint): longint; cdecl; external 'DOSCALLS' index 218;
  158. function DosQueryFSInfo (DiskNum, InfoLevel: longint; var Buffer: TFSInfo;
  159. BufLen: longint): longint; cdecl; external 'DOSCALLS' index 278;
  160. function DosQueryFileInfo (Handle, InfoLevel: longint;
  161. AFileStatus: PFileStatus; FileStatusLen: longint): longint; cdecl;
  162. external 'DOSCALLS' index 279;
  163. function DosScanEnv (Name: PChar; var Value: PChar): longint; cdecl;
  164. external 'DOSCALLS' index 227;
  165. function DosFindFirst (FileMask: PChar; var Handle: longint; Attrib: longint;
  166. AFileStatus: PFileStatus; FileStatusLen: longint;
  167. var Count: longint; InfoLevel: longint): longint; cdecl;
  168. external 'DOSCALLS' index 264;
  169. function DosFindNext (Handle: longint; AFileStatus: PFileStatus;
  170. FileStatusLen: longint; var Count: longint): longint; cdecl;
  171. external 'DOSCALLS' index 265;
  172. function DosFindClose (Handle: longint): longint; cdecl;
  173. external 'DOSCALLS' index 263;
  174. function DosQueryCtryInfo (Size: longint; var Country: TCountryCode;
  175. var Res: TCountryInfo; var ActualSize: longint): longint; cdecl;
  176. external 'NLS' index 5;
  177. function DosMapCase (Size: longint; var Country: TCountryCode;
  178. AString: PChar): longint; cdecl; external 'NLS' index 7;
  179. {****************************************************************************
  180. File Functions
  181. ****************************************************************************}
  182. const
  183. ofRead = $0000; {Open for reading}
  184. ofWrite = $0001; {Open for writing}
  185. ofReadWrite = $0002; {Open for reading/writing}
  186. doDenyRW = $0010; {DenyAll (no sharing)}
  187. faCreateNew = $00010000; {Create if file does not exist}
  188. faOpenReplace = $00040000; {Truncate if file exists}
  189. faCreate = $00050000; {Create if file does not exist, truncate otherwise}
  190. FindResvdMask = $00003737; {Allowed bits in attribute
  191. specification for DosFindFirst call.}
  192. {$ASMMODE INTEL}
  193. function FileOpen (const FileName: string; Mode: integer): longint;
  194. {$IFOPT H+}
  195. assembler;
  196. {$ELSE}
  197. var FN: string;
  198. begin
  199. FN := FileName + #0;
  200. {$ENDIF}
  201. asm
  202. mov eax, Mode
  203. (* DenyAll if sharing not specified. *)
  204. test eax, 112
  205. jnz @FOpen1
  206. or eax, 16
  207. @FOpen1:
  208. mov ecx, eax
  209. mov eax, 7F2Bh
  210. {$IFOPT H+}
  211. mov edx, FileName
  212. {$ELSE}
  213. lea edx, FN
  214. inc edx
  215. {$ENDIF}
  216. call syscall
  217. {$IFOPT H-}
  218. mov [ebp - 4], eax
  219. end;
  220. {$ENDIF}
  221. end;
  222. function FileCreate (const FileName: string): longint;
  223. {$IFOPT H+}
  224. assembler;
  225. {$ELSE}
  226. var FN: string;
  227. begin
  228. FN := FileName + #0;
  229. {$ENDIF}
  230. asm
  231. mov eax, 7F2Bh
  232. mov ecx, ofReadWrite or faCreate or doDenyRW (* Sharing to DenyAll *)
  233. {$IFOPT H+}
  234. mov edx, FileName
  235. {$ELSE}
  236. lea edx, FN
  237. inc edx
  238. {$ENDIF}
  239. call syscall
  240. {$IFOPT H-}
  241. mov [ebp - 4], eax
  242. end;
  243. {$ENDIF}
  244. end;
  245. function FileRead (Handle: longint; var Buffer; Count: longint): longint;
  246. assembler;
  247. asm
  248. mov eax, 3F00h
  249. mov ebx, Handle
  250. mov ecx, Count
  251. mov edx, Buffer
  252. call syscall
  253. jnc @FReadEnd
  254. mov eax, -1
  255. @FReadEnd:
  256. end;
  257. function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
  258. assembler;
  259. asm
  260. mov eax, 4000h
  261. mov ebx, Handle
  262. mov ecx, Count
  263. mov edx, Buffer
  264. call syscall
  265. jnc @FWriteEnd
  266. mov eax, -1
  267. @FWriteEnd:
  268. end;
  269. function FileSeek (Handle, FOffset, Origin: longint): longint; assembler;
  270. asm
  271. mov eax, Origin
  272. mov ah, 42h
  273. mov ebx, Handle
  274. mov edx, FOffset
  275. call syscall
  276. jnc @FSeekEnd
  277. mov eax, -1
  278. @FSeekEnd:
  279. end;
  280. Function FileSeek (Handle : Longint; FOffset,Origin : Int64) : Int64;
  281. begin
  282. {$warning need to add 64bit call }
  283. Result:=FileSeek(Handle,Longint(Foffset),Longint(Origin));
  284. end;
  285. procedure FileClose (Handle: longint);
  286. begin
  287. if (Handle <= 4) or (os_mode = osOS2) and (Handle <= 2) then
  288. asm
  289. mov eax, 3E00h
  290. mov ebx, Handle
  291. call syscall
  292. end;
  293. end;
  294. function FileTruncate (Handle, Size: longint): boolean; assembler;
  295. asm
  296. mov eax, 7F25h
  297. mov ebx, Handle
  298. mov edx, Size
  299. call syscall
  300. jc @FTruncEnd
  301. mov eax, 4202h
  302. mov ebx, Handle
  303. mov edx, 0
  304. call syscall
  305. mov eax, 0
  306. jnc @FTruncEnd
  307. dec eax
  308. @FTruncEnd:
  309. end;
  310. function FileAge (const FileName: string): longint;
  311. var Handle: longint;
  312. begin
  313. Handle := FileOpen (FileName, 0);
  314. if Handle <> -1 then
  315. begin
  316. Result := FileGetDate (Handle);
  317. FileClose (Handle);
  318. end
  319. else
  320. Result := -1;
  321. end;
  322. function FileExists (const FileName: string): boolean;
  323. {$IFOPT H+}
  324. assembler;
  325. {$ELSE}
  326. var FN: string;
  327. begin
  328. FN := FileName + #0;
  329. {$ENDIF}
  330. asm
  331. mov ax, 4300h
  332. {$IFOPT H+}
  333. mov edx, FileName
  334. {$ELSE}
  335. lea edx, FN
  336. inc edx
  337. {$ENDIF}
  338. call syscall
  339. mov eax, 0
  340. jc @FExistsEnd
  341. test cx, 18h
  342. jnz @FExistsEnd
  343. inc eax
  344. @FExistsEnd:
  345. {$IFOPT H-}
  346. end;
  347. {$ENDIF}
  348. end;
  349. type TRec = record
  350. T, D: word;
  351. end;
  352. PSearchRec = ^SearchRec;
  353. function FindFirst (const Path: string; Attr: longint; var Rslt: TSearchRec): longint;
  354. var SR: PSearchRec;
  355. FStat: PFileFindBuf3;
  356. Count: longint;
  357. Err: longint;
  358. begin
  359. if os_mode = osOS2 then
  360. begin
  361. New (FStat);
  362. Rslt.FindHandle := $FFFFFFFF;
  363. Count := 1;
  364. Err := DosFindFirst (Path, Rslt.FindHandle, Attr and FindResvdMask,
  365. FStat, SizeOf (FStat^), Count, ilStandard);
  366. if (Err = 0) and (Count = 0) then Err := 18;
  367. FindFirst := -Err;
  368. if Err = 0 then
  369. begin
  370. Rslt.Name := FStat^.Name;
  371. Rslt.Size := FStat^.FileSize;
  372. Rslt.Attr := FStat^.AttrFile;
  373. Rslt.ExcludeAttr := 0;
  374. TRec (Rslt.Time).T := FStat^.TimeLastWrite;
  375. TRec (Rslt.Time).D := FStat^.DateLastWrite;
  376. end;
  377. Dispose (FStat);
  378. end
  379. else
  380. begin
  381. Err := DOS.DosError;
  382. GetMem (SR, SizeOf (SearchRec));
  383. Rslt.FindHandle := longint(SR);
  384. DOS.FindFirst (Path, Attr, SR^);
  385. FindFirst := -DOS.DosError;
  386. if DosError = 0 then
  387. begin
  388. Rslt.Time := SR^.Time;
  389. Rslt.Size := SR^.Size;
  390. Rslt.Attr := SR^.Attr;
  391. Rslt.ExcludeAttr := 0;
  392. Rslt.Name := SR^.Name;
  393. end;
  394. DOS.DosError := Err;
  395. end;
  396. end;
  397. function FindNext (var Rslt: TSearchRec): longint;
  398. var SR: PSearchRec;
  399. FStat: PFileFindBuf3;
  400. Count: longint;
  401. Err: longint;
  402. begin
  403. if os_mode = osOS2 then
  404. begin
  405. New (FStat);
  406. Count := 1;
  407. Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^),
  408. Count);
  409. if (Err = 0) and (Count = 0) then Err := 18;
  410. FindNext := -Err;
  411. if Err = 0 then
  412. begin
  413. Rslt.Name := FStat^.Name;
  414. Rslt.Size := FStat^.FileSize;
  415. Rslt.Attr := FStat^.AttrFile;
  416. Rslt.ExcludeAttr := 0;
  417. TRec (Rslt.Time).T := FStat^.TimeLastWrite;
  418. TRec (Rslt.Time).D := FStat^.DateLastWrite;
  419. end;
  420. Dispose (FStat);
  421. end
  422. else
  423. begin
  424. SR := PSearchRec (Rslt.FindHandle);
  425. if SR <> nil then
  426. begin
  427. DOS.FindNext (SR^);
  428. FindNext := -DosError;
  429. if DosError = 0 then
  430. begin
  431. Rslt.Time := SR^.Time;
  432. Rslt.Size := SR^.Size;
  433. Rslt.Attr := SR^.Attr;
  434. Rslt.ExcludeAttr := 0;
  435. Rslt.Name := SR^.Name;
  436. end;
  437. end;
  438. end;
  439. end;
  440. procedure FindClose (var F: TSearchrec);
  441. var SR: PSearchRec;
  442. begin
  443. if os_mode = osOS2 then
  444. begin
  445. DosFindClose (F.FindHandle);
  446. end
  447. else
  448. begin
  449. SR := PSearchRec (F.FindHandle);
  450. DOS.FindClose (SR^);
  451. FreeMem (SR, SizeOf (SearchRec));
  452. end;
  453. F.FindHandle := 0;
  454. end;
  455. function FileGetDate (Handle: longint): longint; assembler;
  456. asm
  457. mov ax, 5700h
  458. mov ebx, Handle
  459. call syscall
  460. mov eax, -1
  461. jc @FGetDateEnd
  462. mov ax, dx
  463. shld eax, ecx, 16
  464. @FGetDateEnd:
  465. end;
  466. function FileSetDate (Handle, Age: longint): longint;
  467. var FStat: PFileStatus0;
  468. RC: longint;
  469. begin
  470. if os_mode = osOS2 then
  471. begin
  472. New (FStat);
  473. RC := DosQueryFileInfo (Handle, ilStandard, FStat,
  474. SizeOf (FStat^));
  475. if RC <> 0 then
  476. FileSetDate := -1
  477. else
  478. begin
  479. FStat^.DateLastAccess := Hi (Age);
  480. FStat^.DateLastWrite := Hi (Age);
  481. FStat^.TimeLastAccess := Lo (Age);
  482. FStat^.TimeLastWrite := Lo (Age);
  483. RC := DosSetFileInfo (Handle, ilStandard, FStat,
  484. SizeOf (FStat^));
  485. if RC <> 0 then
  486. FileSetDate := -1
  487. else
  488. FileSetDate := 0;
  489. end;
  490. Dispose (FStat);
  491. end
  492. else
  493. asm
  494. mov ax, 5701h
  495. mov ebx, Handle
  496. mov cx, word ptr [Age]
  497. mov dx, word ptr [Age + 2]
  498. call syscall
  499. jnc @FSetDateEnd
  500. mov eax, -1
  501. @FSetDateEnd:
  502. mov [ebp - 4], eax
  503. end;
  504. end;
  505. function FileGetAttr (const FileName: string): longint;
  506. {$IFOPT H+}
  507. assembler;
  508. {$ELSE}
  509. var FN: string;
  510. begin
  511. FN := FileName + #0;
  512. {$ENDIF}
  513. asm
  514. mov ax, 4300h
  515. {$IFOPT H+}
  516. mov edx, FileName
  517. {$ELSE}
  518. lea edx, FN
  519. inc edx
  520. {$ENDIF}
  521. call syscall
  522. jnc @FGetAttrEnd
  523. mov eax, -1
  524. @FGetAttrEnd:
  525. {$IFOPT H-}
  526. mov [ebp - 4], eax
  527. end;
  528. {$ENDIF}
  529. end;
  530. function FileSetAttr (const Filename: string; Attr: longint): longint;
  531. {$IFOPT H+}
  532. assembler;
  533. {$ELSE}
  534. var FN: string;
  535. begin
  536. FN := FileName + #0;
  537. {$ENDIF}
  538. asm
  539. mov ax, 4301h
  540. mov ecx, Attr
  541. {$IFOPT H+}
  542. mov edx, FileName
  543. {$ELSE}
  544. lea edx, FN
  545. inc edx
  546. {$ENDIF}
  547. call syscall
  548. mov eax, 0
  549. jnc @FSetAttrEnd
  550. mov eax, -1
  551. @FSetAttrEnd:
  552. {$IFOPT H-}
  553. mov [ebp - 4], eax
  554. end;
  555. {$ENDIF}
  556. end;
  557. function DeleteFile (const FileName: string): boolean;
  558. {$IFOPT H+}
  559. assembler;
  560. {$ELSE}
  561. var FN: string;
  562. begin
  563. FN := FileName + #0;
  564. {$ENDIF}
  565. asm
  566. mov ax, 4100h
  567. {$IFOPT H+}
  568. mov edx, FileName
  569. {$ELSE}
  570. lea edx, FN
  571. inc edx
  572. {$ENDIF}
  573. call syscall
  574. mov eax, 0
  575. jc @FDeleteEnd
  576. inc eax
  577. @FDeleteEnd:
  578. {$IFOPT H-}
  579. mov [ebp - 4], eax
  580. end;
  581. {$ENDIF}
  582. end;
  583. function RenameFile (const OldName, NewName: string): boolean;
  584. {$IFOPT H+}
  585. assembler;
  586. {$ELSE}
  587. var FN1, FN2: string;
  588. begin
  589. FN1 := OldName + #0;
  590. FN2 := NewName + #0;
  591. {$ENDIF}
  592. asm
  593. mov ax, 5600h
  594. {$IFOPT H+}
  595. mov edx, OldName
  596. mov edi, NewName
  597. {$ELSE}
  598. lea edx, FN1
  599. inc edx
  600. lea edi, FN2
  601. inc edi
  602. {$ENDIF}
  603. call syscall
  604. mov eax, 0
  605. jc @FRenameEnd
  606. inc eax
  607. @FRenameEnd:
  608. {$IFOPT H-}
  609. mov [ebp - 4], eax
  610. end;
  611. {$ENDIF}
  612. end;
  613. {****************************************************************************
  614. Disk Functions
  615. ****************************************************************************}
  616. {$ASMMODE ATT}
  617. function DiskFree (Drive: byte): int64;
  618. var FI: TFSinfo;
  619. RC: longint;
  620. begin
  621. if (os_mode = osDOS) or (os_mode = osDPMI) then
  622. {Function 36 is not supported in OS/2.}
  623. asm
  624. movb Drive,%dl
  625. movb $0x36,%ah
  626. call syscall
  627. cmpw $-1,%ax
  628. je .LDISKFREE1
  629. mulw %cx
  630. mulw %bx
  631. shll $16,%edx
  632. movw %ax,%dx
  633. movl $0,%eax
  634. xchgl %edx,%eax
  635. leave
  636. ret
  637. .LDISKFREE1:
  638. cltd
  639. leave
  640. ret
  641. end
  642. else
  643. {In OS/2, we use the filesystem information.}
  644. begin
  645. RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
  646. if RC = 0 then
  647. DiskFree := int64 (FI.Free_Clusters) *
  648. int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
  649. else
  650. DiskFree := -1;
  651. end;
  652. end;
  653. function DiskSize (Drive: byte): int64;
  654. var FI: TFSinfo;
  655. RC: longint;
  656. begin
  657. if (os_mode = osDOS) or (os_mode = osDPMI) then
  658. {Function 36 is not supported in OS/2.}
  659. asm
  660. movb Drive,%dl
  661. movb $0x36,%ah
  662. call syscall
  663. movw %dx,%bx
  664. cmpw $-1,%ax
  665. je .LDISKSIZE1
  666. mulw %cx
  667. mulw %bx
  668. shll $16,%edx
  669. movw %ax,%dx
  670. movl $0,%eax
  671. xchgl %edx,%eax
  672. leave
  673. ret
  674. .LDISKSIZE1:
  675. cltd
  676. leave
  677. ret
  678. end
  679. else
  680. {In OS/2, we use the filesystem information.}
  681. begin
  682. RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
  683. if RC = 0 then
  684. DiskSize := int64 (FI.Total_Clusters) *
  685. int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
  686. else
  687. DiskSize := -1;
  688. end;
  689. end;
  690. function GetCurrentDir: string;
  691. begin
  692. GetDir (0, Result);
  693. end;
  694. function SetCurrentDir (const NewDir: string): boolean;
  695. begin
  696. {$I-}
  697. ChDir (NewDir);
  698. Result := (IOResult = 0);
  699. {$I+}
  700. end;
  701. function CreateDir (const NewDir: string): boolean;
  702. begin
  703. {$I-}
  704. MkDir (NewDir);
  705. Result := (IOResult = 0);
  706. {$I+}
  707. end;
  708. function RemoveDir (const Dir: string): boolean;
  709. begin
  710. {$I-}
  711. RmDir (Dir);
  712. Result := (IOResult = 0);
  713. {$I+}
  714. end;
  715. {****************************************************************************
  716. Time Functions
  717. ****************************************************************************}
  718. {$asmmode intel}
  719. procedure GetLocalTime (var SystemTime: TSystemTime); assembler;
  720. asm
  721. (* Expects the default record alignment (word)!!! *)
  722. mov ah, 2Ah
  723. call syscall
  724. mov edi, SystemTime
  725. mov ax, cx
  726. stosw
  727. xor eax, eax
  728. mov al, dl
  729. shl eax, 16
  730. mov al, dh
  731. stosd
  732. push edi
  733. mov ah, 2Ch
  734. call syscall
  735. pop edi
  736. xor eax, eax
  737. mov al, cl
  738. shl eax, 16
  739. mov al, ch
  740. stosd
  741. mov al, dl
  742. shl eax, 16
  743. mov al, dh
  744. stosd
  745. end;
  746. {$asmmode default}
  747. {****************************************************************************
  748. Misc Functions
  749. ****************************************************************************}
  750. procedure Beep;
  751. begin
  752. end;
  753. {****************************************************************************
  754. Locale Functions
  755. ****************************************************************************}
  756. procedure InitAnsi;
  757. var I: byte;
  758. Country: TCountryCode;
  759. begin
  760. for I := 0 to 255 do
  761. UpperCaseTable [I] := Chr (I);
  762. Move (UpperCaseTable, LowerCaseTable, SizeOf (UpperCaseTable));
  763. if os_mode = osOS2 then
  764. begin
  765. FillChar (Country, SizeOf (Country), 0);
  766. DosMapCase (SizeOf (UpperCaseTable), Country, @UpperCaseTable);
  767. end
  768. else
  769. begin
  770. (* !!! TODO: DOS/DPMI mode support!!! *)
  771. end;
  772. for I := 0 to 255 do
  773. if UpperCaseTable [I] <> Chr (I) then
  774. LowerCaseTable [Ord (UpperCaseTable [I])] := Chr (I);
  775. end;
  776. procedure InitInternational;
  777. var Country: TCountryCode;
  778. CtryInfo: TCountryInfo;
  779. Size: longint;
  780. RC: longint;
  781. begin
  782. Size := 0;
  783. FillChar (Country, SizeOf (Country), 0);
  784. FillChar (CtryInfo, SizeOf (CtryInfo), 0);
  785. RC := DosQueryCtryInfo (SizeOf (CtryInfo), Country, CtryInfo, Size);
  786. if RC = 0 then
  787. begin
  788. DateSeparator := CtryInfo.DateSeparator;
  789. case CtryInfo.DateFormat of
  790. 1: begin
  791. ShortDateFormat := 'd/m/y';
  792. LongDateFormat := 'dd" "mmmm" "yyyy';
  793. end;
  794. 2: begin
  795. ShortDateFormat := 'y/m/d';
  796. LongDateFormat := 'yyyy" "mmmm" "dd';
  797. end;
  798. 3: begin
  799. ShortDateFormat := 'm/d/y';
  800. LongDateFormat := 'mmmm" "dd" "yyyy';
  801. end;
  802. end;
  803. TimeSeparator := CtryInfo.TimeSeparator;
  804. DecimalSeparator := CtryInfo.DecimalSeparator;
  805. ThousandSeparator := CtryInfo.ThousandSeparator;
  806. CurrencyFormat := CtryInfo.CurrencyFormat;
  807. CurrencyString := PChar (CtryInfo.CurrencyUnit);
  808. end;
  809. InitAnsi;
  810. end;
  811. function SysErrorMessage(ErrorCode: Integer): String;
  812. begin
  813. Result:=Format(SUnknownErrorCode,[ErrorCode]);
  814. end;
  815. {****************************************************************************
  816. OS Utils
  817. ****************************************************************************}
  818. Function GetEnvironmentVariable(Const EnvVar : String) : String;
  819. var P: PChar;
  820. begin
  821. if DosScanEnv (PChar (EnvVar), P) = 0
  822. then GetEnvironmentVariable := StrPas (P)
  823. else GetEnvironmentVariable := '';
  824. end;
  825. {****************************************************************************
  826. Initialization code
  827. ****************************************************************************}
  828. Initialization
  829. InitExceptions; { Initialize exceptions. OS independent }
  830. InitInternational; { Initialize internationalization settings }
  831. Finalization
  832. DoneExceptions;
  833. end.
  834. {
  835. $Log$
  836. Revision 1.16 2002-07-11 16:00:05 hajny
  837. * FindFirst fix (invalid attribute bits masked out)
  838. Revision 1.15 2002/01/25 16:23:03 peter
  839. * merged filesearch() fix
  840. Revision 1.14 2001/12/16 19:08:20 hajny
  841. * uses DosCalls replaced with direct declarations
  842. Revision 1.13 2001/10/25 21:23:49 peter
  843. * added 64bit fileseek
  844. Revision 1.12 2001/06/03 15:18:01 peter
  845. * eoutofmemory and einvalidpointer fix
  846. Revision 1.11 2001/05/21 20:50:19 hajny
  847. * silly mistyping corrected
  848. Revision 1.10 2001/05/20 18:40:33 hajny
  849. * merging Carl's fixes from the fixes branch
  850. Revision 1.9 2001/02/21 21:23:38 hajny
  851. * GetEnvironmentVariable now really merged
  852. Revision 1.8 2001/02/20 22:14:19 peter
  853. * merged getenvironmentvariable
  854. Revision 1.7 2001/01/13 11:10:59 hajny
  855. * FileCreate and GetLocalTime fixed
  856. Revision 1.6 2000/10/15 20:44:18 hajny
  857. * FindClose correction
  858. Revision 1.5 2000/09/29 21:49:41 jonas
  859. * removed warnings
  860. Revision 1.4 2000/08/30 06:30:55 michael
  861. + Merged syserrormsg fix
  862. Revision 1.3 2000/08/25 17:23:56 hajny
  863. * Sharing mode error fixed
  864. Revision 1.2 2000/08/20 15:46:46 peter
  865. * sysutils.pp moved to target and merged with disk.inc, filutil.inc
  866. Revision 1.1.2.3 2000/08/25 17:20:57 hajny
  867. * Sharing mode error fixed
  868. Revision 1.1.2.2 2000/08/22 19:21:48 michael
  869. + Implemented syserrormessage. Made dummies for go32v2 and OS/2
  870. * Changed linux/errors.pp so it uses pchars for storage.
  871. Revision 1.1.2.1 2000/08/20 15:08:32 peter
  872. * forgot the add command :(
  873. }