sysutils.pp 43 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349
  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): Int64;
  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 FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
  580. begin
  581. Result := False;
  582. end;
  583. function FileExists (const FileName: RawByteString; FollowLink : Boolean): boolean;
  584. var
  585. L: longint;
  586. begin
  587. { no need to convert to DefaultFileSystemEncoding, FileGetAttr will do that }
  588. if FileName = '' then
  589. Result := false
  590. else
  591. begin
  592. L := FileGetAttr (FileName);
  593. Result := (L >= 0) and (L and (faDirectory or faVolumeID) = 0);
  594. (* Neither VolumeIDs nor directories are files. *)
  595. end;
  596. end;
  597. type
  598. TRec = record
  599. T, D: word;
  600. end;
  601. PSearchRec = ^SearchRec;
  602. Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
  603. var
  604. SystemEncodedPath: RawByteString;
  605. SR: PSearchRec;
  606. FStat: PFileFindBuf3L;
  607. Count: cardinal;
  608. Err: cardinal;
  609. begin
  610. if os_mode = osOS2 then
  611. begin
  612. SystemEncodedPath:=ToSingleByteFileSystemEncodedFileName(Path);
  613. New (FStat);
  614. Rslt.FindHandle := THandle ($FFFFFFFF);
  615. Count := 1;
  616. if FSApi64 then
  617. Err := DosFindFirst (PChar (SystemEncodedPath), Rslt.FindHandle,
  618. Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, ilStandardL)
  619. else
  620. Err := DosFindFirst (PChar (SystemEncodedPath), Rslt.FindHandle,
  621. Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, ilStandard);
  622. if (Err = 0) and (Count = 0) then
  623. Err := 18;
  624. InternalFindFirst := -Err;
  625. if Err = 0 then
  626. begin
  627. Rslt.ExcludeAttr := 0;
  628. TRec (Rslt.Time).T := FStat^.TimeLastWrite;
  629. TRec (Rslt.Time).D := FStat^.DateLastWrite;
  630. if FSApi64 then
  631. begin
  632. Rslt.Size := FStat^.FileSize;
  633. Name := FStat^.Name;
  634. Rslt.Attr := FStat^.AttrFile;
  635. end
  636. else
  637. begin
  638. Rslt.Size := PFileFindBuf3 (FStat)^.FileSize;
  639. Name := PFileFindBuf3 (FStat)^.Name;
  640. Rslt.Attr := PFileFindBuf3 (FStat)^.AttrFile;
  641. end;
  642. SetCodePage(Name, DefaultFileSystemCodePage, false);
  643. end
  644. else
  645. InternalFindClose (Rslt.FindHandle);
  646. Dispose (FStat);
  647. end
  648. else
  649. begin
  650. Err := DOS.DosError;
  651. GetMem (SR, SizeOf (SearchRec));
  652. Rslt.FindHandle := longint(SR);
  653. DOS.FindFirst (Path, Attr, SR^);
  654. InternalFindFirst := -DOS.DosError;
  655. if DosError = 0 then
  656. begin
  657. Rslt.Time := SR^.Time;
  658. (* Extend the supported file sizes from 2 GB to 4 GB at least. *)
  659. Rslt.Size := cardinal (SR^.Size);
  660. Rslt.Attr := SR^.Attr;
  661. Rslt.ExcludeAttr := 0;
  662. Name := SR^.Name;
  663. SetCodePage(Name, DefaultFileSystemCodePage, false);
  664. end;
  665. DOS.DosError := Err;
  666. end;
  667. end;
  668. Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
  669. var
  670. SR: PSearchRec;
  671. FStat: PFileFindBuf3L;
  672. Count: cardinal;
  673. Err: cardinal;
  674. begin
  675. if os_mode = osOS2 then
  676. begin
  677. New (FStat);
  678. Count := 1;
  679. Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^), Count);
  680. if (Err = 0) and (Count = 0) then
  681. Err := 18;
  682. InternalFindNext := -Err;
  683. if Err = 0 then
  684. begin
  685. Rslt.ExcludeAttr := 0;
  686. TRec (Rslt.Time).T := FStat^.TimeLastWrite;
  687. TRec (Rslt.Time).D := FStat^.DateLastWrite;
  688. if FSApi64 then
  689. begin
  690. Rslt.Size := FStat^.FileSize;
  691. Name := FStat^.Name;
  692. Rslt.Attr := FStat^.AttrFile;
  693. end
  694. else
  695. begin
  696. Rslt.Size := PFileFindBuf3 (FStat)^.FileSize;
  697. Name := PFileFindBuf3 (FStat)^.Name;
  698. Rslt.Attr := PFileFindBuf3 (FStat)^.AttrFile;
  699. end;
  700. SetCodePage(Name, DefaultFileSystemCodePage, false);
  701. end;
  702. Dispose (FStat);
  703. end
  704. else
  705. begin
  706. SR := PSearchRec (Rslt.FindHandle);
  707. if SR <> nil then
  708. begin
  709. DOS.FindNext (SR^);
  710. InternalFindNext := -DosError;
  711. if DosError = 0 then
  712. begin
  713. Rslt.Time := SR^.Time;
  714. (* Extend the supported file sizes from 2 GB to 4 GB at least. *)
  715. Rslt.Size := cardinal (SR^.Size);
  716. Rslt.Attr := SR^.Attr;
  717. Rslt.ExcludeAttr := 0;
  718. Name := SR^.Name;
  719. SetCodePage(Name, DefaultFileSystemCodePage, false);
  720. end;
  721. end;
  722. end;
  723. end;
  724. Procedure InternalFindClose(var Handle: THandle);
  725. var SR: PSearchRec;
  726. begin
  727. if os_mode = osOS2 then
  728. begin
  729. DosFindClose (Handle);
  730. end
  731. else
  732. begin
  733. SR := PSearchRec (Handle);
  734. DOS.FindClose (SR^);
  735. FreeMem (SR, SizeOf (SearchRec));
  736. end;
  737. Handle := 0;
  738. end;
  739. function FileGetDate (Handle: longint): Int64; assembler;
  740. asm
  741. push ebx
  742. {$IFDEF REGCALL}
  743. mov ebx, eax
  744. {$ELSE REGCALL}
  745. mov ebx, Handle
  746. {$ENDIF REGCALL}
  747. mov ax, 5700h
  748. call syscall
  749. mov eax, -1
  750. jc @FGetDateEnd
  751. mov ax, dx
  752. shld eax, ecx, 16
  753. @FGetDateEnd:
  754. pop ebx
  755. xorl edx,edx
  756. end {['eax', 'ebx', 'ecx', 'edx']};
  757. function FileSetDate (Handle: longint; Age: Int64): longint;
  758. var FStat: PFileStatus3;
  759. RC: cardinal;
  760. begin
  761. if os_mode = osOS2 then
  762. begin
  763. New (FStat);
  764. RC := DosQueryFileInfo (Handle, ilStandard, FStat,
  765. SizeOf (FStat^));
  766. if RC <> 0 then
  767. FileSetDate := -1
  768. else
  769. begin
  770. FStat^.DateLastAccess := Hi (dword (Age));
  771. FStat^.DateLastWrite := Hi (dword (Age));
  772. FStat^.TimeLastAccess := Lo (dword (Age));
  773. FStat^.TimeLastWrite := Lo (dword (Age));
  774. RC := DosSetFileInfo (Handle, ilStandard, FStat,
  775. SizeOf (FStat^));
  776. if RC <> 0 then
  777. FileSetDate := -1
  778. else
  779. FileSetDate := 0;
  780. end;
  781. Dispose (FStat);
  782. end
  783. else
  784. asm
  785. push ebx
  786. mov ax, 5701h
  787. mov ebx, Handle
  788. mov cx, word ptr [Age]
  789. mov dx, word ptr [Age + 2]
  790. call syscall
  791. jnc @FSetDateEnd
  792. mov eax, -1
  793. @FSetDateEnd:
  794. mov Result, eax
  795. pop ebx
  796. end ['eax', 'ecx', 'edx'];
  797. end;
  798. function FileGetAttr (const FileName: rawbytestring): longint; assembler;
  799. asm
  800. {$IFDEF REGCALL}
  801. mov edx, eax
  802. {$ELSE REGCALL}
  803. mov edx, FileName
  804. {$ENDIF REGCALL}
  805. mov ax, 4300h
  806. call syscall
  807. jnc @FGetAttrEnd
  808. mov eax, -1
  809. @FGetAttrEnd:
  810. end {['eax', 'edx']};
  811. function FileSetAttr (const Filename: RawByteString; Attr: longint): longint;
  812. var
  813. SystemFileName: RawByteString;
  814. begin
  815. SystemFileName:=ToSingleByteFileSystemEncodedFileName(Filename);
  816. asm
  817. mov ecx, Attr
  818. mov edx, SystemFileName
  819. mov ax, 4301h
  820. call syscall
  821. mov @result, 0
  822. jnc @FSetAttrEnd
  823. mov @result, -1
  824. @FSetAttrEnd:
  825. end ['eax', 'ecx', 'edx'];
  826. end;
  827. function DeleteFile (const FileName: rawbytestring): boolean;
  828. var
  829. SystemFileName: RawByteString;
  830. begin
  831. SystemFileName:=ToSingleByteFileSystemEncodedFileName(Filename);
  832. asm
  833. mov edx, SystemFileName
  834. mov ax, 4100h
  835. call syscall
  836. mov @result, 0
  837. jc @FDeleteEnd
  838. mov @result, 1
  839. @FDeleteEnd:
  840. end ['eax', 'edx'];
  841. end;
  842. function RenameFile (const OldName, NewName: rawbytestring): boolean;
  843. var
  844. OldSystemFileName, NewSystemFileName: RawByteString;
  845. Begin
  846. OldSystemFileName:=ToSingleByteFileSystemEncodedFileName(OldName);
  847. NewSystemFileName:=ToSingleByteFileSystemEncodedFileName(NewName);
  848. asm
  849. mov edx, OldSystemFileName
  850. mov edi, NewSystemFileName
  851. mov ax, 5600h
  852. call syscall
  853. mov @result, 0
  854. jc @FRenameEnd
  855. mov @result, 1
  856. @FRenameEnd:
  857. end ['eax', 'edx', 'edi'];
  858. end;
  859. {****************************************************************************
  860. Disk Functions
  861. ****************************************************************************}
  862. {$ASMMODE ATT}
  863. function DiskFree (Drive: byte): int64;
  864. var FI: TFSinfo;
  865. RC: cardinal;
  866. begin
  867. if (os_mode = osDOS) or (os_mode = osDPMI) then
  868. {Function 36 is not supported in OS/2.}
  869. asm
  870. pushl %ebx
  871. movb Drive,%dl
  872. movb $0x36,%ah
  873. call syscall
  874. cmpw $-1,%ax
  875. je .LDISKFREE1
  876. mulw %cx
  877. mulw %bx
  878. shll $16,%edx
  879. movw %ax,%dx
  880. movl $0,%eax
  881. xchgl %edx,%eax
  882. jmp .LDISKFREE2
  883. .LDISKFREE1:
  884. cltd
  885. .LDISKFREE2:
  886. popl %ebx
  887. leave
  888. ret
  889. end
  890. else
  891. {In OS/2, we use the filesystem information.}
  892. begin
  893. RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
  894. if RC = 0 then
  895. DiskFree := int64 (FI.Free_Clusters) *
  896. int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
  897. else
  898. DiskFree := -1;
  899. end;
  900. end;
  901. function DiskSize (Drive: byte): int64;
  902. var FI: TFSinfo;
  903. RC: cardinal;
  904. begin
  905. if (os_mode = osDOS) or (os_mode = osDPMI) then
  906. {Function 36 is not supported in OS/2.}
  907. asm
  908. pushl %ebx
  909. movb Drive,%dl
  910. movb $0x36,%ah
  911. call syscall
  912. movw %dx,%bx
  913. cmpw $-1,%ax
  914. je .LDISKSIZE1
  915. mulw %cx
  916. mulw %bx
  917. shll $16,%edx
  918. movw %ax,%dx
  919. movl $0,%eax
  920. xchgl %edx,%eax
  921. jmp .LDISKSIZE2
  922. .LDISKSIZE1:
  923. cltd
  924. .LDISKSIZE2:
  925. popl %ebx
  926. leave
  927. ret
  928. end
  929. else
  930. {In OS/2, we use the filesystem information.}
  931. begin
  932. RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
  933. if RC = 0 then
  934. DiskSize := int64 (FI.Total_Clusters) *
  935. int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
  936. else
  937. DiskSize := -1;
  938. end;
  939. end;
  940. function DirectoryExists (const Directory: RawByteString; FollowLink : Boolean): boolean;
  941. var
  942. L: longint;
  943. begin
  944. { no need to convert to DefaultFileSystemEncoding, FileGetAttr will do that }
  945. if Directory = '' then
  946. Result := false
  947. else
  948. begin
  949. if ((Length (Directory) = 2) or
  950. (Length (Directory) = 3) and
  951. (Directory [3] in AllowDirectorySeparators)) and
  952. (Directory [2] in AllowDriveSeparators) and
  953. (UpCase (Directory [1]) in ['A'..'Z']) then
  954. (* Checking attributes for 'x:' is not possible but for 'x:.' it is. *)
  955. L := FileGetAttr (Directory + '.')
  956. else if (Directory [Length (Directory)] in AllowDirectorySeparators) and
  957. (Length (Directory) > 1) and
  958. (* Do not remove '\' in '\\' (invalid path, possibly broken UNC path). *)
  959. not (Directory [Length (Directory) - 1] in AllowDirectorySeparators) then
  960. L := FileGetAttr (Copy (Directory, 1, Length (Directory) - 1))
  961. else
  962. L := FileGetAttr (Directory);
  963. Result := (L > 0) and (L and faDirectory = faDirectory);
  964. end;
  965. end;
  966. {****************************************************************************
  967. Time Functions
  968. ****************************************************************************}
  969. {$ASMMODE INTEL}
  970. procedure GetLocalTime (var SystemTime: TSystemTime); assembler;
  971. asm
  972. (* Expects the default record alignment (word)!!! *)
  973. push edi
  974. {$IFDEF REGCALL}
  975. push eax
  976. {$ENDIF REGCALL}
  977. mov ah, 2Ah
  978. call syscall
  979. {$IFDEF REGCALL}
  980. pop edi
  981. {$ELSE REGCALL}
  982. mov edi, SystemTime
  983. {$ENDIF REGCALL}
  984. xchg ax, cx
  985. shl eax, 16
  986. mov al, dh
  987. stosd
  988. mov al, dl
  989. shl eax, 16
  990. mov al, cl
  991. stosd
  992. push edi
  993. mov ah, 2Ch
  994. call syscall
  995. pop edi
  996. xor eax, eax
  997. mov al, ch
  998. shl eax, 16
  999. mov al, cl
  1000. stosd
  1001. xor eax, eax
  1002. mov al, 10
  1003. mul dl
  1004. shl eax, 16
  1005. mov al, dh
  1006. rol eax, 16
  1007. stosd
  1008. pop edi
  1009. end {['eax', 'ecx', 'edx', 'edi']};
  1010. {$asmmode default}
  1011. {****************************************************************************
  1012. Misc Functions
  1013. ****************************************************************************}
  1014. {****************************************************************************
  1015. Locale Functions
  1016. ****************************************************************************}
  1017. procedure InitAnsi;
  1018. var I: byte;
  1019. Country: TCountryCode;
  1020. begin
  1021. for I := 0 to 255 do
  1022. UpperCaseTable [I] := Chr (I);
  1023. Move (UpperCaseTable, LowerCaseTable, SizeOf (UpperCaseTable));
  1024. if os_mode = osOS2 then
  1025. begin
  1026. FillChar (Country, SizeOf (Country), 0);
  1027. DosMapCase (SizeOf (UpperCaseTable), Country, @UpperCaseTable);
  1028. end
  1029. else
  1030. begin
  1031. (* !!! TODO: DOS/DPMI mode support!!! *)
  1032. end;
  1033. for I := 0 to 255 do
  1034. if UpperCaseTable [I] <> Chr (I) then
  1035. LowerCaseTable [Ord (UpperCaseTable [I])] := Chr (I);
  1036. end;
  1037. procedure InitInternational;
  1038. var Country: TCountryCode;
  1039. CtryInfo: TCountryInfo;
  1040. Size: cardinal;
  1041. RC: cardinal;
  1042. begin
  1043. Size := 0;
  1044. FillChar (Country, SizeOf (Country), 0);
  1045. FillChar (CtryInfo, SizeOf (CtryInfo), 0);
  1046. RC := DosQueryCtryInfo (SizeOf (CtryInfo), Country, CtryInfo, Size);
  1047. if RC = 0 then
  1048. begin
  1049. DateSeparator := CtryInfo.DateSeparator;
  1050. case CtryInfo.DateFormat of
  1051. 1: begin
  1052. ShortDateFormat := 'd/m/y';
  1053. LongDateFormat := 'dd" "mmmm" "yyyy';
  1054. end;
  1055. 2: begin
  1056. ShortDateFormat := 'y/m/d';
  1057. LongDateFormat := 'yyyy" "mmmm" "dd';
  1058. end;
  1059. 3: begin
  1060. ShortDateFormat := 'm/d/y';
  1061. LongDateFormat := 'mmmm" "dd" "yyyy';
  1062. end;
  1063. end;
  1064. TimeSeparator := CtryInfo.TimeSeparator;
  1065. DecimalSeparator := CtryInfo.DecimalSeparator;
  1066. ThousandSeparator := CtryInfo.ThousandSeparator;
  1067. CurrencyFormat := CtryInfo.CurrencyFormat;
  1068. CurrencyString := PChar (CtryInfo.CurrencyUnit);
  1069. end;
  1070. InitAnsi;
  1071. InitInternationalGeneric;
  1072. end;
  1073. function SysErrorMessage(ErrorCode: Integer): String;
  1074. begin
  1075. Result:=Format(SUnknownErrorCode,[ErrorCode]);
  1076. end;
  1077. {****************************************************************************
  1078. OS Utils
  1079. ****************************************************************************}
  1080. Function GetEnvironmentVariable(Const EnvVar : String) : String;
  1081. begin
  1082. GetEnvironmentVariable := GetEnvPChar (EnvVar);
  1083. end;
  1084. Function GetEnvironmentVariableCount : Integer;
  1085. begin
  1086. (* Result:=FPCCountEnvVar(EnvP); - the amount is already known... *)
  1087. GetEnvironmentVariableCount := EnvC;
  1088. end;
  1089. Function GetEnvironmentString(Index : Integer) : {$ifdef FPC_RTL_UNICODE}UnicodeString{$else}AnsiString{$endif};
  1090. begin
  1091. Result:=FPCGetEnvStrFromP (EnvP, Index);
  1092. end;
  1093. {$ASMMODE INTEL}
  1094. procedure Sleep (Milliseconds: cardinal);
  1095. begin
  1096. if os_mode = osOS2 then DosSleep (Milliseconds) else
  1097. asm
  1098. mov edx, Milliseconds
  1099. mov eax, 7F30h
  1100. call syscall
  1101. end ['eax', 'edx'];
  1102. end;
  1103. {$ASMMODE DEFAULT}
  1104. function ExecuteProcess (const Path: RawByteString; const ComLine: RawByteString;Flags:TExecuteFlags=[]):
  1105. integer;
  1106. var
  1107. HQ: THandle;
  1108. SPID, STID, QName: shortstring;
  1109. SD: TStartData;
  1110. SID, PID: cardinal;
  1111. RD: TRequestData;
  1112. PCI: PChildInfo;
  1113. CISize: cardinal;
  1114. Prio: byte;
  1115. E: EOSError;
  1116. CommandLine: rawbytestring;
  1117. begin
  1118. if os_Mode = osOS2 then
  1119. begin
  1120. FillChar (SD, SizeOf (SD), 0);
  1121. SD.Length := 24;
  1122. SD.Related := ssf_Related_Child;
  1123. SD.PgmName := PChar (Path);
  1124. SD.PgmInputs := PChar (ComLine);
  1125. Str (GetProcessID, SPID);
  1126. Str (ThreadID, STID);
  1127. QName := '\QUEUES\FPC_ExecuteProcess_p' + SPID + 't' + STID + '.QUE'#0;
  1128. SD.TermQ := @QName [1];
  1129. Result := DosCreateQueue (HQ, quFIFO or quConvert_Address, @QName [1]);
  1130. if Result = 0 then
  1131. begin
  1132. Result := DosStartSession (SD, SID, PID);
  1133. if (Result = 0) or (Result = 457) then
  1134. begin
  1135. Result := DosReadQueue (HQ, RD, CISize, PCI, 0, 0, Prio, 0);
  1136. if Result = 0 then
  1137. begin
  1138. Result := PCI^.Return;
  1139. DosCloseQueue (HQ);
  1140. DosFreeMem (PCI);
  1141. Exit;
  1142. end;
  1143. end;
  1144. DosCloseQueue (HQ);
  1145. end;
  1146. if ComLine = '' then
  1147. CommandLine := Path
  1148. else
  1149. CommandLine := Path + ' ' + ComLine;
  1150. E := EOSError.CreateFmt (SExecuteProcessFailed, [CommandLine, Result]);
  1151. E.ErrorCode := Result;
  1152. raise E;
  1153. end else
  1154. begin
  1155. Dos.Exec (Path, ComLine);
  1156. if DosError <> 0 then
  1157. begin
  1158. if ComLine = '' then
  1159. CommandLine := Path
  1160. else
  1161. CommandLine := Path + ' ' + ComLine;
  1162. E := EOSError.CreateFmt (SExecuteProcessFailed, [CommandLine, DosError]);
  1163. E.ErrorCode := DosError;
  1164. raise E;
  1165. end;
  1166. ExecuteProcess := DosExitCode;
  1167. end;
  1168. end;
  1169. function ExecuteProcess (const Path: RawByteString;
  1170. const ComLine: array of RawByteString;Flags:TExecuteFlags=[]): integer;
  1171. var
  1172. CommandLine: RawByteString;
  1173. I: integer;
  1174. begin
  1175. Commandline := '';
  1176. for I := 0 to High (ComLine) do
  1177. if Pos (' ', ComLine [I]) <> 0 then
  1178. CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
  1179. else
  1180. CommandLine := CommandLine + ' ' + Comline [I];
  1181. ExecuteProcess := ExecuteProcess (Path, CommandLine);
  1182. end;
  1183. {****************************************************************************
  1184. Initialization code
  1185. ****************************************************************************}
  1186. Initialization
  1187. InitExceptions; { Initialize exceptions. OS independent }
  1188. InitInternational; { Initialize internationalization settings }
  1189. Finalization
  1190. FreeTerminateProcs;
  1191. DoneExceptions;
  1192. end.