sysutils.pp 28 KB

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