sysutils.pp 42 KB

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