sysutils.pp 39 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2000 by Florian Klaempfl
  4. member of the Free Pascal development team
  5. Sysutils unit for OS/2
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. unit sysutils;
  13. interface
  14. {$MODE objfpc}
  15. {$MODESWITCH OUT}
  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. {$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
  27. {$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
  28. { Include platform independent implementation part }
  29. {$i sysutils.inc}
  30. {****************************************************************************
  31. System (imported) calls
  32. ****************************************************************************}
  33. (* "uses DosCalls" could not be used here due to type *)
  34. (* conflicts, so needed parts had to be redefined here). *)
  35. type
  36. TFileStatus = object
  37. end;
  38. PFileStatus = ^TFileStatus;
  39. TFileStatus3 = object (TFileStatus)
  40. DateCreation, {Date of file creation.}
  41. TimeCreation, {Time of file creation.}
  42. DateLastAccess, {Date of last access to file.}
  43. TimeLastAccess, {Time of last access to file.}
  44. DateLastWrite, {Date of last modification of file.}
  45. TimeLastWrite:word; {Time of last modification of file.}
  46. FileSize, {Size of file.}
  47. FileAlloc:cardinal; {Amount of space the file really
  48. occupies on disk.}
  49. AttrFile:cardinal; {Attributes of file.}
  50. end;
  51. PFileStatus3=^TFileStatus3;
  52. TFileStatus4=object(TFileStatus3)
  53. cbList:cardinal; {Length of entire EA set.}
  54. end;
  55. PFileStatus4=^TFileStatus4;
  56. TFileStatus3L = object (TFileStatus)
  57. DateCreation, {Date of file creation.}
  58. TimeCreation, {Time of file creation.}
  59. DateLastAccess, {Date of last access to file.}
  60. TimeLastAccess, {Time of last access to file.}
  61. DateLastWrite, {Date of last modification of file.}
  62. TimeLastWrite:word; {Time of last modification of file.}
  63. FileSize, {Size of file.}
  64. FileAlloc:int64; {Amount of space the file really
  65. occupies on disk.}
  66. AttrFile:cardinal; {Attributes of file.}
  67. end;
  68. PFileStatus3L=^TFileStatus3L;
  69. TFileStatus4L=object(TFileStatus3L)
  70. cbList:cardinal; {Length of entire EA set.}
  71. end;
  72. PFileStatus4L=^TFileStatus4L;
  73. TFileFindBuf3=object(TFileStatus)
  74. NextEntryOffset: cardinal; {Offset of next entry}
  75. DateCreation, {Date of file creation.}
  76. TimeCreation, {Time of file creation.}
  77. DateLastAccess, {Date of last access to file.}
  78. TimeLastAccess, {Time of last access to file.}
  79. DateLastWrite, {Date of last modification of file.}
  80. TimeLastWrite:word; {Time of last modification of file.}
  81. FileSize, {Size of file.}
  82. FileAlloc:cardinal; {Amount of space the file really
  83. occupies on disk.}
  84. AttrFile:cardinal; {Attributes of file.}
  85. Name:shortstring; {Also possible to use as ASCIIZ.
  86. The byte following the last string
  87. character is always zero.}
  88. end;
  89. PFileFindBuf3=^TFileFindBuf3;
  90. TFileFindBuf4=object(TFileStatus)
  91. NextEntryOffset: cardinal; {Offset of next entry}
  92. DateCreation, {Date of file creation.}
  93. TimeCreation, {Time of file creation.}
  94. DateLastAccess, {Date of last access to file.}
  95. TimeLastAccess, {Time of last access to file.}
  96. DateLastWrite, {Date of last modification of file.}
  97. TimeLastWrite:word; {Time of last modification of file.}
  98. FileSize, {Size of file.}
  99. FileAlloc:cardinal; {Amount of space the file really
  100. occupies on disk.}
  101. AttrFile:cardinal; {Attributes of file.}
  102. cbList:cardinal; {Size of the file's extended attributes.}
  103. Name:shortstring; {Also possible to use as ASCIIZ.
  104. The byte following the last string
  105. character is always zero.}
  106. end;
  107. PFileFindBuf4=^TFileFindBuf4;
  108. TFileFindBuf3L=object(TFileStatus)
  109. NextEntryOffset: cardinal; {Offset of next entry}
  110. DateCreation, {Date of file creation.}
  111. TimeCreation, {Time of file creation.}
  112. DateLastAccess, {Date of last access to file.}
  113. TimeLastAccess, {Time of last access to file.}
  114. DateLastWrite, {Date of last modification of file.}
  115. TimeLastWrite:word; {Time of last modification of file.}
  116. FileSize, {Size of file.}
  117. FileAlloc:int64; {Amount of space the file really
  118. occupies on disk.}
  119. AttrFile:cardinal; {Attributes of file.}
  120. Name:shortstring; {Also possible to use as ASCIIZ.
  121. The byte following the last string
  122. character is always zero.}
  123. end;
  124. PFileFindBuf3L=^TFileFindBuf3L;
  125. TFileFindBuf4L=object(TFileStatus)
  126. NextEntryOffset: cardinal; {Offset of next entry}
  127. DateCreation, {Date of file creation.}
  128. TimeCreation, {Time of file creation.}
  129. DateLastAccess, {Date of last access to file.}
  130. TimeLastAccess, {Time of last access to file.}
  131. DateLastWrite, {Date of last modification of file.}
  132. TimeLastWrite:word; {Time of last modification of file.}
  133. FileSize, {Size of file.}
  134. FileAlloc:int64; {Amount of space the file really
  135. occupies on disk.}
  136. AttrFile:cardinal; {Attributes of file.}
  137. cbList:cardinal; {Size of the file's extended attributes.}
  138. Name:shortstring; {Also possible to use as ASCIIZ.
  139. The byte following the last string
  140. character is always zero.}
  141. end;
  142. PFileFindBuf4L=^TFileFindBuf4L;
  143. TFSInfo = record
  144. case word of
  145. 1:
  146. (File_Sys_ID,
  147. Sectors_Per_Cluster,
  148. Total_Clusters,
  149. Free_Clusters: cardinal;
  150. Bytes_Per_Sector: word);
  151. 2: {For date/time description,
  152. see file searching realted
  153. routines.}
  154. (Label_Date, {Date when volume label was created.}
  155. Label_Time: word; {Time when volume label was created.}
  156. VolumeLabel: ShortString); {Volume label. Can also be used
  157. as ASCIIZ, because the byte
  158. following the last character of
  159. the string is always zero.}
  160. end;
  161. PFSInfo = ^TFSInfo;
  162. TCountryCode=record
  163. Country, {Country to query info about (0=current).}
  164. CodePage: cardinal; {Code page to query info about (0=current).}
  165. end;
  166. PCountryCode=^TCountryCode;
  167. TTimeFmt = (Clock12, Clock24);
  168. TCountryInfo=record
  169. Country, CodePage: cardinal; {Country and codepage requested.}
  170. case byte of
  171. 0:
  172. (DateFormat: cardinal; {1=ddmmyy 2=yymmdd 3=mmddyy}
  173. CurrencyUnit: array [0..4] of char;
  174. ThousandSeparator: char; {Thousands separator.}
  175. Zero1: byte; {Always zero.}
  176. DecimalSeparator: char; {Decimals separator,}
  177. Zero2: byte;
  178. DateSeparator: char; {Date separator.}
  179. Zero3: byte;
  180. TimeSeparator: char; {Time separator.}
  181. Zero4: byte;
  182. CurrencyFormat, {Bit field:
  183. Bit 0: 0=indicator before value
  184. 1=indicator after value
  185. Bit 1: 1=insert space after
  186. indicator.
  187. Bit 2: 1=Ignore bit 0&1, replace
  188. decimal separator with
  189. indicator.}
  190. DecimalPlace: byte; {Number of decimal places used in
  191. currency indication.}
  192. TimeFormat: TTimeFmt; {12/24 hour.}
  193. Reserve1: array [0..1] of word;
  194. DataSeparator: char; {Data list separator}
  195. Zero5: byte;
  196. Reserve2: array [0..4] of word);
  197. 1:
  198. (fsDateFmt: cardinal; {1=ddmmyy 2=yymmdd 3=mmddyy}
  199. szCurrency: array [0..4] of char;
  200. {null terminated currency symbol}
  201. szThousandsSeparator: array [0..1] of char;
  202. {Thousands separator + #0}
  203. szDecimal: array [0..1] of char;
  204. {Decimals separator + #0}
  205. szDateSeparator: array [0..1] of char;
  206. {Date separator + #0}
  207. szTimeSeparator: array [0..1] of char;
  208. {Time separator + #0}
  209. fsCurrencyFmt, {Bit field:
  210. Bit 0: 0=indicator before value
  211. 1=indicator after value
  212. Bit 1: 1=insert space after
  213. indicator.
  214. Bit 2: 1=Ignore bit 0&1, replace
  215. decimal separator with
  216. indicator}
  217. cDecimalPlace: byte; {Number of decimal places used in
  218. currency indication}
  219. fsTimeFmt: byte; {0=12,1=24 hours}
  220. abReserved1: array [0..1] of word;
  221. szDataSeparator: array [0..1] of char;
  222. {Data list separator + #0}
  223. abReserved2: array [0..4] of word);
  224. end;
  225. PCountryInfo=^TCountryInfo;
  226. TRequestData=record
  227. PID, {ID of process that wrote element.}
  228. Data: cardinal; {Information from process writing the data.}
  229. end;
  230. PRequestData=^TRequestData;
  231. {Queue data structure for synchronously started sessions.}
  232. TChildInfo = record
  233. case boolean of
  234. false:
  235. (SessionID,
  236. Return: word); {Return code from the child process.}
  237. true:
  238. (usSessionID,
  239. usReturn: word); {Return code from the child process.}
  240. end;
  241. PChildInfo = ^TChildInfo;
  242. TStartData=record
  243. {Note: to omit some fields, use a length smaller than SizeOf(TStartData).}
  244. Length:word; {Length, in bytes, of datastructure
  245. (24/30/32/50/60).}
  246. Related:word; {Independent/child session (0/1).}
  247. FgBg:word; {Foreground/background (0/1).}
  248. TraceOpt:word; {No trace/trace this/trace all (0/1/2).}
  249. PgmTitle:PChar; {Program title.}
  250. PgmName:PChar; {Filename to program.}
  251. PgmInputs:PChar; {Command parameters (nil allowed).}
  252. TermQ:PChar; {System queue. (nil allowed).}
  253. Environment:PChar; {Environment to pass (nil allowed).}
  254. InheritOpt:word; {Inherit environment from shell/
  255. inherit environment from parent (0/1).}
  256. SessionType:word; {Auto/full screen/window/presentation
  257. manager/full screen Dos/windowed Dos
  258. (0/1/2/3/4/5/6/7).}
  259. Iconfile:PChar; {Icon file to use (nil allowed).}
  260. PgmHandle:cardinal; {0 or the program handle.}
  261. PgmControl:word; {Bitfield describing initial state
  262. of windowed sessions.}
  263. InitXPos,InitYPos:word; {Initial top coordinates.}
  264. InitXSize,InitYSize:word; {Initial size.}
  265. Reserved:word;
  266. ObjectBuffer:PChar; {If a module cannot be loaded, its
  267. name will be returned here.}
  268. ObjectBuffLen:cardinal; {Size of your buffer.}
  269. end;
  270. PStartData=^TStartData;
  271. TResultCodes=record
  272. TerminateReason, {0 = Normal termionation.
  273. 1 = Critical error.
  274. 2 = Trapped. (GPE, etc.)
  275. 3 = Killed by DosKillProcess.}
  276. ExitCode:cardinal; {Exit code of child.}
  277. end;
  278. const
  279. ilStandard = 1; (* Use TFileStatus3/TFindFileBuf3 *)
  280. ilQueryEASize = 2; (* Use TFileStatus4/TFindFileBuf4 *)
  281. ilQueryEAs = 3;
  282. ilQueryFullName = 5;
  283. ilStandardL = 11; (* Use TFileStatus3L/TFindFileBuf3L *)
  284. ilQueryEASizeL = 12; (* Use TFileStatus4L/TFindFileBuf4L *)
  285. ilQueryEAsL = 13;
  286. quFIFO = 0;
  287. quLIFO = 1;
  288. quPriority = 2;
  289. quNoConvert_Address = 0;
  290. quConvert_Address = 4;
  291. {Start the new session independent or as a child.}
  292. ssf_Related_Independent = 0; {Start new session independent
  293. of the calling session.}
  294. ssf_Related_Child = 1; {Start new session as a child
  295. session to the calling session.}
  296. {Start the new session in the foreground or in the background.}
  297. ssf_FgBg_Fore = 0; {Start new session in foreground.}
  298. ssf_FgBg_Back = 1; {Start new session in background.}
  299. {Should the program started in the new session
  300. be executed under conditions for tracing?}
  301. ssf_TraceOpt_None = 0; {No trace.}
  302. ssf_TraceOpt_Trace = 1; {Trace with no notification
  303. of descendants.}
  304. ssf_TraceOpt_TraceAll = 2; {Trace all descendant sessions.
  305. A termination queue must be
  306. supplied and Related must be
  307. ssf_Related_Child (=1).}
  308. {Will the new session inherit open file handles
  309. and environment from the calling process.}
  310. ssf_InhertOpt_Shell = 0; {Inherit from the shell.}
  311. ssf_InhertOpt_Parent = 1; {Inherit from the calling process.}
  312. {Specifies the type of session to start.}
  313. ssf_Type_Default = 0; {Use program's type.}
  314. ssf_Type_FullScreen = 1; {OS/2 full screen.}
  315. ssf_Type_WindowableVIO = 2; {OS/2 window.}
  316. ssf_Type_PM = 3; {Presentation Manager.}
  317. ssf_Type_VDM = 4; {DOS full screen.}
  318. ssf_Type_WindowedVDM = 7; {DOS window.}
  319. {Additional values for Windows programs}
  320. Prog_31_StdSeamlessVDM = 15; {Windows 3.1 program in its
  321. own windowed session.}
  322. Prog_31_StdSeamlessCommon = 16; {Windows 3.1 program in a
  323. common windowed session.}
  324. Prog_31_EnhSeamlessVDM = 17; {Windows 3.1 program in enhanced
  325. compatibility mode in its own
  326. windowed session.}
  327. Prog_31_EnhSeamlessCommon = 18; {Windows 3.1 program in enhanced
  328. compatibility mode in a common
  329. windowed session.}
  330. Prog_31_Enh = 19; {Windows 3.1 program in enhanced
  331. compatibility mode in a full
  332. screen session.}
  333. Prog_31_Std = 20; {Windows 3.1 program in a full
  334. screen session.}
  335. {Specifies the initial attributes for a OS/2 window or DOS window session.}
  336. ssf_Control_Visible = 0; {Window is visible.}
  337. ssf_Control_Invisible = 1; {Window is invisible.}
  338. ssf_Control_Maximize = 2; {Window is maximized.}
  339. ssf_Control_Minimize = 4; {Window is minimized.}
  340. ssf_Control_NoAutoClose = 8; {Window will not close after
  341. the program has ended.}
  342. ssf_Control_SetPos = 32768; {Use InitXPos, InitYPos,
  343. InitXSize, and InitYSize for
  344. the size and placement.}
  345. function DosSetFileInfo (Handle: THandle; InfoLevel: cardinal; AFileStatus: PFileStatus;
  346. FileStatusLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 218;
  347. function DosQueryFSInfo (DiskNum, InfoLevel: cardinal; var Buffer: TFSInfo;
  348. BufLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 278;
  349. function DosQueryFileInfo (Handle: THandle; InfoLevel: cardinal;
  350. AFileStatus: PFileStatus; FileStatusLen: cardinal): cardinal; cdecl;
  351. external 'DOSCALLS' index 279;
  352. function DosScanEnv (Name: PChar; var Value: PChar): cardinal; cdecl;
  353. external 'DOSCALLS' index 227;
  354. function DosFindFirst (FileMask: PChar; var Handle: THandle; Attrib: cardinal;
  355. AFileStatus: PFileStatus; FileStatusLen: cardinal;
  356. var Count: cardinal; InfoLevel: cardinal): cardinal; cdecl;
  357. external 'DOSCALLS' index 264;
  358. function DosFindNext (Handle: THandle; AFileStatus: PFileStatus;
  359. FileStatusLen: cardinal; var Count: cardinal): cardinal; cdecl;
  360. external 'DOSCALLS' index 265;
  361. function DosFindClose (Handle: THandle): cardinal; cdecl;
  362. external 'DOSCALLS' index 263;
  363. function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode;
  364. var Res: TCountryInfo; var ActualSize: cardinal): cardinal; cdecl;
  365. external 'NLS' index 5;
  366. function DosMapCase (Size: cardinal; var Country: TCountryCode;
  367. AString: PChar): cardinal; cdecl; external 'NLS' index 7;
  368. function DosDelete(FileName:PChar): cardinal; cdecl;
  369. external 'DOSCALLS' index 259;
  370. function DosMove(OldFile, NewFile:PChar): cardinal; cdecl;
  371. external 'DOSCALLS' index 271;
  372. function DosQueryPathInfo(FileName:PChar;InfoLevel:cardinal;
  373. AFileStatus:PFileStatus;FileStatusLen:cardinal): cardinal; cdecl;
  374. external 'DOSCALLS' index 223;
  375. function DosSetPathInfo(FileName:PChar;InfoLevel:cardinal;
  376. AFileStatus:PFileStatus;FileStatusLen,
  377. Options:cardinal):cardinal; cdecl;
  378. external 'DOSCALLS' index 219;
  379. function DosClose(Handle: THandle): cardinal; cdecl;
  380. external 'DOSCALLS' index 257;
  381. function DosRead(Handle:THandle; var Buffer; Count: cardinal;
  382. var ActCount: cardinal): cardinal; cdecl;
  383. external 'DOSCALLS' index 281;
  384. function DosWrite(Handle: THandle; Buffer: pointer; Count: cardinal;
  385. var ActCount: cardinal): cardinal; cdecl;
  386. external 'DOSCALLS' index 282;
  387. procedure DosSleep (MSec: cardinal); cdecl; external 'DOSCALLS' index 229;
  388. function DosCreateQueue (var Handle: THandle; Priority:longint;
  389. Name: PChar): cardinal; cdecl;
  390. external 'QUECALLS' index 16;
  391. function DosReadQueue (Handle: THandle; var ReqBuffer: TRequestData;
  392. var DataLen: cardinal; var DataPtr: pointer;
  393. Element, Wait: cardinal; var Priority: byte;
  394. ASem: THandle): cardinal; cdecl;
  395. external 'QUECALLS' index 9;
  396. function DosCloseQueue (Handle: THandle): cardinal; cdecl;
  397. external 'QUECALLS' index 11;
  398. function DosStartSession (var AStartData: TStartData;
  399. var SesID, PID: cardinal): cardinal; cdecl;
  400. external 'SESMGR' index 37;
  401. function DosFreeMem(P:pointer):cardinal; cdecl; external 'DOSCALLS' index 304;
  402. function DosExecPgm (ObjName: PChar; ObjLen: longint; ExecFlag: cardinal;
  403. Args, Env: PByteArray; var Res: TResultCodes;
  404. FileName:PChar): cardinal; cdecl;
  405. external 'DOSCALLS' index 283;
  406. type
  407. TDT=packed record
  408. Hour,
  409. Minute,
  410. Second,
  411. Sec100,
  412. Day,
  413. Month: byte;
  414. Year: word;
  415. TimeZone: smallint;
  416. WeekDay: byte;
  417. end;
  418. function DosGetDateTime(var Buf: TDT): cardinal; cdecl;
  419. external 'DOSCALLS' index 230;
  420. {****************************************************************************
  421. File Functions
  422. ****************************************************************************}
  423. const
  424. ofRead = $0000; {Open for reading}
  425. ofWrite = $0001; {Open for writing}
  426. ofReadWrite = $0002; {Open for reading/writing}
  427. doDenyRW = $0010; {DenyAll (no sharing)}
  428. faCreateNew = $00010000; {Create if file does not exist}
  429. faOpenReplace = $00040000; {Truncate if file exists}
  430. faCreate = $00050000; {Create if file does not exist, truncate otherwise}
  431. FindResvdMask = $00003737; {Allowed bits in attribute
  432. specification for DosFindFirst call.}
  433. function FileOpen (const FileName: string; Mode: integer): THandle;
  434. Var
  435. Handle: THandle;
  436. Rc, Action: cardinal;
  437. begin
  438. (* DenyNone if sharing not specified. *)
  439. if (Mode and 112 = 0) or (Mode and 112 > 64) then
  440. Mode := Mode or 64;
  441. Rc:=Sys_DosOpenL(PChar (FileName), Handle, Action, 0, 0, 1, Mode, nil);
  442. If Rc=0 then
  443. FileOpen:=Handle
  444. else
  445. FileOpen:=feInvalidHandle; //FileOpen:=-RC;
  446. //should return feInvalidHandle(=-1) if fail, other negative returned value are no more errors
  447. end;
  448. function FileCreate (const FileName: string): THandle;
  449. begin
  450. FileCreate := FileCreate (FileName, doDenyRW, 777); (* Sharing to DenyAll *)
  451. end;
  452. function FileCreate (const FileName: string; Rights: integer): THandle;
  453. begin
  454. FileCreate := FileCreate (FileName, doDenyRW, Rights);
  455. (* Sharing to DenyAll *)
  456. end;
  457. function FileCreate (const FileName: string; ShareMode: integer;
  458. Rights: integer): THandle;
  459. var
  460. Handle: THandle;
  461. RC, Action: cardinal;
  462. begin
  463. ShareMode := ShareMode and 112;
  464. (* Sharing to DenyAll as default in case of values not allowed by OS/2. *)
  465. if (ShareMode = 0) or (ShareMode > 64) then
  466. ShareMode := doDenyRW;
  467. RC := Sys_DosOpenL (PChar (FileName), Handle, Action, 0, 0, $12,
  468. faCreate or ofReadWrite or ShareMode, nil);
  469. if RC = 0 then
  470. FileCreate := Handle
  471. else
  472. FileCreate := feInvalidHandle;
  473. End;
  474. function FileRead (Handle: THandle; Out Buffer; Count: longint): longint;
  475. Var
  476. T: cardinal;
  477. begin
  478. DosRead(Handle, Buffer, Count, T);
  479. FileRead := longint (T);
  480. end;
  481. function FileWrite (Handle: THandle; const Buffer; Count: longint): longint;
  482. Var
  483. T: cardinal;
  484. begin
  485. DosWrite (Handle, @Buffer, Count, T);
  486. FileWrite := longint (T);
  487. end;
  488. function FileSeek (Handle: THandle; FOffset, Origin: longint): longint;
  489. var
  490. NPos: int64;
  491. begin
  492. if (Sys_DosSetFilePtrL (Handle, FOffset, Origin, NPos) = 0)
  493. and (NPos < high (longint)) then
  494. FileSeek:= longint (NPos)
  495. else
  496. FileSeek:=-1;
  497. end;
  498. function FileSeek (Handle: THandle; FOffset: Int64; Origin: Longint): Int64;
  499. var
  500. NPos: int64;
  501. begin
  502. if Sys_DosSetFilePtrL (Handle, FOffset, Origin, NPos) = 0 then
  503. FileSeek:= NPos
  504. else
  505. FileSeek:=-1;
  506. end;
  507. procedure FileClose (Handle: THandle);
  508. begin
  509. DosClose(Handle);
  510. end;
  511. function FileTruncate (Handle: THandle; Size: Int64): boolean;
  512. begin
  513. FileTruncate:=Sys_DosSetFileSizeL(Handle, Size)=0;
  514. FileSeek(Handle, 0, 2);
  515. end;
  516. function FileAge (const FileName: string): longint;
  517. var Handle: longint;
  518. begin
  519. Handle := FileOpen (FileName, 0);
  520. if Handle <> -1 then
  521. begin
  522. Result := FileGetDate (Handle);
  523. FileClose (Handle);
  524. end
  525. else
  526. Result := -1;
  527. end;
  528. function FileExists (const FileName: string): boolean;
  529. var
  530. SR: TSearchRec;
  531. RC: longint;
  532. begin
  533. FileExists:=False;
  534. if FindFirst (FileName, faAnyFile and not (faDirectory), SR) = 0
  535. then FileExists := True;
  536. FindClose(SR);
  537. end;
  538. type TRec = record
  539. T, D: word;
  540. end;
  541. PSearchRec = ^SearchRec;
  542. function FindFirst (const Path: string; Attr: longint; out Rslt: TSearchRec): longint;
  543. var SR: PSearchRec;
  544. FStat: PFileFindBuf3L;
  545. Count: cardinal;
  546. Err: cardinal;
  547. I: cardinal;
  548. begin
  549. New (FStat);
  550. Rslt.FindHandle := THandle ($FFFFFFFF);
  551. Count := 1;
  552. if FSApi64 then
  553. Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
  554. Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, ilStandardL)
  555. else
  556. Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
  557. Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, ilStandard);
  558. if (Err = 0) and (Count = 0) then
  559. Err := 18;
  560. FindFirst := -Err;
  561. if Err = 0 then
  562. begin
  563. Rslt.ExcludeAttr := 0;
  564. TRec (Rslt.Time).T := FStat^.TimeLastWrite;
  565. TRec (Rslt.Time).D := FStat^.DateLastWrite;
  566. if FSApi64 then
  567. begin
  568. Rslt.Size := FStat^.FileSize;
  569. Rslt.Name := FStat^.Name;
  570. Rslt.Attr := FStat^.AttrFile;
  571. end
  572. else
  573. begin
  574. Rslt.Size := PFileFindBuf3 (FStat)^.FileSize;
  575. Rslt.Name := PFileFindBuf3 (FStat)^.Name;
  576. Rslt.Attr := PFileFindBuf3 (FStat)^.AttrFile;
  577. end;
  578. end
  579. else
  580. FindClose(Rslt);
  581. Dispose (FStat);
  582. end;
  583. function FindNext (var Rslt: TSearchRec): longint;
  584. var
  585. SR: PSearchRec;
  586. FStat: PFileFindBuf3L;
  587. Count: cardinal;
  588. Err: cardinal;
  589. begin
  590. New (FStat);
  591. Count := 1;
  592. Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^), Count);
  593. if (Err = 0) and (Count = 0) then
  594. Err := 18;
  595. FindNext := -Err;
  596. if Err = 0 then
  597. begin
  598. Rslt.ExcludeAttr := 0;
  599. TRec (Rslt.Time).T := FStat^.TimeLastWrite;
  600. TRec (Rslt.Time).D := FStat^.DateLastWrite;
  601. if FSApi64 then
  602. begin
  603. Rslt.Size := FStat^.FileSize;
  604. Rslt.Name := FStat^.Name;
  605. Rslt.Attr := FStat^.AttrFile;
  606. end
  607. else
  608. begin
  609. Rslt.Size := PFileFindBuf3 (FStat)^.FileSize;
  610. Rslt.Name := PFileFindBuf3 (FStat)^.Name;
  611. Rslt.Attr := PFileFindBuf3 (FStat)^.AttrFile;
  612. end;
  613. end;
  614. Dispose (FStat);
  615. end;
  616. procedure FindClose (var F: TSearchrec);
  617. var
  618. SR: PSearchRec;
  619. begin
  620. DosFindClose (F.FindHandle);
  621. F.FindHandle := 0;
  622. end;
  623. function FileGetDate (Handle: THandle): longint;
  624. var
  625. FStat: TFileStatus3;
  626. Time: Longint;
  627. begin
  628. DosError := DosQueryFileInfo(Handle, ilStandard, @FStat, SizeOf(FStat));
  629. if DosError=0 then
  630. begin
  631. Time := FStat.TimeLastWrite + longint (FStat.DateLastWrite) shl 16;
  632. if Time = 0 then
  633. Time := FStat.TimeCreation + longint (FStat.DateCreation) shl 16;
  634. end else
  635. Time:=0;
  636. FileGetDate:=Time;
  637. end;
  638. function FileSetDate (Handle: THandle; Age: longint): longint;
  639. var
  640. FStat: PFileStatus3;
  641. RC: cardinal;
  642. begin
  643. New (FStat);
  644. RC := DosQueryFileInfo (Handle, ilStandard, FStat, SizeOf (FStat^));
  645. if RC <> 0 then
  646. FileSetDate := -1
  647. else
  648. begin
  649. FStat^.DateLastAccess := Hi (Age);
  650. FStat^.DateLastWrite := Hi (Age);
  651. FStat^.TimeLastAccess := Lo (Age);
  652. FStat^.TimeLastWrite := Lo (Age);
  653. RC := DosSetFileInfo (Handle, ilStandard, FStat, SizeOf (FStat^));
  654. if RC <> 0 then
  655. FileSetDate := -1
  656. else
  657. FileSetDate := 0;
  658. end;
  659. Dispose (FStat);
  660. end;
  661. function FileGetAttr (const FileName: string): longint;
  662. var
  663. FS: PFileStatus3;
  664. begin
  665. New(FS);
  666. Result:=-DosQueryPathInfo(PChar (FileName), ilStandard, FS, SizeOf(FS^));
  667. If Result=0 Then Result:=FS^.attrFile;
  668. Dispose(FS);
  669. end;
  670. function FileSetAttr (const Filename: string; Attr: longint): longint;
  671. Var
  672. FS: PFileStatus3;
  673. Begin
  674. New(FS);
  675. FillChar(FS, SizeOf(FS^), 0);
  676. FS^.AttrFile:=Attr;
  677. Result:=-DosSetPathInfo(PChar (FileName), ilStandard, FS, SizeOf(FS^), 0);
  678. Dispose(FS);
  679. end;
  680. function DeleteFile (const FileName: string): boolean;
  681. Begin
  682. Result:=(DosDelete(PChar (FileName))=0);
  683. End;
  684. function RenameFile (const OldName, NewName: string): boolean;
  685. Begin
  686. Result:=(DosMove(PChar (OldName), PChar (NewName))=0);
  687. End;
  688. {****************************************************************************
  689. Disk Functions
  690. ****************************************************************************}
  691. function DiskFree (Drive: byte): int64;
  692. var FI: TFSinfo;
  693. RC: cardinal;
  694. begin
  695. {In OS/2, we use the filesystem information.}
  696. RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
  697. if RC = 0 then
  698. DiskFree := int64 (FI.Free_Clusters) *
  699. int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
  700. else
  701. DiskFree := -1;
  702. end;
  703. function DiskSize (Drive: byte): int64;
  704. var FI: TFSinfo;
  705. RC: cardinal;
  706. begin
  707. {In OS/2, we use the filesystem information.}
  708. RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
  709. if RC = 0 then
  710. DiskSize := int64 (FI.Total_Clusters) *
  711. int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
  712. else
  713. DiskSize := -1;
  714. end;
  715. function GetCurrentDir: string;
  716. begin
  717. GetDir (0, Result);
  718. end;
  719. function SetCurrentDir (const NewDir: string): boolean;
  720. begin
  721. {$I-}
  722. {$WARNING Should be rewritten to avoid unit dos dependency!}
  723. ChDir (NewDir);
  724. Result := (IOResult = 0);
  725. {$I+}
  726. end;
  727. function CreateDir (const NewDir: string): boolean;
  728. begin
  729. {$I-}
  730. {$WARNING Should be rewritten to avoid unit dos dependency!}
  731. MkDir (NewDir);
  732. Result := (IOResult = 0);
  733. {$I+}
  734. end;
  735. function RemoveDir (const Dir: string): boolean;
  736. begin
  737. {$I-}
  738. {$WARNING Should be rewritten to avoid unit dos dependency!}
  739. RmDir (Dir);
  740. Result := (IOResult = 0);
  741. {$I+}
  742. end;
  743. function DirectoryExists (const Directory: string): boolean;
  744. var
  745. L: longint;
  746. begin
  747. if Directory = '' then
  748. Result := false
  749. else
  750. begin
  751. if (Directory [Length (Directory)] in AllowDirectorySeparators) and
  752. (Length (Directory) > 1) and
  753. (* Do not remove '\' after ':' (root directory of a drive)
  754. or in '\\' (invalid path, possibly broken UNC path). *)
  755. not (Directory [Length (Directory) - 1] in AllowDriveSeparators + AllowDirectorySeparators) then
  756. L := FileGetAttr (ExpandFileName (Copy (Directory, 1, Length (Directory) - 1)))
  757. else
  758. L := FileGetAttr (ExpandFileName (Directory));
  759. Result := (L > 0) and (L and faDirectory = faDirectory);
  760. end;
  761. end;
  762. {****************************************************************************
  763. Time Functions
  764. ****************************************************************************}
  765. procedure GetLocalTime (var SystemTime: TSystemTime);
  766. var
  767. DT: TDT;
  768. begin
  769. DosGetDateTime(DT);
  770. with SystemTime do
  771. begin
  772. Year:=DT.Year;
  773. Month:=DT.Month;
  774. Day:=DT.Day;
  775. Hour:=DT.Hour;
  776. Minute:=DT.Minute;
  777. Second:=DT.Second;
  778. MilliSecond:=DT.Sec100;
  779. end;
  780. end;
  781. {****************************************************************************
  782. Misc Functions
  783. ****************************************************************************}
  784. procedure sysbeep;
  785. begin
  786. // Maybe implement later on ?
  787. end;
  788. {****************************************************************************
  789. Locale Functions
  790. ****************************************************************************}
  791. procedure InitAnsi;
  792. var I: byte;
  793. Country: TCountryCode;
  794. begin
  795. for I := 0 to 255 do
  796. UpperCaseTable [I] := Chr (I);
  797. Move (UpperCaseTable, LowerCaseTable, SizeOf (UpperCaseTable));
  798. FillChar (Country, SizeOf (Country), 0);
  799. DosMapCase (SizeOf (UpperCaseTable), Country, @UpperCaseTable);
  800. for I := 0 to 255 do
  801. if UpperCaseTable [I] <> Chr (I) then
  802. LowerCaseTable [Ord (UpperCaseTable [I])] := Chr (I);
  803. end;
  804. procedure InitInternational;
  805. var Country: TCountryCode;
  806. CtryInfo: TCountryInfo;
  807. Size: cardinal;
  808. RC: cardinal;
  809. begin
  810. Size := 0;
  811. FillChar (Country, SizeOf (Country), 0);
  812. FillChar (CtryInfo, SizeOf (CtryInfo), 0);
  813. RC := DosQueryCtryInfo (SizeOf (CtryInfo), Country, CtryInfo, Size);
  814. if RC = 0 then
  815. begin
  816. DateSeparator := CtryInfo.DateSeparator;
  817. case CtryInfo.DateFormat of
  818. 1: begin
  819. ShortDateFormat := 'd/m/y';
  820. LongDateFormat := 'dd" "mmmm" "yyyy';
  821. end;
  822. 2: begin
  823. ShortDateFormat := 'y/m/d';
  824. LongDateFormat := 'yyyy" "mmmm" "dd';
  825. end;
  826. 3: begin
  827. ShortDateFormat := 'm/d/y';
  828. LongDateFormat := 'mmmm" "dd" "yyyy';
  829. end;
  830. end;
  831. TimeSeparator := CtryInfo.TimeSeparator;
  832. DecimalSeparator := CtryInfo.DecimalSeparator;
  833. ThousandSeparator := CtryInfo.ThousandSeparator;
  834. CurrencyFormat := CtryInfo.CurrencyFormat;
  835. CurrencyString := PChar (CtryInfo.CurrencyUnit);
  836. end;
  837. InitAnsi;
  838. InitInternationalGeneric;
  839. end;
  840. function SysErrorMessage(ErrorCode: Integer): String;
  841. begin
  842. Result:=Format(SUnknownErrorCode,[ErrorCode]);
  843. end;
  844. {****************************************************************************
  845. OS Utils
  846. ****************************************************************************}
  847. Function GetEnvironmentVariable(Const EnvVar : String) : String;
  848. begin
  849. GetEnvironmentVariable := StrPas (GetEnvPChar (EnvVar));
  850. end;
  851. Function GetEnvironmentVariableCount : Integer;
  852. begin
  853. (* Result:=FPCCountEnvVar(EnvP); - the amount is already known... *)
  854. GetEnvironmentVariableCount := EnvC;
  855. end;
  856. Function GetEnvironmentString(Index : Integer) : String;
  857. begin
  858. Result:=FPCGetEnvStrFromP (EnvP, Index);
  859. end;
  860. procedure Sleep (Milliseconds: cardinal);
  861. begin
  862. DosSleep (Milliseconds);
  863. end;
  864. function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString;Flags:TExecuteFlags=[]):
  865. integer;
  866. var
  867. HQ: THandle;
  868. SPID, STID, QName: shortstring;
  869. SD: TStartData;
  870. SID, PID: cardinal;
  871. RD: TRequestData;
  872. PCI: PChildInfo;
  873. CISize: cardinal;
  874. Prio: byte;
  875. E: EOSError;
  876. CommandLine: ansistring;
  877. Args0, Args: PByteArray;
  878. ObjNameBuf: PChar;
  879. ArgSize: word;
  880. Res: TResultCodes;
  881. ObjName: shortstring;
  882. const
  883. MaxArgsSize = 3072; (* Amount of memory reserved for arguments in bytes. *)
  884. ObjBufSize = 512;
  885. begin
  886. ObjName := '';
  887. GetMem (ObjNameBuf, ObjBufSize);
  888. FillChar (ObjNameBuf^, ObjBufSize, 0);
  889. if ComLine = '' then
  890. begin
  891. Args0 := nil;
  892. Args := nil;
  893. end
  894. else
  895. begin
  896. GetMem (Args0, MaxArgsSize);
  897. Args := Args0;
  898. (* Work around a bug in OS/2 - argument to DosExecPgm *)
  899. (* should not cross 64K boundary. *)
  900. if ((PtrUInt (Args) + 1024) and $FFFF) < 1024 then
  901. Inc (pointer (Args), 1024);
  902. ArgSize := 0;
  903. Move (Path [1], Args^ [ArgSize], Length (Path));
  904. Inc (ArgSize, Length (Path));
  905. Args^ [ArgSize] := 0;
  906. Inc (ArgSize);
  907. {Now do the real arguments.}
  908. Move (ComLine [1], Args^ [ArgSize], Length (ComLine));
  909. Inc (ArgSize, Length (ComLine));
  910. Args^ [ArgSize] := 0;
  911. Inc (ArgSize);
  912. Args^ [ArgSize] := 0;
  913. end;
  914. Result := DosExecPgm (ObjNameBuf, ObjBufSize, 0, Args, nil, Res, PChar (Path));
  915. if Args0 <> nil then
  916. FreeMem (Args0, MaxArgsSize);
  917. if Result = 0 then
  918. begin
  919. Result := Res.ExitCode;
  920. FreeMem (ObjNameBuf, ObjBufSize);
  921. end
  922. else
  923. begin
  924. if (Result = 190) or (Result = 191) then
  925. begin
  926. FillChar (SD, SizeOf (SD), 0);
  927. SD.Length := 24;
  928. SD.Related := ssf_Related_Child;
  929. CommandLine := FExpand (Path); (* Needed for other session types... *)
  930. SD.PgmName := PChar (CommandLine);
  931. if ComLine <> '' then
  932. SD.PgmInputs := PChar (ComLine);
  933. SD.InheritOpt := ssf_InhertOpt_Parent;
  934. Str (GetProcessID, SPID);
  935. Str (ThreadID, STID);
  936. QName := '\QUEUES\FPC_ExecuteProcess_p' + SPID + 't' + STID + '.QUE'#0;
  937. SD.TermQ := @QName [1];
  938. Result := DosCreateQueue (HQ, quFIFO or quConvert_Address, @QName [1]);
  939. if Result = 0 then
  940. begin
  941. Result := DosStartSession (SD, SID, PID);
  942. if (Result = 0) or (Result = 457) then
  943. begin
  944. Result := DosReadQueue (HQ, RD, CISize, PCI, 0, 0, Prio, 0);
  945. if Result = 0 then
  946. begin
  947. Result := PCI^.Return;
  948. DosCloseQueue (HQ);
  949. DosFreeMem (PCI);
  950. Exit;
  951. end;
  952. end;
  953. DosCloseQueue (HQ);
  954. end;
  955. end
  956. else
  957. ObjName := StrPas (ObjNameBuf);
  958. FreeMem (ObjNameBuf, ObjBufSize);
  959. if ComLine = '' then
  960. CommandLine := Path
  961. else
  962. CommandLine := Path + ' ' + ComLine;
  963. if ObjName = '' then
  964. E := EOSError.CreateFmt (SExecuteProcessFailed, [CommandLine, Result])
  965. else
  966. E := EOSError.CreateFmt (SExecuteProcessFailed + '(' + ObjName + ')', [CommandLine, Result]);
  967. E.ErrorCode := Result;
  968. raise E;
  969. end;
  970. end;
  971. function ExecuteProcess (const Path: AnsiString;
  972. const ComLine: array of AnsiString;Flags:TExecuteFlags=[]): integer;
  973. var
  974. CommandLine: AnsiString;
  975. I: integer;
  976. begin
  977. Commandline := '';
  978. for I := 0 to High (ComLine) do
  979. if Pos (' ', ComLine [I]) <> 0 then
  980. CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
  981. else
  982. CommandLine := CommandLine + ' ' + Comline [I];
  983. ExecuteProcess := ExecuteProcess (Path, CommandLine);
  984. end;
  985. {****************************************************************************
  986. Initialization code
  987. ****************************************************************************}
  988. Initialization
  989. InitExceptions; { Initialize exceptions. OS independent }
  990. InitInternational; { Initialize internationalization settings }
  991. OnBeep:=@SysBeep;
  992. Finalization
  993. DoneExceptions;
  994. end.