sysutils.pp 43 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338
  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 EMX
  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. {$modeswitch typehelpers}
  19. {$modeswitch advancedrecords}
  20. uses
  21. Dos;
  22. {$DEFINE HAS_SLEEP}
  23. { used OS file system APIs use ansistring }
  24. {$define SYSUTILS_HAS_ANSISTR_FILEUTIL_IMPL}
  25. { OS has an ansistring/single byte environment variable API }
  26. {$define SYSUTILS_HAS_ANSISTR_ENVVAR_IMPL}
  27. {$DEFINE executeprocuni} (* Only 1 byte version of ExecuteProcess is provided by the OS *)
  28. { Include platform independent interface part }
  29. {$i sysutilh.inc}
  30. implementation
  31. uses
  32. sysconst;
  33. {$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
  34. {$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
  35. { Include platform independent implementation part }
  36. {$i sysutils.inc}
  37. {****************************************************************************
  38. System (imported) calls
  39. ****************************************************************************}
  40. (* "uses DosCalls" could not be used here due to type *)
  41. (* conflicts, so needed parts had to be redefined here). *)
  42. type
  43. TFileStatus = object
  44. end;
  45. PFileStatus = ^TFileStatus;
  46. TFileStatus3 = object (TFileStatus)
  47. DateCreation, {Date of file creation.}
  48. TimeCreation, {Time of file creation.}
  49. DateLastAccess, {Date of last access to file.}
  50. TimeLastAccess, {Time of last access to file.}
  51. DateLastWrite, {Date of last modification of file.}
  52. TimeLastWrite:word; {Time of last modification of file.}
  53. FileSize, {Size of file.}
  54. FileAlloc:cardinal; {Amount of space the file really
  55. occupies on disk.}
  56. AttrFile:cardinal; {Attributes of file.}
  57. end;
  58. PFileStatus3=^TFileStatus3;
  59. TFileStatus4=object(TFileStatus3)
  60. cbList:cardinal; {Length of entire EA set.}
  61. end;
  62. PFileStatus4=^TFileStatus4;
  63. TFileStatus3L = object (TFileStatus)
  64. DateCreation, {Date of file creation.}
  65. TimeCreation, {Time of file creation.}
  66. DateLastAccess, {Date of last access to file.}
  67. TimeLastAccess, {Time of last access to file.}
  68. DateLastWrite, {Date of last modification of file.}
  69. TimeLastWrite:word; {Time of last modification of file.}
  70. FileSize, {Size of file.}
  71. FileAlloc:int64; {Amount of space the file really
  72. occupies on disk.}
  73. AttrFile:cardinal; {Attributes of file.}
  74. end;
  75. PFileStatus3L=^TFileStatus3L;
  76. TFileStatus4L=object(TFileStatus3L)
  77. cbList:cardinal; {Length of entire EA set.}
  78. end;
  79. PFileStatus4L=^TFileStatus4L;
  80. TFileFindBuf3=object(TFileStatus)
  81. NextEntryOffset: cardinal; {Offset of next entry}
  82. DateCreation, {Date of file creation.}
  83. TimeCreation, {Time of file creation.}
  84. DateLastAccess, {Date of last access to file.}
  85. TimeLastAccess, {Time of last access to file.}
  86. DateLastWrite, {Date of last modification of file.}
  87. TimeLastWrite:word; {Time of last modification of file.}
  88. FileSize, {Size of file.}
  89. FileAlloc:cardinal; {Amount of space the file really
  90. occupies on disk.}
  91. AttrFile:cardinal; {Attributes of file.}
  92. Name:shortstring; {Also possible to use as ASCIIZ.
  93. The byte following the last string
  94. character is always zero.}
  95. end;
  96. PFileFindBuf3=^TFileFindBuf3;
  97. TFileFindBuf4=object(TFileStatus)
  98. NextEntryOffset: cardinal; {Offset of next entry}
  99. DateCreation, {Date of file creation.}
  100. TimeCreation, {Time of file creation.}
  101. DateLastAccess, {Date of last access to file.}
  102. TimeLastAccess, {Time of last access to file.}
  103. DateLastWrite, {Date of last modification of file.}
  104. TimeLastWrite:word; {Time of last modification of file.}
  105. FileSize, {Size of file.}
  106. FileAlloc:cardinal; {Amount of space the file really
  107. occupies on disk.}
  108. AttrFile:cardinal; {Attributes of file.}
  109. cbList:longint; {Size of the file's extended attributes.}
  110. Name:shortstring; {Also possible to use as ASCIIZ.
  111. The byte following the last string
  112. character is always zero.}
  113. end;
  114. PFileFindBuf4=^TFileFindBuf4;
  115. TFileFindBuf3L=object(TFileStatus)
  116. NextEntryOffset: cardinal; {Offset of next entry}
  117. DateCreation, {Date of file creation.}
  118. TimeCreation, {Time of file creation.}
  119. DateLastAccess, {Date of last access to file.}
  120. TimeLastAccess, {Time of last access to file.}
  121. DateLastWrite, {Date of last modification of file.}
  122. TimeLastWrite:word; {Time of last modification of file.}
  123. FileSize, {Size of file.}
  124. FileAlloc:int64; {Amount of space the file really
  125. occupies on disk.}
  126. AttrFile:cardinal; {Attributes of file.}
  127. Name:shortstring; {Also possible to use as ASCIIZ.
  128. The byte following the last string
  129. character is always zero.}
  130. end;
  131. PFileFindBuf3L=^TFileFindBuf3L;
  132. TFileFindBuf4L=object(TFileStatus)
  133. NextEntryOffset: cardinal; {Offset of next entry}
  134. DateCreation, {Date of file creation.}
  135. TimeCreation, {Time of file creation.}
  136. DateLastAccess, {Date of last access to file.}
  137. TimeLastAccess, {Time of last access to file.}
  138. DateLastWrite, {Date of last modification of file.}
  139. TimeLastWrite:word; {Time of last modification of file.}
  140. FileSize, {Size of file.}
  141. FileAlloc:int64; {Amount of space the file really
  142. occupies on disk.}
  143. AttrFile:cardinal; {Attributes of file.}
  144. cbList:cardinal; {Size of the file's extended attributes.}
  145. Name:shortstring; {Also possible to use as ASCIIZ.
  146. The byte following the last string
  147. character is always zero.}
  148. end;
  149. PFileFindBuf4L=^TFileFindBuf4L;
  150. TFSInfo = record
  151. case word of
  152. 1:
  153. (File_Sys_ID,
  154. Sectors_Per_Cluster,
  155. Total_Clusters,
  156. Free_Clusters: cardinal;
  157. Bytes_Per_Sector: word);
  158. 2: {For date/time description,
  159. see file searching realted
  160. routines.}
  161. (Label_Date, {Date when volume label was created.}
  162. Label_Time: word; {Time when volume label was created.}
  163. VolumeLabel: ShortString); {Volume label. Can also be used
  164. as ASCIIZ, because the byte
  165. following the last character of
  166. the string is always zero.}
  167. end;
  168. PFSInfo = ^TFSInfo;
  169. TCountryCode=record
  170. Country, {Country to query info about (0=current).}
  171. CodePage: cardinal; {Code page to query info about (0=current).}
  172. end;
  173. PCountryCode=^TCountryCode;
  174. TTimeFmt = (Clock12, Clock24);
  175. TCountryInfo=record
  176. Country, CodePage: cardinal; {Country and codepage requested.}
  177. case byte of
  178. 0:
  179. (DateFormat: cardinal; {1=ddmmyy 2=yymmdd 3=mmddyy}
  180. CurrencyUnit: array [0..4] of char;
  181. ThousandSeparator: char; {Thousands separator.}
  182. Zero1: byte; {Always zero.}
  183. DecimalSeparator: char; {Decimals separator,}
  184. Zero2: byte;
  185. DateSeparator: char; {Date separator.}
  186. Zero3: byte;
  187. TimeSeparator: char; {Time separator.}
  188. Zero4: byte;
  189. CurrencyFormat, {Bit field:
  190. Bit 0: 0=indicator before value
  191. 1=indicator after value
  192. Bit 1: 1=insert space after
  193. indicator.
  194. Bit 2: 1=Ignore bit 0&1, replace
  195. decimal separator with
  196. indicator.}
  197. DecimalPlace: byte; {Number of decimal places used in
  198. currency indication.}
  199. TimeFormat: TTimeFmt; {12/24 hour.}
  200. Reserve1: array [0..1] of word;
  201. DataSeparator: char; {Data list separator}
  202. Zero5: byte;
  203. Reserve2: array [0..4] of word);
  204. 1:
  205. (fsDateFmt: cardinal; {1=ddmmyy 2=yymmdd 3=mmddyy}
  206. szCurrency: array [0..4] of char;
  207. {null terminated currency symbol}
  208. szThousandsSeparator: array [0..1] of char;
  209. {Thousands separator + #0}
  210. szDecimal: array [0..1] of char;
  211. {Decimals separator + #0}
  212. szDateSeparator: array [0..1] of char;
  213. {Date separator + #0}
  214. szTimeSeparator: array [0..1] of char;
  215. {Time separator + #0}
  216. fsCurrencyFmt, {Bit field:
  217. Bit 0: 0=indicator before value
  218. 1=indicator after value
  219. Bit 1: 1=insert space after
  220. indicator.
  221. Bit 2: 1=Ignore bit 0&1, replace
  222. decimal separator with
  223. indicator}
  224. cDecimalPlace: byte; {Number of decimal places used in
  225. currency indication}
  226. fsTimeFmt: byte; {0=12,1=24 hours}
  227. abReserved1: array [0..1] of word;
  228. szDataSeparator: array [0..1] of char;
  229. {Data list separator + #0}
  230. abReserved2: array [0..4] of word);
  231. end;
  232. PCountryInfo=^TCountryInfo;
  233. TRequestData=record
  234. PID, {ID of process that wrote element.}
  235. Data: cardinal; {Information from process writing the data.}
  236. end;
  237. PRequestData=^TRequestData;
  238. {Queue data structure for synchronously started sessions.}
  239. TChildInfo = record
  240. case boolean of
  241. false:
  242. (SessionID,
  243. Return: word); {Return code from the child process.}
  244. true:
  245. (usSessionID,
  246. usReturn: word); {Return code from the child process.}
  247. end;
  248. PChildInfo = ^TChildInfo;
  249. TStartData=record
  250. {Note: to omit some fields, use a length smaller than SizeOf(TStartData).}
  251. Length:word; {Length, in bytes, of datastructure
  252. (24/30/32/50/60).}
  253. Related:word; {Independent/child session (0/1).}
  254. FgBg:word; {Foreground/background (0/1).}
  255. TraceOpt:word; {No trace/trace this/trace all (0/1/2).}
  256. PgmTitle:PChar; {Program title.}
  257. PgmName:PChar; {Filename to program.}
  258. PgmInputs:PChar; {Command parameters (nil allowed).}
  259. TermQ:PChar; {System queue. (nil allowed).}
  260. Environment:PChar; {Environment to pass (nil allowed).}
  261. InheritOpt:word; {Inherit environment from shell/
  262. inherit environment from parent (0/1).}
  263. SessionType:word; {Auto/full screen/window/presentation
  264. manager/full screen Dos/windowed Dos
  265. (0/1/2/3/4/5/6/7).}
  266. Iconfile:PChar; {Icon file to use (nil allowed).}
  267. PgmHandle:cardinal; {0 or the program handle.}
  268. PgmControl:word; {Bitfield describing initial state
  269. of windowed sessions.}
  270. InitXPos,InitYPos:word; {Initial top coordinates.}
  271. InitXSize,InitYSize:word; {Initial size.}
  272. Reserved:word;
  273. ObjectBuffer:PChar; {If a module cannot be loaded, its
  274. name will be returned here.}
  275. ObjectBuffLen:cardinal; {Size of your buffer.}
  276. end;
  277. PStartData=^TStartData;
  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. {This is the correct way to call external assembler procedures.}
  346. procedure syscall;external name '___SYSCALL';
  347. function DosSetFileInfo (Handle: THandle; InfoLevel: cardinal; AFileStatus: PFileStatus;
  348. FileStatusLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 218;
  349. function DosQueryFSInfo (DiskNum, InfoLevel: cardinal; var Buffer: TFSInfo;
  350. BufLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 278;
  351. function DosQueryFileInfo (Handle: THandle; InfoLevel: cardinal;
  352. AFileStatus: PFileStatus; FileStatusLen: cardinal): cardinal; cdecl;
  353. external 'DOSCALLS' index 279;
  354. function DosScanEnv (Name: PChar; var Value: PChar): cardinal; cdecl;
  355. external 'DOSCALLS' index 227;
  356. function DosFindFirst (FileMask: PChar; var Handle: THandle; Attrib: cardinal;
  357. AFileStatus: PFileStatus; FileStatusLen: cardinal;
  358. var Count: cardinal; InfoLevel: cardinal): cardinal; cdecl;
  359. external 'DOSCALLS' index 264;
  360. function DosFindNext (Handle: THandle; AFileStatus: PFileStatus;
  361. FileStatusLen: cardinal; var Count: cardinal): cardinal; cdecl;
  362. external 'DOSCALLS' index 265;
  363. function DosFindClose (Handle: THandle): cardinal; cdecl;
  364. external 'DOSCALLS' index 263;
  365. function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode;
  366. var Res: TCountryInfo; var ActualSize: cardinal): cardinal; cdecl;
  367. external 'NLS' index 5;
  368. function DosMapCase (Size: cardinal; var Country: TCountryCode;
  369. AString: PChar): cardinal; cdecl; external 'NLS' index 7;
  370. procedure DosSleep (MSec: cardinal); cdecl; external 'DOSCALLS' index 229;
  371. function DosCreateQueue (var Handle: THandle; Priority:longint;
  372. Name: PChar): cardinal; cdecl;
  373. external 'QUECALLS' index 16;
  374. function DosReadQueue (Handle: THandle; var ReqBuffer: TRequestData;
  375. var DataLen: cardinal; var DataPtr: pointer;
  376. Element, Wait: cardinal; var Priority: byte;
  377. ASem: THandle): cardinal; cdecl;
  378. external 'QUECALLS' index 9;
  379. function DosCloseQueue (Handle: THandle): cardinal; cdecl;
  380. external 'QUECALLS' index 11;
  381. function DosStartSession (var AStartData: TStartData;
  382. var SesID, PID: cardinal): cardinal; cdecl;
  383. external 'SESMGR' index 37;
  384. function DosFreeMem(P:pointer):cardinal; cdecl; external 'DOSCALLS' index 304;
  385. {****************************************************************************
  386. File Functions
  387. ****************************************************************************}
  388. const
  389. ofRead = $0000; {Open for reading}
  390. ofWrite = $0001; {Open for writing}
  391. ofReadWrite = $0002; {Open for reading/writing}
  392. doDenyRW = $0010; {DenyAll (no sharing)}
  393. faCreateNew = $00010000; {Create if file does not exist}
  394. faOpenReplace = $00040000; {Truncate if file exists}
  395. faCreate = $00050000; {Create if file does not exist, truncate otherwise}
  396. FindResvdMask = $00003737; {Allowed bits in attribute
  397. specification for DosFindFirst call.}
  398. {$ASMMODE INTEL}
  399. function FileOpen (const FileName: pointer; Mode: integer): longint; assembler;
  400. asm
  401. push ebx
  402. {$IFDEF REGCALL}
  403. mov ecx, edx
  404. mov edx, eax
  405. {$ELSE REGCALL}
  406. mov ecx, Mode
  407. mov edx, FileName
  408. {$ENDIF REGCALL}
  409. (* DenyNone if sharing not specified. *)
  410. mov eax, ecx
  411. xor eax, 112
  412. jz @FOpenDefSharing
  413. cmp eax, 64
  414. jbe @FOpen1
  415. @FOpenDefSharing:
  416. or ecx, 64
  417. @FOpen1:
  418. mov eax, 7F2Bh
  419. call syscall
  420. (* syscall __open() returns -1 in case of error, i.e. exactly what we need *)
  421. pop ebx
  422. end {['eax', 'ebx', 'ecx', 'edx']};
  423. function FileOpen (const FileName: rawbytestring; Mode: integer): longint;
  424. var
  425. SystemFileName: RawByteString;
  426. begin
  427. SystemFileName := ToSingleByteFileSystemEncodedFileName(FileName);
  428. FileOpen := FileOpen(pointer(SystemFileName),Mode);
  429. end;
  430. function FileCreate (const FileName: RawByteString): longint;
  431. begin
  432. FileCreate := FileCreate (FileName, ofReadWrite or faCreate or doDenyRW, 777);
  433. (* Sharing to DenyAll *)
  434. end;
  435. function FileCreate (const FileName: RawByteString; Rights: integer): longint;
  436. begin
  437. FileCreate := FileCreate (FileName, ofReadWrite or faCreate or doDenyRW,
  438. Rights); (* Sharing to DenyAll *)
  439. end;
  440. function FileCreate (const FileName: Pointer; ShareMode: integer; Rights: integer): longint; assembler;
  441. asm
  442. push ebx
  443. {$IFDEF REGCALL}
  444. mov ecx, edx
  445. mov edx, eax
  446. {$ELSE REGCALL}
  447. mov ecx, ShareMode
  448. mov edx, FileName
  449. {$ENDIF REGCALL}
  450. and ecx, 112
  451. or ecx, ecx
  452. jz @FCDefSharing
  453. cmp ecx, 64
  454. jbe @FCSharingOK
  455. @FCDefSharing:
  456. mov ecx, doDenyRW (* Sharing to DenyAll *)
  457. @FCSharingOK:
  458. or ecx, ofReadWrite or faCreate
  459. mov eax, 7F2Bh
  460. call syscall
  461. pop ebx
  462. end {['eax', 'ebx', 'ecx', 'edx']};
  463. function FileCreate (const FileName: RawByteString; ShareMode: integer; Rights: integer): longint;
  464. var
  465. SystemFileName: RawByteString;
  466. begin
  467. SystemFileName := ToSingleByteFileSystemEncodedFileName(FileName);
  468. FileCreate := FileCreate(pointer(SystemFileName),ShareMode,Rights);
  469. end;
  470. function FileRead (Handle: longint; Out Buffer; Count: longint): longint;
  471. assembler;
  472. asm
  473. push ebx
  474. {$IFDEF REGCALL}
  475. mov ebx, eax
  476. {$ELSE REGCALL}
  477. mov ebx, Handle
  478. mov ecx, Count
  479. mov edx, Buffer
  480. {$ENDIF REGCALL}
  481. mov eax, 3F00h
  482. call syscall
  483. jnc @FReadEnd
  484. mov eax, -1
  485. @FReadEnd:
  486. pop ebx
  487. end {['eax', 'ebx', 'ecx', 'edx']};
  488. function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
  489. assembler;
  490. asm
  491. push ebx
  492. {$IFDEF REGCALL}
  493. mov ebx, eax
  494. {$ELSE REGCALL}
  495. mov ebx, Handle
  496. mov ecx, Count
  497. mov edx, Buffer
  498. {$ENDIF REGCALL}
  499. mov eax, 4000h
  500. call syscall
  501. jnc @FWriteEnd
  502. mov eax, -1
  503. @FWriteEnd:
  504. pop ebx
  505. end {['eax', 'ebx', 'ecx', 'edx']};
  506. function FileSeek (Handle, FOffset, Origin: longint): longint; assembler;
  507. asm
  508. push ebx
  509. {$IFDEF REGCALL}
  510. mov ebx, eax
  511. mov eax, ecx
  512. {$ELSE REGCALL}
  513. mov ebx, Handle
  514. mov eax, Origin
  515. mov edx, FOffset
  516. {$ENDIF REGCALL}
  517. mov ah, 42h
  518. call syscall
  519. jnc @FSeekEnd
  520. mov eax, -1
  521. @FSeekEnd:
  522. pop ebx
  523. end {['eax', 'ebx', 'edx']};
  524. function FileSeek (Handle: longint; FOffset: Int64; Origin: longint): Int64;
  525. begin
  526. {$warning need to add 64bit call }
  527. Result:=FileSeek(Handle,Longint(Foffset),Longint(Origin));
  528. end;
  529. procedure FileClose (Handle: longint);
  530. begin
  531. if (Handle > 4) or ((os_mode = osOS2) and (Handle > 2)) then
  532. asm
  533. push ebx
  534. mov eax, 3E00h
  535. mov ebx, Handle
  536. call syscall
  537. pop ebx
  538. end ['eax'];
  539. end;
  540. function FileTruncate (Handle: THandle; Size: Int64): boolean; assembler;
  541. asm
  542. push ebx
  543. {$IFDEF REGCALL}
  544. mov ebx, eax
  545. {$ELSE REGCALL}
  546. mov ebx, Handle
  547. {$ENDIF REGCALL}
  548. mov edx, dword ptr Size
  549. mov eax, dword ptr Size+4
  550. or eax, eax
  551. mov eax, 0
  552. jz @FTruncEnd (* file sizes > 4 GB not supported with EMX *)
  553. mov eax, 7F25h
  554. push ebx
  555. call syscall
  556. pop ebx
  557. jc @FTruncEnd
  558. mov eax, 4202h
  559. mov edx, 0
  560. call syscall
  561. mov eax, 0
  562. jnc @FTruncEnd
  563. dec eax
  564. @FTruncEnd:
  565. pop ebx
  566. end {['eax', 'ebx', 'ecx', 'edx']};
  567. function FileAge (const FileName: RawByteString): longint;
  568. var Handle: longint;
  569. begin
  570. Handle := FileOpen (FileName, 0);
  571. if Handle <> -1 then
  572. begin
  573. Result := FileGetDate (Handle);
  574. FileClose (Handle);
  575. end
  576. else
  577. Result := -1;
  578. end;
  579. function FileExists (const FileName: RawByteString): boolean;
  580. var
  581. L: longint;
  582. begin
  583. { no need to convert to DefaultFileSystemEncoding, FileGetAttr will do that }
  584. if FileName = '' then
  585. Result := false
  586. else
  587. begin
  588. L := FileGetAttr (FileName);
  589. Result := (L >= 0) and (L and (faDirectory or faVolumeID) = 0);
  590. (* Neither VolumeIDs nor directories are files. *)
  591. end;
  592. end;
  593. type
  594. TRec = record
  595. T, D: word;
  596. end;
  597. PSearchRec = ^SearchRec;
  598. Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
  599. var
  600. SystemEncodedPath: RawByteString;
  601. SR: PSearchRec;
  602. FStat: PFileFindBuf3L;
  603. Count: cardinal;
  604. Err: cardinal;
  605. begin
  606. if os_mode = osOS2 then
  607. begin
  608. SystemEncodedPath:=ToSingleByteFileSystemEncodedFileName(Path);
  609. New (FStat);
  610. Rslt.FindHandle := THandle ($FFFFFFFF);
  611. Count := 1;
  612. if FSApi64 then
  613. Err := DosFindFirst (PChar (SystemEncodedPath), Rslt.FindHandle,
  614. Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, ilStandardL)
  615. else
  616. Err := DosFindFirst (PChar (SystemEncodedPath), Rslt.FindHandle,
  617. Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, ilStandard);
  618. if (Err = 0) and (Count = 0) then
  619. Err := 18;
  620. InternalFindFirst := -Err;
  621. if Err = 0 then
  622. begin
  623. Rslt.ExcludeAttr := 0;
  624. TRec (Rslt.Time).T := FStat^.TimeLastWrite;
  625. TRec (Rslt.Time).D := FStat^.DateLastWrite;
  626. if FSApi64 then
  627. begin
  628. Rslt.Size := FStat^.FileSize;
  629. Name := FStat^.Name;
  630. Rslt.Attr := FStat^.AttrFile;
  631. end
  632. else
  633. begin
  634. Rslt.Size := PFileFindBuf3 (FStat)^.FileSize;
  635. Name := PFileFindBuf3 (FStat)^.Name;
  636. Rslt.Attr := PFileFindBuf3 (FStat)^.AttrFile;
  637. end;
  638. SetCodePage(Name, DefaultFileSystemCodePage, false);
  639. end
  640. else
  641. InternalFindClose (Rslt.FindHandle);
  642. Dispose (FStat);
  643. end
  644. else
  645. begin
  646. Err := DOS.DosError;
  647. GetMem (SR, SizeOf (SearchRec));
  648. Rslt.FindHandle := longint(SR);
  649. DOS.FindFirst (Path, Attr, SR^);
  650. InternalFindFirst := -DOS.DosError;
  651. if DosError = 0 then
  652. begin
  653. Rslt.Time := SR^.Time;
  654. (* Extend the supported file sizes from 2 GB to 4 GB at least. *)
  655. Rslt.Size := cardinal (SR^.Size);
  656. Rslt.Attr := SR^.Attr;
  657. Rslt.ExcludeAttr := 0;
  658. Name := SR^.Name;
  659. SetCodePage(Name, DefaultFileSystemCodePage, false);
  660. end;
  661. DOS.DosError := Err;
  662. end;
  663. end;
  664. Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
  665. var
  666. SR: PSearchRec;
  667. FStat: PFileFindBuf3L;
  668. Count: cardinal;
  669. Err: cardinal;
  670. begin
  671. if os_mode = osOS2 then
  672. begin
  673. New (FStat);
  674. Count := 1;
  675. Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^), Count);
  676. if (Err = 0) and (Count = 0) then
  677. Err := 18;
  678. InternalFindNext := -Err;
  679. if Err = 0 then
  680. begin
  681. Rslt.ExcludeAttr := 0;
  682. TRec (Rslt.Time).T := FStat^.TimeLastWrite;
  683. TRec (Rslt.Time).D := FStat^.DateLastWrite;
  684. if FSApi64 then
  685. begin
  686. Rslt.Size := FStat^.FileSize;
  687. Name := FStat^.Name;
  688. Rslt.Attr := FStat^.AttrFile;
  689. end
  690. else
  691. begin
  692. Rslt.Size := PFileFindBuf3 (FStat)^.FileSize;
  693. Name := PFileFindBuf3 (FStat)^.Name;
  694. Rslt.Attr := PFileFindBuf3 (FStat)^.AttrFile;
  695. end;
  696. SetCodePage(Name, DefaultFileSystemCodePage, false);
  697. end;
  698. Dispose (FStat);
  699. end
  700. else
  701. begin
  702. SR := PSearchRec (Rslt.FindHandle);
  703. if SR <> nil then
  704. begin
  705. DOS.FindNext (SR^);
  706. InternalFindNext := -DosError;
  707. if DosError = 0 then
  708. begin
  709. Rslt.Time := SR^.Time;
  710. (* Extend the supported file sizes from 2 GB to 4 GB at least. *)
  711. Rslt.Size := cardinal (SR^.Size);
  712. Rslt.Attr := SR^.Attr;
  713. Rslt.ExcludeAttr := 0;
  714. Name := SR^.Name;
  715. SetCodePage(Name, DefaultFileSystemCodePage, false);
  716. end;
  717. end;
  718. end;
  719. end;
  720. Procedure InternalFindClose(var Handle: THandle);
  721. var SR: PSearchRec;
  722. begin
  723. if os_mode = osOS2 then
  724. begin
  725. DosFindClose (Handle);
  726. end
  727. else
  728. begin
  729. SR := PSearchRec (Handle);
  730. DOS.FindClose (SR^);
  731. FreeMem (SR, SizeOf (SearchRec));
  732. end;
  733. Handle := 0;
  734. end;
  735. function FileGetDate (Handle: longint): longint; assembler;
  736. asm
  737. push ebx
  738. {$IFDEF REGCALL}
  739. mov ebx, eax
  740. {$ELSE REGCALL}
  741. mov ebx, Handle
  742. {$ENDIF REGCALL}
  743. mov ax, 5700h
  744. call syscall
  745. mov eax, -1
  746. jc @FGetDateEnd
  747. mov ax, dx
  748. shld eax, ecx, 16
  749. @FGetDateEnd:
  750. pop ebx
  751. end {['eax', 'ebx', 'ecx', 'edx']};
  752. function FileSetDate (Handle, Age: longint): longint;
  753. var FStat: PFileStatus3;
  754. RC: cardinal;
  755. begin
  756. if os_mode = osOS2 then
  757. begin
  758. New (FStat);
  759. RC := DosQueryFileInfo (Handle, ilStandard, FStat,
  760. SizeOf (FStat^));
  761. if RC <> 0 then
  762. FileSetDate := -1
  763. else
  764. begin
  765. FStat^.DateLastAccess := Hi (Age);
  766. FStat^.DateLastWrite := Hi (Age);
  767. FStat^.TimeLastAccess := Lo (Age);
  768. FStat^.TimeLastWrite := Lo (Age);
  769. RC := DosSetFileInfo (Handle, ilStandard, FStat,
  770. SizeOf (FStat^));
  771. if RC <> 0 then
  772. FileSetDate := -1
  773. else
  774. FileSetDate := 0;
  775. end;
  776. Dispose (FStat);
  777. end
  778. else
  779. asm
  780. push ebx
  781. mov ax, 5701h
  782. mov ebx, Handle
  783. mov cx, word ptr [Age]
  784. mov dx, word ptr [Age + 2]
  785. call syscall
  786. jnc @FSetDateEnd
  787. mov eax, -1
  788. @FSetDateEnd:
  789. mov Result, eax
  790. pop ebx
  791. end ['eax', 'ecx', 'edx'];
  792. end;
  793. function FileGetAttr (const FileName: rawbytestring): longint; assembler;
  794. asm
  795. {$IFDEF REGCALL}
  796. mov edx, eax
  797. {$ELSE REGCALL}
  798. mov edx, FileName
  799. {$ENDIF REGCALL}
  800. mov ax, 4300h
  801. call syscall
  802. jnc @FGetAttrEnd
  803. mov eax, -1
  804. @FGetAttrEnd:
  805. end {['eax', 'edx']};
  806. function FileSetAttr (const Filename: RawByteString; Attr: longint): longint;
  807. var
  808. SystemFileName: RawByteString;
  809. begin
  810. SystemFileName:=ToSingleByteFileSystemEncodedFileName(Filename);
  811. asm
  812. mov ecx, Attr
  813. mov edx, SystemFileName
  814. mov ax, 4301h
  815. call syscall
  816. mov @result, 0
  817. jnc @FSetAttrEnd
  818. mov @result, -1
  819. @FSetAttrEnd:
  820. end ['eax', 'ecx', 'edx'];
  821. end;
  822. function DeleteFile (const FileName: rawbytestring): boolean;
  823. var
  824. SystemFileName: RawByteString;
  825. begin
  826. SystemFileName:=ToSingleByteFileSystemEncodedFileName(Filename);
  827. asm
  828. mov edx, SystemFileName
  829. mov ax, 4100h
  830. call syscall
  831. mov @result, 0
  832. jc @FDeleteEnd
  833. mov @result, 1
  834. @FDeleteEnd:
  835. end ['eax', 'edx'];
  836. end;
  837. function RenameFile (const OldName, NewName: rawbytestring): boolean;
  838. var
  839. OldSystemFileName, NewSystemFileName: RawByteString;
  840. Begin
  841. OldSystemFileName:=ToSingleByteFileSystemEncodedFileName(OldName);
  842. NewSystemFileName:=ToSingleByteFileSystemEncodedFileName(NewName);
  843. asm
  844. mov edx, OldSystemFileName
  845. mov edi, NewSystemFileName
  846. mov ax, 5600h
  847. call syscall
  848. mov @result, 0
  849. jc @FRenameEnd
  850. mov @result, 1
  851. @FRenameEnd:
  852. end ['eax', 'edx', 'edi'];
  853. end;
  854. {****************************************************************************
  855. Disk Functions
  856. ****************************************************************************}
  857. {$ASMMODE ATT}
  858. function DiskFree (Drive: byte): int64;
  859. var FI: TFSinfo;
  860. RC: cardinal;
  861. begin
  862. if (os_mode = osDOS) or (os_mode = osDPMI) then
  863. {Function 36 is not supported in OS/2.}
  864. asm
  865. pushl %ebx
  866. movb Drive,%dl
  867. movb $0x36,%ah
  868. call syscall
  869. cmpw $-1,%ax
  870. je .LDISKFREE1
  871. mulw %cx
  872. mulw %bx
  873. shll $16,%edx
  874. movw %ax,%dx
  875. movl $0,%eax
  876. xchgl %edx,%eax
  877. jmp .LDISKFREE2
  878. .LDISKFREE1:
  879. cltd
  880. .LDISKFREE2:
  881. popl %ebx
  882. leave
  883. ret
  884. end
  885. else
  886. {In OS/2, we use the filesystem information.}
  887. begin
  888. RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
  889. if RC = 0 then
  890. DiskFree := int64 (FI.Free_Clusters) *
  891. int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
  892. else
  893. DiskFree := -1;
  894. end;
  895. end;
  896. function DiskSize (Drive: byte): int64;
  897. var FI: TFSinfo;
  898. RC: cardinal;
  899. begin
  900. if (os_mode = osDOS) or (os_mode = osDPMI) then
  901. {Function 36 is not supported in OS/2.}
  902. asm
  903. pushl %ebx
  904. movb Drive,%dl
  905. movb $0x36,%ah
  906. call syscall
  907. movw %dx,%bx
  908. cmpw $-1,%ax
  909. je .LDISKSIZE1
  910. mulw %cx
  911. mulw %bx
  912. shll $16,%edx
  913. movw %ax,%dx
  914. movl $0,%eax
  915. xchgl %edx,%eax
  916. jmp .LDISKSIZE2
  917. .LDISKSIZE1:
  918. cltd
  919. .LDISKSIZE2:
  920. popl %ebx
  921. leave
  922. ret
  923. end
  924. else
  925. {In OS/2, we use the filesystem information.}
  926. begin
  927. RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
  928. if RC = 0 then
  929. DiskSize := int64 (FI.Total_Clusters) *
  930. int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
  931. else
  932. DiskSize := -1;
  933. end;
  934. end;
  935. function DirectoryExists (const Directory: RawByteString): boolean;
  936. var
  937. L: longint;
  938. begin
  939. { no need to convert to DefaultFileSystemEncoding, FileGetAttr will do that }
  940. if Directory = '' then
  941. Result := false
  942. else
  943. begin
  944. if ((Length (Directory) = 2) or
  945. (Length (Directory) = 3) and
  946. (Directory [3] in AllowDirectorySeparators)) and
  947. (Directory [2] in AllowDriveSeparators) and
  948. (UpCase (Directory [1]) in ['A'..'Z']) then
  949. (* Checking attributes for 'x:' is not possible but for 'x:.' it is. *)
  950. L := FileGetAttr (Directory + '.')
  951. else if (Directory [Length (Directory)] in AllowDirectorySeparators) and
  952. (Length (Directory) > 1) and
  953. (* Do not remove '\' in '\\' (invalid path, possibly broken UNC path). *)
  954. not (Directory [Length (Directory) - 1] in AllowDirectorySeparators) then
  955. L := FileGetAttr (Copy (Directory, 1, Length (Directory) - 1))
  956. else
  957. L := FileGetAttr (Directory);
  958. Result := (L > 0) and (L and faDirectory = faDirectory);
  959. end;
  960. end;
  961. {****************************************************************************
  962. Time Functions
  963. ****************************************************************************}
  964. {$ASMMODE INTEL}
  965. procedure GetLocalTime (var SystemTime: TSystemTime); assembler;
  966. asm
  967. (* Expects the default record alignment (word)!!! *)
  968. push edi
  969. {$IFDEF REGCALL}
  970. push eax
  971. {$ENDIF REGCALL}
  972. mov ah, 2Ah
  973. call syscall
  974. {$IFDEF REGCALL}
  975. pop eax
  976. {$ELSE REGCALL}
  977. mov edi, SystemTime
  978. {$ENDIF REGCALL}
  979. mov ax, cx
  980. stosw
  981. xor eax, eax
  982. mov al, 10
  983. mul dl
  984. shl eax, 16
  985. mov al, dh
  986. stosd
  987. push edi
  988. mov ah, 2Ch
  989. call syscall
  990. pop edi
  991. xor eax, eax
  992. mov al, cl
  993. shl eax, 16
  994. mov al, ch
  995. stosd
  996. mov al, dl
  997. shl eax, 16
  998. mov al, dh
  999. stosd
  1000. pop edi
  1001. end {['eax', 'ecx', 'edx', 'edi']};
  1002. {$asmmode default}
  1003. {****************************************************************************
  1004. Misc Functions
  1005. ****************************************************************************}
  1006. {****************************************************************************
  1007. Locale Functions
  1008. ****************************************************************************}
  1009. procedure InitAnsi;
  1010. var I: byte;
  1011. Country: TCountryCode;
  1012. begin
  1013. for I := 0 to 255 do
  1014. UpperCaseTable [I] := Chr (I);
  1015. Move (UpperCaseTable, LowerCaseTable, SizeOf (UpperCaseTable));
  1016. if os_mode = osOS2 then
  1017. begin
  1018. FillChar (Country, SizeOf (Country), 0);
  1019. DosMapCase (SizeOf (UpperCaseTable), Country, @UpperCaseTable);
  1020. end
  1021. else
  1022. begin
  1023. (* !!! TODO: DOS/DPMI mode support!!! *)
  1024. end;
  1025. for I := 0 to 255 do
  1026. if UpperCaseTable [I] <> Chr (I) then
  1027. LowerCaseTable [Ord (UpperCaseTable [I])] := Chr (I);
  1028. end;
  1029. procedure InitInternational;
  1030. var Country: TCountryCode;
  1031. CtryInfo: TCountryInfo;
  1032. Size: cardinal;
  1033. RC: cardinal;
  1034. begin
  1035. Size := 0;
  1036. FillChar (Country, SizeOf (Country), 0);
  1037. FillChar (CtryInfo, SizeOf (CtryInfo), 0);
  1038. RC := DosQueryCtryInfo (SizeOf (CtryInfo), Country, CtryInfo, Size);
  1039. if RC = 0 then
  1040. begin
  1041. DateSeparator := CtryInfo.DateSeparator;
  1042. case CtryInfo.DateFormat of
  1043. 1: begin
  1044. ShortDateFormat := 'd/m/y';
  1045. LongDateFormat := 'dd" "mmmm" "yyyy';
  1046. end;
  1047. 2: begin
  1048. ShortDateFormat := 'y/m/d';
  1049. LongDateFormat := 'yyyy" "mmmm" "dd';
  1050. end;
  1051. 3: begin
  1052. ShortDateFormat := 'm/d/y';
  1053. LongDateFormat := 'mmmm" "dd" "yyyy';
  1054. end;
  1055. end;
  1056. TimeSeparator := CtryInfo.TimeSeparator;
  1057. DecimalSeparator := CtryInfo.DecimalSeparator;
  1058. ThousandSeparator := CtryInfo.ThousandSeparator;
  1059. CurrencyFormat := CtryInfo.CurrencyFormat;
  1060. CurrencyString := PChar (CtryInfo.CurrencyUnit);
  1061. end;
  1062. InitAnsi;
  1063. InitInternationalGeneric;
  1064. end;
  1065. function SysErrorMessage(ErrorCode: Integer): String;
  1066. begin
  1067. Result:=Format(SUnknownErrorCode,[ErrorCode]);
  1068. end;
  1069. {****************************************************************************
  1070. OS Utils
  1071. ****************************************************************************}
  1072. Function GetEnvironmentVariable(Const EnvVar : String) : String;
  1073. begin
  1074. GetEnvironmentVariable := GetEnvPChar (EnvVar);
  1075. end;
  1076. Function GetEnvironmentVariableCount : Integer;
  1077. begin
  1078. (* Result:=FPCCountEnvVar(EnvP); - the amount is already known... *)
  1079. GetEnvironmentVariableCount := EnvC;
  1080. end;
  1081. Function GetEnvironmentString(Index : Integer) : {$ifdef FPC_RTL_UNICODE}UnicodeString{$else}AnsiString{$endif};
  1082. begin
  1083. Result:=FPCGetEnvStrFromP (EnvP, Index);
  1084. end;
  1085. {$ASMMODE INTEL}
  1086. procedure Sleep (Milliseconds: cardinal);
  1087. begin
  1088. if os_mode = osOS2 then DosSleep (Milliseconds) else
  1089. asm
  1090. mov edx, Milliseconds
  1091. mov eax, 7F30h
  1092. call syscall
  1093. end ['eax', 'edx'];
  1094. end;
  1095. {$ASMMODE DEFAULT}
  1096. function ExecuteProcess (const Path: RawByteString; const ComLine: RawByteString;Flags:TExecuteFlags=[]):
  1097. integer;
  1098. var
  1099. HQ: THandle;
  1100. SPID, STID, QName: shortstring;
  1101. SD: TStartData;
  1102. SID, PID: cardinal;
  1103. RD: TRequestData;
  1104. PCI: PChildInfo;
  1105. CISize: cardinal;
  1106. Prio: byte;
  1107. E: EOSError;
  1108. CommandLine: rawbytestring;
  1109. begin
  1110. if os_Mode = osOS2 then
  1111. begin
  1112. FillChar (SD, SizeOf (SD), 0);
  1113. SD.Length := 24;
  1114. SD.Related := ssf_Related_Child;
  1115. SD.PgmName := PChar (Path);
  1116. SD.PgmInputs := PChar (ComLine);
  1117. Str (GetProcessID, SPID);
  1118. Str (ThreadID, STID);
  1119. QName := '\QUEUES\FPC_ExecuteProcess_p' + SPID + 't' + STID + '.QUE'#0;
  1120. SD.TermQ := @QName [1];
  1121. Result := DosCreateQueue (HQ, quFIFO or quConvert_Address, @QName [1]);
  1122. if Result = 0 then
  1123. begin
  1124. Result := DosStartSession (SD, SID, PID);
  1125. if (Result = 0) or (Result = 457) then
  1126. begin
  1127. Result := DosReadQueue (HQ, RD, CISize, PCI, 0, 0, Prio, 0);
  1128. if Result = 0 then
  1129. begin
  1130. Result := PCI^.Return;
  1131. DosCloseQueue (HQ);
  1132. DosFreeMem (PCI);
  1133. Exit;
  1134. end;
  1135. end;
  1136. DosCloseQueue (HQ);
  1137. end;
  1138. if ComLine = '' then
  1139. CommandLine := Path
  1140. else
  1141. CommandLine := Path + ' ' + ComLine;
  1142. E := EOSError.CreateFmt (SExecuteProcessFailed, [CommandLine, Result]);
  1143. E.ErrorCode := Result;
  1144. raise E;
  1145. end else
  1146. begin
  1147. Dos.Exec (Path, ComLine);
  1148. if DosError <> 0 then
  1149. begin
  1150. if ComLine = '' then
  1151. CommandLine := Path
  1152. else
  1153. CommandLine := Path + ' ' + ComLine;
  1154. E := EOSError.CreateFmt (SExecuteProcessFailed, [CommandLine, DosError]);
  1155. E.ErrorCode := DosError;
  1156. raise E;
  1157. end;
  1158. ExecuteProcess := DosExitCode;
  1159. end;
  1160. end;
  1161. function ExecuteProcess (const Path: RawByteString;
  1162. const ComLine: array of RawByteString;Flags:TExecuteFlags=[]): integer;
  1163. var
  1164. CommandLine: RawByteString;
  1165. I: integer;
  1166. begin
  1167. Commandline := '';
  1168. for I := 0 to High (ComLine) do
  1169. if Pos (' ', ComLine [I]) <> 0 then
  1170. CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
  1171. else
  1172. CommandLine := CommandLine + ' ' + Comline [I];
  1173. ExecuteProcess := ExecuteProcess (Path, CommandLine);
  1174. end;
  1175. {****************************************************************************
  1176. Initialization code
  1177. ****************************************************************************}
  1178. Initialization
  1179. InitExceptions; { Initialize exceptions. OS independent }
  1180. InitInternational; { Initialize internationalization settings }
  1181. Finalization
  1182. DoneExceptions;
  1183. end.