sysutils.pp 34 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047
  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. {$DEFINE HAS_SLEEP}
  21. { Include platform independent interface part }
  22. {$i sysutilh.inc}
  23. implementation
  24. uses
  25. sysconst;
  26. { Include platform independent implementation part }
  27. {$i sysutils.inc}
  28. {****************************************************************************
  29. System (imported) calls
  30. ****************************************************************************}
  31. (* "uses DosCalls" could not be used here due to type *)
  32. (* conflicts, so needed parts had to be redefined here). *)
  33. type
  34. TFileStatus = object
  35. end;
  36. PFileStatus = ^TFileStatus;
  37. TFileStatus3 = object (TFileStatus)
  38. DateCreation, {Date of file creation.}
  39. TimeCreation, {Time of file creation.}
  40. DateLastAccess, {Date of last access to file.}
  41. TimeLastAccess, {Time of last access to file.}
  42. DateLastWrite, {Date of last modification of file.}
  43. TimeLastWrite:word; {Time of last modification of file.}
  44. FileSize, {Size of file.}
  45. FileAlloc:cardinal; {Amount of space the file really
  46. occupies on disk.}
  47. AttrFile:cardinal; {Attributes of file.}
  48. end;
  49. PFileStatus3=^TFileStatus3;
  50. TFileStatus4=object(TFileStatus3)
  51. cbList:cardinal; {Length of entire EA set.}
  52. end;
  53. PFileStatus4=^TFileStatus4;
  54. TFileFindBuf3=object(TFileStatus)
  55. NextEntryOffset: cardinal; {Offset of next entry}
  56. DateCreation, {Date of file creation.}
  57. TimeCreation, {Time of file creation.}
  58. DateLastAccess, {Date of last access to file.}
  59. TimeLastAccess, {Time of last access to file.}
  60. DateLastWrite, {Date of last modification of file.}
  61. TimeLastWrite:word; {Time of last modification of file.}
  62. FileSize, {Size of file.}
  63. FileAlloc:cardinal; {Amount of space the file really
  64. occupies on disk.}
  65. AttrFile:cardinal; {Attributes of file.}
  66. Name:shortstring; {Also possible to use as ASCIIZ.
  67. The byte following the last string
  68. character is always zero.}
  69. end;
  70. PFileFindBuf3=^TFileFindBuf3;
  71. TFileFindBuf4=object(TFileStatus)
  72. NextEntryOffset: cardinal; {Offset of next entry}
  73. DateCreation, {Date of file creation.}
  74. TimeCreation, {Time of file creation.}
  75. DateLastAccess, {Date of last access to file.}
  76. TimeLastAccess, {Time of last access to file.}
  77. DateLastWrite, {Date of last modification of file.}
  78. TimeLastWrite:word; {Time of last modification of file.}
  79. FileSize, {Size of file.}
  80. FileAlloc:cardinal; {Amount of space the file really
  81. occupies on disk.}
  82. AttrFile:cardinal; {Attributes of file.}
  83. cbList:longint; {Size of the file's extended attributes.}
  84. Name:shortstring; {Also possible to use as ASCIIZ.
  85. The byte following the last string
  86. character is always zero.}
  87. end;
  88. PFileFindBuf4=^TFileFindBuf4;
  89. TFSInfo = record
  90. case word of
  91. 1:
  92. (File_Sys_ID,
  93. Sectors_Per_Cluster,
  94. Total_Clusters,
  95. Free_Clusters: cardinal;
  96. Bytes_Per_Sector: word);
  97. 2: {For date/time description,
  98. see file searching realted
  99. routines.}
  100. (Label_Date, {Date when volume label was created.}
  101. Label_Time: word; {Time when volume label was created.}
  102. VolumeLabel: ShortString); {Volume label. Can also be used
  103. as ASCIIZ, because the byte
  104. following the last character of
  105. the string is always zero.}
  106. end;
  107. PFSInfo = ^TFSInfo;
  108. TCountryCode=record
  109. Country, {Country to query info about (0=current).}
  110. CodePage: cardinal; {Code page to query info about (0=current).}
  111. end;
  112. PCountryCode=^TCountryCode;
  113. TTimeFmt = (Clock12, Clock24);
  114. TCountryInfo=record
  115. Country, CodePage: cardinal; {Country and codepage requested.}
  116. case byte of
  117. 0:
  118. (DateFormat: cardinal; {1=ddmmyy 2=yymmdd 3=mmddyy}
  119. CurrencyUnit: array [0..4] of char;
  120. ThousandSeparator: char; {Thousands separator.}
  121. Zero1: byte; {Always zero.}
  122. DecimalSeparator: char; {Decimals separator,}
  123. Zero2: byte;
  124. DateSeparator: char; {Date separator.}
  125. Zero3: byte;
  126. TimeSeparator: char; {Time separator.}
  127. Zero4: byte;
  128. CurrencyFormat, {Bit field:
  129. Bit 0: 0=indicator before value
  130. 1=indicator after value
  131. Bit 1: 1=insert space after
  132. indicator.
  133. Bit 2: 1=Ignore bit 0&1, replace
  134. decimal separator with
  135. indicator.}
  136. DecimalPlace: byte; {Number of decimal places used in
  137. currency indication.}
  138. TimeFormat: TTimeFmt; {12/24 hour.}
  139. Reserve1: array [0..1] of word;
  140. DataSeparator: char; {Data list separator}
  141. Zero5: byte;
  142. Reserve2: array [0..4] of word);
  143. 1:
  144. (fsDateFmt: cardinal; {1=ddmmyy 2=yymmdd 3=mmddyy}
  145. szCurrency: array [0..4] of char;
  146. {null terminated currency symbol}
  147. szThousandsSeparator: array [0..1] of char;
  148. {Thousands separator + #0}
  149. szDecimal: array [0..1] of char;
  150. {Decimals separator + #0}
  151. szDateSeparator: array [0..1] of char;
  152. {Date separator + #0}
  153. szTimeSeparator: array [0..1] of char;
  154. {Time separator + #0}
  155. fsCurrencyFmt, {Bit field:
  156. Bit 0: 0=indicator before value
  157. 1=indicator after value
  158. Bit 1: 1=insert space after
  159. indicator.
  160. Bit 2: 1=Ignore bit 0&1, replace
  161. decimal separator with
  162. indicator}
  163. cDecimalPlace: byte; {Number of decimal places used in
  164. currency indication}
  165. fsTimeFmt: byte; {0=12,1=24 hours}
  166. abReserved1: array [0..1] of word;
  167. szDataSeparator: array [0..1] of char;
  168. {Data list separator + #0}
  169. abReserved2: array [0..4] of word);
  170. end;
  171. PCountryInfo=^TCountryInfo;
  172. TRequestData=record
  173. PID, {ID of process that wrote element.}
  174. Data: cardinal; {Information from process writing the data.}
  175. end;
  176. PRequestData=^TRequestData;
  177. {Queue data structure for synchronously started sessions.}
  178. TChildInfo = record
  179. case boolean of
  180. false:
  181. (SessionID,
  182. Return: word); {Return code from the child process.}
  183. true:
  184. (usSessionID,
  185. usReturn: word); {Return code from the child process.}
  186. end;
  187. PChildInfo = ^TChildInfo;
  188. TStartData=record
  189. {Note: to omit some fields, use a length smaller than SizeOf(TStartData).}
  190. Length:word; {Length, in bytes, of datastructure
  191. (24/30/32/50/60).}
  192. Related:word; {Independent/child session (0/1).}
  193. FgBg:word; {Foreground/background (0/1).}
  194. TraceOpt:word; {No trace/trace this/trace all (0/1/2).}
  195. PgmTitle:PChar; {Program title.}
  196. PgmName:PChar; {Filename to program.}
  197. PgmInputs:PChar; {Command parameters (nil allowed).}
  198. TermQ:PChar; {System queue. (nil allowed).}
  199. Environment:PChar; {Environment to pass (nil allowed).}
  200. InheritOpt:word; {Inherit enviroment from shell/
  201. inherit environment from parent (0/1).}
  202. SessionType:word; {Auto/full screen/window/presentation
  203. manager/full screen Dos/windowed Dos
  204. (0/1/2/3/4/5/6/7).}
  205. Iconfile:PChar; {Icon file to use (nil allowed).}
  206. PgmHandle:cardinal; {0 or the program handle.}
  207. PgmControl:word; {Bitfield describing initial state
  208. of windowed sessions.}
  209. InitXPos,InitYPos:word; {Initial top coordinates.}
  210. InitXSize,InitYSize:word; {Initial size.}
  211. Reserved:word;
  212. ObjectBuffer:PChar; {If a module cannot be loaded, its
  213. name will be returned here.}
  214. ObjectBuffLen:cardinal; {Size of your buffer.}
  215. end;
  216. PStartData=^TStartData;
  217. const
  218. ilStandard = 1;
  219. ilQueryEAsize = 2;
  220. ilQueryEAs = 3;
  221. ilQueryFullName = 5;
  222. quFIFO = 0;
  223. quLIFO = 1;
  224. quPriority = 2;
  225. quNoConvert_Address = 0;
  226. quConvert_Address = 4;
  227. {Start the new session independent or as a child.}
  228. ssf_Related_Independent = 0; {Start new session independent
  229. of the calling session.}
  230. ssf_Related_Child = 1; {Start new session as a child
  231. session to the calling session.}
  232. {Start the new session in the foreground or in the background.}
  233. ssf_FgBg_Fore = 0; {Start new session in foreground.}
  234. ssf_FgBg_Back = 1; {Start new session in background.}
  235. {Should the program started in the new session
  236. be executed under conditions for tracing?}
  237. ssf_TraceOpt_None = 0; {No trace.}
  238. ssf_TraceOpt_Trace = 1; {Trace with no notification
  239. of descendants.}
  240. ssf_TraceOpt_TraceAll = 2; {Trace all descendant sessions.
  241. A termination queue must be
  242. supplied and Related must be
  243. ssf_Related_Child (=1).}
  244. {Will the new session inherit open file handles
  245. and environment from the calling process.}
  246. ssf_InhertOpt_Shell = 0; {Inherit from the shell.}
  247. ssf_InhertOpt_Parent = 1; {Inherit from the calling process.}
  248. {Specifies the type of session to start.}
  249. ssf_Type_Default = 0; {Use program's type.}
  250. ssf_Type_FullScreen = 1; {OS/2 full screen.}
  251. ssf_Type_WindowableVIO = 2; {OS/2 window.}
  252. ssf_Type_PM = 3; {Presentation Manager.}
  253. ssf_Type_VDM = 4; {DOS full screen.}
  254. ssf_Type_WindowedVDM = 7; {DOS window.}
  255. {Additional values for Windows programs}
  256. Prog_31_StdSeamlessVDM = 15; {Windows 3.1 program in its
  257. own windowed session.}
  258. Prog_31_StdSeamlessCommon = 16; {Windows 3.1 program in a
  259. common windowed session.}
  260. Prog_31_EnhSeamlessVDM = 17; {Windows 3.1 program in enhanced
  261. compatibility mode in its own
  262. windowed session.}
  263. Prog_31_EnhSeamlessCommon = 18; {Windows 3.1 program in enhanced
  264. compatibility mode in a common
  265. windowed session.}
  266. Prog_31_Enh = 19; {Windows 3.1 program in enhanced
  267. compatibility mode in a full
  268. screen session.}
  269. Prog_31_Std = 20; {Windows 3.1 program in a full
  270. screen session.}
  271. {Specifies the initial attributes for a OS/2 window or DOS window session.}
  272. ssf_Control_Visible = 0; {Window is visible.}
  273. ssf_Control_Invisible = 1; {Window is invisible.}
  274. ssf_Control_Maximize = 2; {Window is maximized.}
  275. ssf_Control_Minimize = 4; {Window is minimized.}
  276. ssf_Control_NoAutoClose = 8; {Window will not close after
  277. the program has ended.}
  278. ssf_Control_SetPos = 32768; {Use InitXPos, InitYPos,
  279. InitXSize, and InitYSize for
  280. the size and placement.}
  281. function DosSetFileInfo (Handle: THandle; InfoLevel: cardinal; AFileStatus: PFileStatus;
  282. FileStatusLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 218;
  283. function DosQueryFSInfo (DiskNum, InfoLevel: cardinal; var Buffer: TFSInfo;
  284. BufLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 278;
  285. function DosQueryFileInfo (Handle: THandle; InfoLevel: cardinal;
  286. AFileStatus: PFileStatus; FileStatusLen: cardinal): cardinal; cdecl;
  287. external 'DOSCALLS' index 279;
  288. function DosScanEnv (Name: PChar; var Value: PChar): cardinal; cdecl;
  289. external 'DOSCALLS' index 227;
  290. function DosFindFirst (FileMask: PChar; var Handle: THandle; Attrib: cardinal;
  291. AFileStatus: PFileStatus; FileStatusLen: cardinal;
  292. var Count: cardinal; InfoLevel: cardinal): cardinal; cdecl;
  293. external 'DOSCALLS' index 264;
  294. function DosFindNext (Handle: THandle; AFileStatus: PFileStatus;
  295. FileStatusLen: cardinal; var Count: cardinal): cardinal; cdecl;
  296. external 'DOSCALLS' index 265;
  297. function DosFindClose (Handle: THandle): cardinal; cdecl;
  298. external 'DOSCALLS' index 263;
  299. function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode;
  300. var Res: TCountryInfo; var ActualSize: cardinal): cardinal; cdecl;
  301. external 'NLS' index 5;
  302. function DosMapCase (Size: cardinal; var Country: TCountryCode;
  303. AString: PChar): cardinal; cdecl; external 'NLS' index 7;
  304. function DosDelete(FileName:PChar): cardinal; cdecl;
  305. external 'DOSCALLS' index 259;
  306. function DosMove(OldFile, NewFile:PChar): cardinal; cdecl;
  307. external 'DOSCALLS' index 271;
  308. function DosQueryPathInfo(FileName:PChar;InfoLevel:cardinal;
  309. AFileStatus:PFileStatus;FileStatusLen:cardinal): cardinal; cdecl;
  310. external 'DOSCALLS' index 223;
  311. function DosSetPathInfo(FileName:PChar;InfoLevel:cardinal;
  312. AFileStatus:PFileStatus;FileStatusLen,
  313. Options:cardinal):cardinal; cdecl;
  314. external 'DOSCALLS' index 219;
  315. function DosOpen(FileName:PChar;var Handle: THandle; var Action: cardinal;
  316. InitSize,Attrib,OpenFlags,FileMode:cardinal;
  317. EA:Pointer):cardinal; cdecl;
  318. external 'DOSCALLS' index 273;
  319. function DosClose(Handle: THandle): cardinal; cdecl;
  320. external 'DOSCALLS' index 257;
  321. function DosRead(Handle:THandle; var Buffer; Count: cardinal;
  322. var ActCount: cardinal): cardinal; cdecl;
  323. external 'DOSCALLS' index 281;
  324. function DosWrite(Handle: THandle; Buffer: pointer; Count: cardinal;
  325. var ActCount: cardinal): cardinal; cdecl;
  326. external 'DOSCALLS' index 282;
  327. function DosSetFilePtr(Handle: THandle; Pos: longint; Method: cardinal;
  328. var PosActual: cardinal): cardinal; cdecl;
  329. external 'DOSCALLS' index 256;
  330. function DosSetFileSize (Handle: THandle; Size: cardinal): cardinal; cdecl;
  331. external 'DOSCALLS' index 272;
  332. procedure DosSleep (MSec: cardinal); cdecl; external 'DOSCALLS' index 229;
  333. function DosCreateQueue (var Handle: THandle; Priority:longint;
  334. Name: PChar): cardinal; cdecl;
  335. external 'QUECALLS' index 16;
  336. function DosReadQueue (Handle: THandle; var ReqBuffer: TRequestData;
  337. var DataLen: cardinal; var DataPtr: pointer;
  338. Element, Wait: cardinal; var Priority: byte;
  339. ASem: THandle): cardinal; cdecl;
  340. external 'QUECALLS' index 9;
  341. function DosCloseQueue (Handle: THandle): cardinal; cdecl;
  342. external 'QUECALLS' index 11;
  343. function DosStartSession (var AStartData: TStartData;
  344. var SesID, PID: cardinal): cardinal; cdecl;
  345. external 'SESMGR' index 37;
  346. function DosFreeMem(P:pointer):cardinal; cdecl; external 'DOSCALLS' index 304;
  347. type
  348. TDT=packed record
  349. Hour,
  350. Minute,
  351. Second,
  352. Sec100,
  353. Day,
  354. Month: byte;
  355. Year: word;
  356. TimeZone: smallint;
  357. WeekDay: byte;
  358. end;
  359. function DosGetDateTime(var Buf: TDT): cardinal; cdecl;
  360. external 'DOSCALLS' index 230;
  361. {****************************************************************************
  362. File Functions
  363. ****************************************************************************}
  364. const
  365. ofRead = $0000; {Open for reading}
  366. ofWrite = $0001; {Open for writing}
  367. ofReadWrite = $0002; {Open for reading/writing}
  368. doDenyRW = $0010; {DenyAll (no sharing)}
  369. faCreateNew = $00010000; {Create if file does not exist}
  370. faOpenReplace = $00040000; {Truncate if file exists}
  371. faCreate = $00050000; {Create if file does not exist, truncate otherwise}
  372. FindResvdMask = $00003737; {Allowed bits in attribute
  373. specification for DosFindFirst call.}
  374. function FileOpen (const FileName: string; Mode: integer): longint;
  375. Var
  376. Handle: THandle;
  377. Rc, Action: cardinal;
  378. begin
  379. (* DenyNone if sharing not specified. *)
  380. if Mode and 112 = 0 then Mode:=Mode or 64;
  381. Rc:=DosOpen(PChar (FileName), Handle, Action, 0, 0, 1, Mode, nil);
  382. If Rc=0 then
  383. FileOpen:=Handle
  384. else
  385. FileOpen:=-RC;
  386. end;
  387. function FileCreate (const FileName: string): longint;
  388. Const
  389. Mode = ofReadWrite or faCreate or doDenyRW; (* Sharing to DenyAll *)
  390. Var
  391. Handle: THandle;
  392. RC, Action: cardinal;
  393. Begin
  394. RC:=DosOpen(PChar (FileName), Handle, Action, 0, 0, $12, Mode, Nil);
  395. If RC=0 then
  396. FileCreate:=Handle
  397. else
  398. FileCreate:=-RC;
  399. End;
  400. function FileCreate (const FileName: string; Mode: integer): longint;
  401. begin
  402. FileCreate := FileCreate(FileName);
  403. end;
  404. function FileRead (Handle: longint; var Buffer; Count: longint): longint;
  405. Var
  406. T: cardinal;
  407. begin
  408. DosRead(Handle, Buffer, Count, T);
  409. FileRead := longint (T);
  410. end;
  411. function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
  412. Var
  413. T: cardinal;
  414. begin
  415. DosWrite (Handle, @Buffer, Count, T);
  416. FileWrite := longint (T);
  417. end;
  418. function FileSeek (Handle, FOffset, Origin: longint): longint;
  419. var
  420. npos: cardinal;
  421. begin
  422. if DosSetFilePtr (Handle, FOffset, Origin, npos) = 0 Then
  423. FileSeek:= longint (npos)
  424. else
  425. FileSeek:=-1;
  426. end;
  427. function FileSeek (Handle: longint; FOffset, Origin: Int64): Int64;
  428. begin
  429. {$warning need to add 64bit call }
  430. Result:=FileSeek(Handle,Longint(Foffset),Longint(Origin));
  431. end;
  432. procedure FileClose (Handle: longint);
  433. begin
  434. DosClose(Handle);
  435. end;
  436. function FileTruncate (Handle, Size: longint): boolean;
  437. begin
  438. FileTruncate:=DosSetFileSize(Handle, Size)=0;
  439. FileSeek(Handle, 0, 2);
  440. end;
  441. function FileAge (const FileName: string): longint;
  442. var Handle: longint;
  443. begin
  444. Handle := FileOpen (FileName, 0);
  445. if Handle <> -1 then
  446. begin
  447. Result := FileGetDate (Handle);
  448. FileClose (Handle);
  449. end
  450. else
  451. Result := -1;
  452. end;
  453. function FileExists (const FileName: string): boolean;
  454. var
  455. SR: TSearchRec;
  456. RC: longint;
  457. begin
  458. FileExists:=False;
  459. if FindFirst (FileName, faAnyFile, SR)=0 then FileExists:=True;
  460. FindClose(SR);
  461. end;
  462. type TRec = record
  463. T, D: word;
  464. end;
  465. PSearchRec = ^SearchRec;
  466. function FindFirst (const Path: string; Attr: longint; var Rslt: TSearchRec): longint;
  467. var SR: PSearchRec;
  468. FStat: PFileFindBuf3;
  469. Count: cardinal;
  470. Err: cardinal;
  471. I: cardinal;
  472. begin
  473. New (FStat);
  474. Rslt.FindHandle := $FFFFFFFF;
  475. Count := 1;
  476. Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
  477. Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, ilStandard);
  478. if (Err = 0) and (Count = 0) then Err := 18;
  479. FindFirst := -Err;
  480. if Err = 0 then
  481. begin
  482. Rslt.Name := FStat^.Name;
  483. Rslt.Size := FStat^.FileSize;
  484. Rslt.Attr := FStat^.AttrFile;
  485. Rslt.ExcludeAttr := 0;
  486. TRec (Rslt.Time).T := FStat^.TimeLastWrite;
  487. TRec (Rslt.Time).D := FStat^.DateLastWrite;
  488. end;
  489. Dispose (FStat);
  490. end;
  491. function FindNext (var Rslt: TSearchRec): longint;
  492. var
  493. SR: PSearchRec;
  494. FStat: PFileFindBuf3;
  495. Count: cardinal;
  496. Err: cardinal;
  497. begin
  498. New (FStat);
  499. Count := 1;
  500. Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^),
  501. Count);
  502. if (Err = 0) and (Count = 0) then Err := 18;
  503. FindNext := -Err;
  504. if Err = 0 then
  505. begin
  506. Rslt.Name := FStat^.Name;
  507. Rslt.Size := FStat^.FileSize;
  508. Rslt.Attr := FStat^.AttrFile;
  509. Rslt.ExcludeAttr := 0;
  510. TRec (Rslt.Time).T := FStat^.TimeLastWrite;
  511. TRec (Rslt.Time).D := FStat^.DateLastWrite;
  512. end;
  513. Dispose (FStat);
  514. end;
  515. procedure FindClose (var F: TSearchrec);
  516. var
  517. SR: PSearchRec;
  518. begin
  519. DosFindClose (F.FindHandle);
  520. F.FindHandle := 0;
  521. end;
  522. function FileGetDate (Handle: longint): longint;
  523. var
  524. FStat: TFileStatus3;
  525. Time: Longint;
  526. begin
  527. DosError := DosQueryFileInfo(Handle, ilStandard, @FStat, SizeOf(FStat));
  528. if DosError=0 then
  529. begin
  530. Time := FStat.TimeLastWrite + longint (FStat.DateLastWrite) shl 16;
  531. if Time = 0 then
  532. Time := FStat.TimeCreation + longint (FStat.DateCreation) shl 16;
  533. end else
  534. Time:=0;
  535. FileGetDate:=Time;
  536. end;
  537. function FileSetDate (Handle, Age: longint): longint;
  538. var
  539. FStat: PFileStatus3;
  540. RC: cardinal;
  541. begin
  542. New (FStat);
  543. RC := DosQueryFileInfo (Handle, ilStandard, FStat, SizeOf (FStat^));
  544. if RC <> 0 then
  545. FileSetDate := -1
  546. else
  547. begin
  548. FStat^.DateLastAccess := Hi (Age);
  549. FStat^.DateLastWrite := Hi (Age);
  550. FStat^.TimeLastAccess := Lo (Age);
  551. FStat^.TimeLastWrite := Lo (Age);
  552. RC := DosSetFileInfo (Handle, ilStandard, FStat, SizeOf (FStat^));
  553. if RC <> 0 then
  554. FileSetDate := -1
  555. else
  556. FileSetDate := 0;
  557. end;
  558. Dispose (FStat);
  559. end;
  560. function FileGetAttr (const FileName: string): longint;
  561. var
  562. FS: PFileStatus3;
  563. begin
  564. New(FS);
  565. Result:=-DosQueryPathInfo(PChar (FileName), ilStandard, FS, SizeOf(FS^));
  566. If Result=0 Then Result:=FS^.attrFile;
  567. Dispose(FS);
  568. end;
  569. function FileSetAttr (const Filename: string; Attr: longint): longint;
  570. Var
  571. FS: PFileStatus3;
  572. Begin
  573. New(FS);
  574. FillChar(FS, SizeOf(FS^), 0);
  575. FS^.AttrFile:=Attr;
  576. Result:=-DosSetPathInfo(PChar (FileName), ilStandard, FS, SizeOf(FS^), 0);
  577. Dispose(FS);
  578. end;
  579. function DeleteFile (const FileName: string): boolean;
  580. Begin
  581. Result:=(DosDelete(PChar (FileName))=0);
  582. End;
  583. function RenameFile (const OldName, NewName: string): boolean;
  584. Begin
  585. Result:=(DosMove(PChar (OldName), PChar (NewName))=0);
  586. End;
  587. {****************************************************************************
  588. Disk Functions
  589. ****************************************************************************}
  590. function DiskFree (Drive: byte): int64;
  591. var FI: TFSinfo;
  592. RC: cardinal;
  593. begin
  594. {In OS/2, we use the filesystem information.}
  595. RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
  596. if RC = 0 then
  597. DiskFree := int64 (FI.Free_Clusters) *
  598. int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
  599. else
  600. DiskFree := -1;
  601. end;
  602. function DiskSize (Drive: byte): int64;
  603. var FI: TFSinfo;
  604. RC: cardinal;
  605. begin
  606. {In OS/2, we use the filesystem information.}
  607. RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
  608. if RC = 0 then
  609. DiskSize := int64 (FI.Total_Clusters) *
  610. int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
  611. else
  612. DiskSize := -1;
  613. end;
  614. function GetCurrentDir: string;
  615. begin
  616. GetDir (0, Result);
  617. end;
  618. function SetCurrentDir (const NewDir: string): boolean;
  619. begin
  620. {$I-}
  621. {$WARNING Should be rewritten to avoid unit dos dependancy!}
  622. ChDir (NewDir);
  623. Result := (IOResult = 0);
  624. {$I+}
  625. end;
  626. function CreateDir (const NewDir: string): boolean;
  627. begin
  628. {$I-}
  629. {$WARNING Should be rewritten to avoid unit dos dependancy!}
  630. MkDir (NewDir);
  631. Result := (IOResult = 0);
  632. {$I+}
  633. end;
  634. function RemoveDir (const Dir: string): boolean;
  635. begin
  636. {$I-}
  637. {$WARNING Should be rewritten to avoid unit dos dependancy!}
  638. RmDir (Dir);
  639. Result := (IOResult = 0);
  640. {$I+}
  641. end;
  642. function DirectoryExists (const Directory: string): boolean;
  643. var
  644. SR: TSearchRec;
  645. begin
  646. DirectoryExists:=FindFirst(Directory, faDirectory, SR)=0;
  647. FindClose(SR);
  648. end;
  649. {****************************************************************************
  650. Time Functions
  651. ****************************************************************************}
  652. procedure GetLocalTime (var SystemTime: TSystemTime);
  653. var
  654. DT: TDT;
  655. begin
  656. DosGetDateTime(DT);
  657. with SystemTime do
  658. begin
  659. Year:=DT.Year;
  660. Month:=DT.Month;
  661. Day:=DT.Day;
  662. Hour:=DT.Hour;
  663. Minute:=DT.Minute;
  664. Second:=DT.Second;
  665. MilliSecond:=DT.Sec100;
  666. end;
  667. end;
  668. {****************************************************************************
  669. Misc Functions
  670. ****************************************************************************}
  671. procedure Beep;
  672. begin
  673. end;
  674. {****************************************************************************
  675. Locale Functions
  676. ****************************************************************************}
  677. procedure InitAnsi;
  678. var I: byte;
  679. Country: TCountryCode;
  680. begin
  681. for I := 0 to 255 do
  682. UpperCaseTable [I] := Chr (I);
  683. Move (UpperCaseTable, LowerCaseTable, SizeOf (UpperCaseTable));
  684. FillChar (Country, SizeOf (Country), 0);
  685. DosMapCase (SizeOf (UpperCaseTable), Country, @UpperCaseTable);
  686. for I := 0 to 255 do
  687. if UpperCaseTable [I] <> Chr (I) then
  688. LowerCaseTable [Ord (UpperCaseTable [I])] := Chr (I);
  689. end;
  690. procedure InitInternational;
  691. var Country: TCountryCode;
  692. CtryInfo: TCountryInfo;
  693. Size: cardinal;
  694. RC: cardinal;
  695. begin
  696. Size := 0;
  697. FillChar (Country, SizeOf (Country), 0);
  698. FillChar (CtryInfo, SizeOf (CtryInfo), 0);
  699. RC := DosQueryCtryInfo (SizeOf (CtryInfo), Country, CtryInfo, Size);
  700. if RC = 0 then
  701. begin
  702. DateSeparator := CtryInfo.DateSeparator;
  703. case CtryInfo.DateFormat of
  704. 1: begin
  705. ShortDateFormat := 'd/m/y';
  706. LongDateFormat := 'dd" "mmmm" "yyyy';
  707. end;
  708. 2: begin
  709. ShortDateFormat := 'y/m/d';
  710. LongDateFormat := 'yyyy" "mmmm" "dd';
  711. end;
  712. 3: begin
  713. ShortDateFormat := 'm/d/y';
  714. LongDateFormat := 'mmmm" "dd" "yyyy';
  715. end;
  716. end;
  717. TimeSeparator := CtryInfo.TimeSeparator;
  718. DecimalSeparator := CtryInfo.DecimalSeparator;
  719. ThousandSeparator := CtryInfo.ThousandSeparator;
  720. CurrencyFormat := CtryInfo.CurrencyFormat;
  721. CurrencyString := PChar (CtryInfo.CurrencyUnit);
  722. end;
  723. InitAnsi;
  724. end;
  725. function SysErrorMessage(ErrorCode: Integer): String;
  726. begin
  727. Result:=Format(SUnknownErrorCode,[ErrorCode]);
  728. end;
  729. {****************************************************************************
  730. OS Utils
  731. ****************************************************************************}
  732. Function GetEnvironmentVariable(Const EnvVar : String) : String;
  733. begin
  734. GetEnvironmentVariable := StrPas (GetEnvPChar (EnvVar));
  735. end;
  736. procedure Sleep (Milliseconds: cardinal);
  737. begin
  738. DosSleep (Milliseconds);
  739. end;
  740. function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString):
  741. integer;
  742. var
  743. HQ: THandle;
  744. SPID, STID, QName: shortstring;
  745. SD: TStartData;
  746. SID, PID: cardinal;
  747. RD: TRequestData;
  748. PCI: PChildInfo;
  749. CISize: cardinal;
  750. Prio: byte;
  751. E: EOSError;
  752. CommandLine: ansistring;
  753. begin
  754. FillChar (SD, SizeOf (SD), 0);
  755. SD.Length := 24;
  756. SD.Related := ssf_Related_Child;
  757. SD.PgmName := PChar (Path);
  758. SD.PgmInputs := PChar (ComLine);
  759. Str (ProcessID, SPID);
  760. Str (ThreadID, STID);
  761. QName := '\QUEUES\FPC_ExecuteProcess_p' + SPID + 't' + STID + '.QUE'#0;
  762. SD.TermQ := @QName [1];
  763. Result := DosCreateQueue (HQ, quFIFO or quConvert_Address, @QName [1]);
  764. if Result = 0 then
  765. begin
  766. Result := DosStartSession (SD, SID, PID);
  767. if (Result = 0) or (Result = 457) then
  768. begin
  769. Result := DosReadQueue (HQ, RD, CISize, PCI, 0, 0, Prio, 0);
  770. if Result = 0 then
  771. begin
  772. Result := PCI^.Return;
  773. DosCloseQueue (HQ);
  774. DosFreeMem (PCI);
  775. Exit;
  776. end;
  777. end;
  778. DosCloseQueue (HQ);
  779. end;
  780. if ComLine = '' then
  781. CommandLine := Path
  782. else
  783. CommandLine := Path + ' ' + ComLine;
  784. E := EOSError.CreateFmt (SExecuteProcessFailed, [CommandLine, Result]);
  785. E.ErrorCode := Result;
  786. raise E;
  787. end;
  788. function ExecuteProcess (const Path: AnsiString;
  789. const ComLine: array of AnsiString): integer;
  790. var
  791. CommandLine: AnsiString;
  792. I: integer;
  793. begin
  794. Commandline := '';
  795. for I := 0 to High (ComLine) do
  796. if Pos (' ', ComLine [I]) <> 0 then
  797. CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
  798. else
  799. CommandLine := CommandLine + ' ' + Comline [I];
  800. ExecuteProcess := ExecuteProcess (Path, CommandLine);
  801. end;
  802. {****************************************************************************
  803. Initialization code
  804. ****************************************************************************}
  805. Initialization
  806. InitExceptions; { Initialize exceptions. OS independent }
  807. InitInternational; { Initialize internationalization settings }
  808. Finalization
  809. DoneExceptions;
  810. end.
  811. {
  812. $Log$
  813. Revision 1.43 2004-02-22 15:01:49 hajny
  814. * lots of fixes (regcall, THandle, string operations in sysutils, longint2cardinal according to OS/2 docs, dosh.inc, ...)
  815. Revision 1.42 2004/02/15 21:36:10 hajny
  816. * overloaded ExecuteProcess added, EnvStr param changed to longint
  817. Revision 1.41 2004/02/15 08:02:44 yuri
  818. * fixes for dosh.inc
  819. * Executeprocess iverloaded function
  820. * updated todo
  821. Revision 1.40 2004/01/20 23:11:20 hajny
  822. * ExecuteProcess fixes, ProcessID and ThreadID added
  823. Revision 1.39 2003/11/26 20:00:19 florian
  824. * error handling for Variants improved
  825. Revision 1.38 2003/11/23 15:50:07 yuri
  826. * Now native
  827. Revision 1.37 2003/11/05 09:14:00 yuri
  828. * exec fix
  829. * unused units removed
  830. Revision 1.36 2003/10/27 12:19:20 yuri
  831. * GetLocatTime now also native
  832. Revision 1.35 2003/10/27 11:43:40 yuri
  833. * New set of native functions
  834. Revision 1.34 2003/10/18 16:58:39 hajny
  835. * stdcall fixes again
  836. Revision 1.33 2003/10/13 21:17:31 hajny
  837. * longint to cardinal corrections
  838. Revision 1.32 2003/10/08 05:22:47 yuri
  839. * Some emx code removed
  840. Revision 1.31 2003/10/07 21:26:34 hajny
  841. * stdcall fixes and asm routines cleanup
  842. Revision 1.30 2003/10/03 21:46:41 peter
  843. * stdcall fixes
  844. Revision 1.29 2003/06/06 23:34:40 hajny
  845. * better fix for bug 2518
  846. Revision 1.28 2003/06/06 23:31:17 hajny
  847. * fix for bug 2518 applied to OS/2 as well
  848. Revision 1.27 2003/04/01 15:57:41 peter
  849. * made THandle platform dependent and unique type
  850. Revision 1.26 2003/03/31 02:18:39 yuri
  851. FileClose bug fixed (again ;))
  852. Revision 1.25 2003/03/29 19:14:16 yuri
  853. * Directoryexists function header changed back.
  854. Revision 1.24 2003/03/29 18:53:10 yuri
  855. * Fixed DirectoryExists function header
  856. Revision 1.23 2003/03/29 15:01:20 hajny
  857. + DirectoryExists added for main branch OS/2 too
  858. Revision 1.22 2003/03/01 21:19:14 hajny
  859. * FileClose bug fixed
  860. Revision 1.21 2003/01/04 16:25:08 hajny
  861. * modified to make use of the common GetEnv code
  862. Revision 1.20 2003/01/03 20:41:04 peter
  863. * FileCreate(string,mode) overload added
  864. Revision 1.19 2002/11/18 19:51:00 hajny
  865. * another bunch of type corrections
  866. Revision 1.18 2002/09/23 17:42:37 hajny
  867. * AnsiString to PChar typecast
  868. Revision 1.17 2002/09/07 16:01:25 peter
  869. * old logs removed and tabs fixed
  870. Revision 1.16 2002/07/11 16:00:05 hajny
  871. * FindFirst fix (invalid attribute bits masked out)
  872. Revision 1.15 2002/01/25 16:23:03 peter
  873. * merged filesearch() fix
  874. }