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. {$IFDEF UNICODERTL}
  17. {$MODESWITCH UNICODESTRINGS}
  18. {$ELSE}
  19. {$H+}
  20. {$ENDIF}
  21. {$modeswitch typehelpers}
  22. {$modeswitch advancedrecords}
  23. uses
  24. Dos;
  25. {$DEFINE HAS_SLEEP}
  26. { used OS file system APIs use ansistring }
  27. {$define SYSUTILS_HAS_ANSISTR_FILEUTIL_IMPL}
  28. { OS has an ansistring/single byte environment variable API }
  29. {$define SYSUTILS_HAS_ANSISTR_ENVVAR_IMPL}
  30. {$DEFINE executeprocuni} (* Only 1 byte version of ExecuteProcess is provided by the OS *)
  31. { Include platform independent interface part }
  32. {$i sysutilh.inc}
  33. implementation
  34. uses
  35. sysconst;
  36. {$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
  37. {$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
  38. { Include platform independent implementation part }
  39. {$i sysutils.inc}
  40. {****************************************************************************
  41. System (imported) calls
  42. ****************************************************************************}
  43. (* "uses DosCalls" could not be used here due to type *)
  44. (* conflicts, so needed parts had to be redefined here). *)
  45. type
  46. TFileStatus = object
  47. end;
  48. PFileStatus = ^TFileStatus;
  49. TFileStatus3 = object (TFileStatus)
  50. DateCreation, {Date of file creation.}
  51. TimeCreation, {Time of file creation.}
  52. DateLastAccess, {Date of last access to file.}
  53. TimeLastAccess, {Time of last access to file.}
  54. DateLastWrite, {Date of last modification of file.}
  55. TimeLastWrite:word; {Time of last modification of file.}
  56. FileSize, {Size of file.}
  57. FileAlloc:cardinal; {Amount of space the file really
  58. occupies on disk.}
  59. AttrFile:cardinal; {Attributes of file.}
  60. end;
  61. PFileStatus3=^TFileStatus3;
  62. TFileStatus4=object(TFileStatus3)
  63. cbList:cardinal; {Length of entire EA set.}
  64. end;
  65. PFileStatus4=^TFileStatus4;
  66. TFileStatus3L = object (TFileStatus)
  67. DateCreation, {Date of file creation.}
  68. TimeCreation, {Time of file creation.}
  69. DateLastAccess, {Date of last access to file.}
  70. TimeLastAccess, {Time of last access to file.}
  71. DateLastWrite, {Date of last modification of file.}
  72. TimeLastWrite:word; {Time of last modification of file.}
  73. FileSize, {Size of file.}
  74. FileAlloc:int64; {Amount of space the file really
  75. occupies on disk.}
  76. AttrFile:cardinal; {Attributes of file.}
  77. end;
  78. PFileStatus3L=^TFileStatus3L;
  79. TFileStatus4L=object(TFileStatus3L)
  80. cbList:cardinal; {Length of entire EA set.}
  81. end;
  82. PFileStatus4L=^TFileStatus4L;
  83. TFileFindBuf3=object(TFileStatus)
  84. NextEntryOffset: cardinal; {Offset of next entry}
  85. DateCreation, {Date of file creation.}
  86. TimeCreation, {Time of file creation.}
  87. DateLastAccess, {Date of last access to file.}
  88. TimeLastAccess, {Time of last access to file.}
  89. DateLastWrite, {Date of last modification of file.}
  90. TimeLastWrite:word; {Time of last modification of file.}
  91. FileSize, {Size of file.}
  92. FileAlloc:cardinal; {Amount of space the file really
  93. occupies on disk.}
  94. AttrFile:cardinal; {Attributes of file.}
  95. Name:shortstring; {Also possible to use as ASCIIZ.
  96. The byte following the last string
  97. character is always zero.}
  98. end;
  99. PFileFindBuf3=^TFileFindBuf3;
  100. TFileFindBuf4=object(TFileStatus)
  101. NextEntryOffset: cardinal; {Offset of next entry}
  102. DateCreation, {Date of file creation.}
  103. TimeCreation, {Time of file creation.}
  104. DateLastAccess, {Date of last access to file.}
  105. TimeLastAccess, {Time of last access to file.}
  106. DateLastWrite, {Date of last modification of file.}
  107. TimeLastWrite:word; {Time of last modification of file.}
  108. FileSize, {Size of file.}
  109. FileAlloc:cardinal; {Amount of space the file really
  110. occupies on disk.}
  111. AttrFile:cardinal; {Attributes of file.}
  112. cbList:longint; {Size of the file's extended attributes.}
  113. Name:shortstring; {Also possible to use as ASCIIZ.
  114. The byte following the last string
  115. character is always zero.}
  116. end;
  117. PFileFindBuf4=^TFileFindBuf4;
  118. TFileFindBuf3L=object(TFileStatus)
  119. NextEntryOffset: cardinal; {Offset of next entry}
  120. DateCreation, {Date of file creation.}
  121. TimeCreation, {Time of file creation.}
  122. DateLastAccess, {Date of last access to file.}
  123. TimeLastAccess, {Time of last access to file.}
  124. DateLastWrite, {Date of last modification of file.}
  125. TimeLastWrite:word; {Time of last modification of file.}
  126. FileSize, {Size of file.}
  127. FileAlloc:int64; {Amount of space the file really
  128. occupies on disk.}
  129. AttrFile:cardinal; {Attributes of file.}
  130. Name:shortstring; {Also possible to use as ASCIIZ.
  131. The byte following the last string
  132. character is always zero.}
  133. end;
  134. PFileFindBuf3L=^TFileFindBuf3L;
  135. TFileFindBuf4L=object(TFileStatus)
  136. NextEntryOffset: cardinal; {Offset of next entry}
  137. DateCreation, {Date of file creation.}
  138. TimeCreation, {Time of file creation.}
  139. DateLastAccess, {Date of last access to file.}
  140. TimeLastAccess, {Time of last access to file.}
  141. DateLastWrite, {Date of last modification of file.}
  142. TimeLastWrite:word; {Time of last modification of file.}
  143. FileSize, {Size of file.}
  144. FileAlloc:int64; {Amount of space the file really
  145. occupies on disk.}
  146. AttrFile:cardinal; {Attributes of file.}
  147. cbList:cardinal; {Size of the file's extended attributes.}
  148. Name:shortstring; {Also possible to use as ASCIIZ.
  149. The byte following the last string
  150. character is always zero.}
  151. end;
  152. PFileFindBuf4L=^TFileFindBuf4L;
  153. TFSInfo = record
  154. case word of
  155. 1:
  156. (File_Sys_ID,
  157. Sectors_Per_Cluster,
  158. Total_Clusters,
  159. Free_Clusters: cardinal;
  160. Bytes_Per_Sector: word);
  161. 2: {For date/time description,
  162. see file searching realted
  163. routines.}
  164. (Label_Date, {Date when volume label was created.}
  165. Label_Time: word; {Time when volume label was created.}
  166. VolumeLabel: ShortString); {Volume label. Can also be used
  167. as ASCIIZ, because the byte
  168. following the last character of
  169. the string is always zero.}
  170. end;
  171. PFSInfo = ^TFSInfo;
  172. TCountryCode=record
  173. Country, {Country to query info about (0=current).}
  174. CodePage: cardinal; {Code page to query info about (0=current).}
  175. end;
  176. PCountryCode=^TCountryCode;
  177. TTimeFmt = (Clock12, Clock24);
  178. TCountryInfo=record
  179. Country, CodePage: cardinal; {Country and codepage requested.}
  180. case byte of
  181. 0:
  182. (DateFormat: cardinal; {1=ddmmyy 2=yymmdd 3=mmddyy}
  183. CurrencyUnit: array [0..4] of AnsiChar;
  184. ThousandSeparator: AnsiChar; {Thousands separator.}
  185. Zero1: byte; {Always zero.}
  186. DecimalSeparator: AnsiChar; {Decimals separator,}
  187. Zero2: byte;
  188. DateSeparator: AnsiChar; {Date separator.}
  189. Zero3: byte;
  190. TimeSeparator: AnsiChar; {Time separator.}
  191. Zero4: byte;
  192. CurrencyFormat, {Bit field:
  193. Bit 0: 0=indicator before value
  194. 1=indicator after value
  195. Bit 1: 1=insert space after
  196. indicator.
  197. Bit 2: 1=Ignore bit 0&1, replace
  198. decimal separator with
  199. indicator.}
  200. DecimalPlace: byte; {Number of decimal places used in
  201. currency indication.}
  202. TimeFormat: TTimeFmt; {12/24 hour.}
  203. Reserve1: array [0..1] of word;
  204. DataSeparator: AnsiChar; {Data list separator}
  205. Zero5: byte;
  206. Reserve2: array [0..4] of word);
  207. 1:
  208. (fsDateFmt: cardinal; {1=ddmmyy 2=yymmdd 3=mmddyy}
  209. szCurrency: array [0..4] of AnsiChar;
  210. {null terminated currency symbol}
  211. szThousandsSeparator: array [0..1] of AnsiChar;
  212. {Thousands separator + #0}
  213. szDecimal: array [0..1] of AnsiChar;
  214. {Decimals separator + #0}
  215. szDateSeparator: array [0..1] of AnsiChar;
  216. {Date separator + #0}
  217. szTimeSeparator: array [0..1] of AnsiChar;
  218. {Time separator + #0}
  219. fsCurrencyFmt, {Bit field:
  220. Bit 0: 0=indicator before value
  221. 1=indicator after value
  222. Bit 1: 1=insert space after
  223. indicator.
  224. Bit 2: 1=Ignore bit 0&1, replace
  225. decimal separator with
  226. indicator}
  227. cDecimalPlace: byte; {Number of decimal places used in
  228. currency indication}
  229. fsTimeFmt: byte; {0=12,1=24 hours}
  230. abReserved1: array [0..1] of word;
  231. szDataSeparator: array [0..1] of AnsiChar;
  232. {Data list separator + #0}
  233. abReserved2: array [0..4] of word);
  234. end;
  235. PCountryInfo=^TCountryInfo;
  236. TRequestData=record
  237. PID, {ID of process that wrote element.}
  238. Data: cardinal; {Information from process writing the data.}
  239. end;
  240. PRequestData=^TRequestData;
  241. {Queue data structure for synchronously started sessions.}
  242. TChildInfo = record
  243. case boolean of
  244. false:
  245. (SessionID,
  246. Return: word); {Return code from the child process.}
  247. true:
  248. (usSessionID,
  249. usReturn: word); {Return code from the child process.}
  250. end;
  251. PChildInfo = ^TChildInfo;
  252. TStartData=record
  253. {Note: to omit some fields, use a length smaller than SizeOf(TStartData).}
  254. Length:word; {Length, in bytes, of datastructure
  255. (24/30/32/50/60).}
  256. Related:word; {Independent/child session (0/1).}
  257. FgBg:word; {Foreground/background (0/1).}
  258. TraceOpt:word; {No trace/trace this/trace all (0/1/2).}
  259. PgmTitle:PAnsiChar; {Program title.}
  260. PgmName:PAnsiChar; {Filename to program.}
  261. PgmInputs:PAnsiChar; {Command parameters (nil allowed).}
  262. TermQ:PAnsiChar; {System queue. (nil allowed).}
  263. Environment:PAnsiChar; {Environment to pass (nil allowed).}
  264. InheritOpt:word; {Inherit environment from shell/
  265. inherit environment from parent (0/1).}
  266. SessionType:word; {Auto/full screen/window/presentation
  267. manager/full screen Dos/windowed Dos
  268. (0/1/2/3/4/5/6/7).}
  269. Iconfile:PAnsiChar; {Icon file to use (nil allowed).}
  270. PgmHandle:cardinal; {0 or the program handle.}
  271. PgmControl:word; {Bitfield describing initial state
  272. of windowed sessions.}
  273. InitXPos,InitYPos:word; {Initial top coordinates.}
  274. InitXSize,InitYSize:word; {Initial size.}
  275. Reserved:word;
  276. ObjectBuffer:PAnsiChar; {If a module cannot be loaded, its
  277. name will be returned here.}
  278. ObjectBuffLen:cardinal; {Size of your buffer.}
  279. end;
  280. PStartData=^TStartData;
  281. const
  282. ilStandard = 1; (* Use TFileStatus3/TFindFileBuf3 *)
  283. ilQueryEASize = 2; (* Use TFileStatus4/TFindFileBuf4 *)
  284. ilQueryEAs = 3;
  285. ilQueryFullName = 5;
  286. ilStandardL = 11; (* Use TFileStatus3L/TFindFileBuf3L *)
  287. ilQueryEASizeL = 12; (* Use TFileStatus4L/TFindFileBuf4L *)
  288. ilQueryEAsL = 13;
  289. quFIFO = 0;
  290. quLIFO = 1;
  291. quPriority = 2;
  292. quNoConvert_Address = 0;
  293. quConvert_Address = 4;
  294. {Start the new session independent or as a child.}
  295. ssf_Related_Independent = 0; {Start new session independent
  296. of the calling session.}
  297. ssf_Related_Child = 1; {Start new session as a child
  298. session to the calling session.}
  299. {Start the new session in the foreground or in the background.}
  300. ssf_FgBg_Fore = 0; {Start new session in foreground.}
  301. ssf_FgBg_Back = 1; {Start new session in background.}
  302. {Should the program started in the new session
  303. be executed under conditions for tracing?}
  304. ssf_TraceOpt_None = 0; {No trace.}
  305. ssf_TraceOpt_Trace = 1; {Trace with no notification
  306. of descendants.}
  307. ssf_TraceOpt_TraceAll = 2; {Trace all descendant sessions.
  308. A termination queue must be
  309. supplied and Related must be
  310. ssf_Related_Child (=1).}
  311. {Will the new session inherit open file handles
  312. and environment from the calling process.}
  313. ssf_InhertOpt_Shell = 0; {Inherit from the shell.}
  314. ssf_InhertOpt_Parent = 1; {Inherit from the calling process.}
  315. {Specifies the type of session to start.}
  316. ssf_Type_Default = 0; {Use program's type.}
  317. ssf_Type_FullScreen = 1; {OS/2 full screen.}
  318. ssf_Type_WindowableVIO = 2; {OS/2 window.}
  319. ssf_Type_PM = 3; {Presentation Manager.}
  320. ssf_Type_VDM = 4; {DOS full screen.}
  321. ssf_Type_WindowedVDM = 7; {DOS window.}
  322. {Additional values for Windows programs}
  323. Prog_31_StdSeamlessVDM = 15; {Windows 3.1 program in its
  324. own windowed session.}
  325. Prog_31_StdSeamlessCommon = 16; {Windows 3.1 program in a
  326. common windowed session.}
  327. Prog_31_EnhSeamlessVDM = 17; {Windows 3.1 program in enhanced
  328. compatibility mode in its own
  329. windowed session.}
  330. Prog_31_EnhSeamlessCommon = 18; {Windows 3.1 program in enhanced
  331. compatibility mode in a common
  332. windowed session.}
  333. Prog_31_Enh = 19; {Windows 3.1 program in enhanced
  334. compatibility mode in a full
  335. screen session.}
  336. Prog_31_Std = 20; {Windows 3.1 program in a full
  337. screen session.}
  338. {Specifies the initial attributes for a OS/2 window or DOS window session.}
  339. ssf_Control_Visible = 0; {Window is visible.}
  340. ssf_Control_Invisible = 1; {Window is invisible.}
  341. ssf_Control_Maximize = 2; {Window is maximized.}
  342. ssf_Control_Minimize = 4; {Window is minimized.}
  343. ssf_Control_NoAutoClose = 8; {Window will not close after
  344. the program has ended.}
  345. ssf_Control_SetPos = 32768; {Use InitXPos, InitYPos,
  346. InitXSize, and InitYSize for
  347. the size and placement.}
  348. {This is the correct way to call external assembler procedures.}
  349. procedure syscall;external name '___SYSCALL';
  350. function DosSetFileInfo (Handle: THandle; InfoLevel: cardinal; AFileStatus: PFileStatus;
  351. FileStatusLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 218;
  352. function DosQueryFSInfo (DiskNum, InfoLevel: cardinal; var Buffer: TFSInfo;
  353. BufLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 278;
  354. function DosQueryFileInfo (Handle: THandle; InfoLevel: cardinal;
  355. AFileStatus: PFileStatus; FileStatusLen: cardinal): cardinal; cdecl;
  356. external 'DOSCALLS' index 279;
  357. function DosScanEnv (Name: PAnsiChar; var Value: PAnsiChar): cardinal; cdecl;
  358. external 'DOSCALLS' index 227;
  359. function DosFindFirst (FileMask: PAnsiChar; var Handle: THandle; Attrib: cardinal;
  360. AFileStatus: PFileStatus; FileStatusLen: cardinal;
  361. var Count: cardinal; InfoLevel: cardinal): cardinal; cdecl;
  362. external 'DOSCALLS' index 264;
  363. function DosFindNext (Handle: THandle; AFileStatus: PFileStatus;
  364. FileStatusLen: cardinal; var Count: cardinal): cardinal; cdecl;
  365. external 'DOSCALLS' index 265;
  366. function DosFindClose (Handle: THandle): cardinal; cdecl;
  367. external 'DOSCALLS' index 263;
  368. function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode;
  369. var Res: TCountryInfo; var ActualSize: cardinal): cardinal; cdecl;
  370. external 'NLS' index 5;
  371. function DosMapCase (Size: cardinal; var Country: TCountryCode;
  372. AString: PAnsiChar): cardinal; cdecl; external 'NLS' index 7;
  373. procedure DosSleep (MSec: cardinal); cdecl; external 'DOSCALLS' index 229;
  374. function DosCreateQueue (var Handle: THandle; Priority:longint;
  375. Name: PAnsiChar): cardinal; cdecl;
  376. external 'QUECALLS' index 16;
  377. function DosReadQueue (Handle: THandle; var ReqBuffer: TRequestData;
  378. var DataLen: cardinal; var DataPtr: pointer;
  379. Element, Wait: cardinal; var Priority: byte;
  380. ASem: THandle): cardinal; cdecl;
  381. external 'QUECALLS' index 9;
  382. function DosCloseQueue (Handle: THandle): cardinal; cdecl;
  383. external 'QUECALLS' index 11;
  384. function DosStartSession (var AStartData: TStartData;
  385. var SesID, PID: cardinal): cardinal; cdecl;
  386. external 'SESMGR' index 37;
  387. function DosFreeMem(P:pointer):cardinal; cdecl; external 'DOSCALLS' index 304;
  388. {****************************************************************************
  389. File Functions
  390. ****************************************************************************}
  391. const
  392. ofRead = $0000; {Open for reading}
  393. ofWrite = $0001; {Open for writing}
  394. ofReadWrite = $0002; {Open for reading/writing}
  395. doDenyRW = $0010; {DenyAll (no sharing)}
  396. faCreateNew = $00010000; {Create if file does not exist}
  397. faOpenReplace = $00040000; {Truncate if file exists}
  398. faCreate = $00050000; {Create if file does not exist, truncate otherwise}
  399. FindResvdMask = $00003737; {Allowed bits in attribute
  400. specification for DosFindFirst call.}
  401. {$ASMMODE INTEL}
  402. function FileOpen (const FileName: pointer; Mode: integer): longint; assembler;
  403. asm
  404. push ebx
  405. {$IFDEF REGCALL}
  406. mov ecx, edx
  407. mov edx, eax
  408. {$ELSE REGCALL}
  409. mov ecx, Mode
  410. mov edx, FileName
  411. {$ENDIF REGCALL}
  412. (* DenyNone if sharing not specified. *)
  413. mov eax, ecx
  414. xor eax, 112
  415. jz @FOpenDefSharing
  416. cmp eax, 64
  417. jbe @FOpen1
  418. @FOpenDefSharing:
  419. or ecx, 64
  420. @FOpen1:
  421. mov eax, 7F2Bh
  422. call syscall
  423. (* syscall __open() returns -1 in case of error, i.e. exactly what we need *)
  424. pop ebx
  425. end {['eax', 'ebx', 'ecx', 'edx']};
  426. function FileOpen (const FileName: rawbytestring; Mode: integer): longint;
  427. var
  428. SystemFileName: RawByteString;
  429. begin
  430. SystemFileName := ToSingleByteFileSystemEncodedFileName(FileName);
  431. FileOpen := FileOpen(pointer(SystemFileName),Mode);
  432. end;
  433. function FileCreate (const FileName: RawByteString): longint;
  434. begin
  435. FileCreate := FileCreate (FileName, ofReadWrite or faCreate or doDenyRW, 777);
  436. (* Sharing to DenyAll *)
  437. end;
  438. function FileCreate (const FileName: RawByteString; Rights: integer): longint;
  439. begin
  440. FileCreate := FileCreate (FileName, ofReadWrite or faCreate or doDenyRW,
  441. Rights); (* Sharing to DenyAll *)
  442. end;
  443. function FileCreate (const FileName: Pointer; ShareMode: integer; Rights: integer): longint; assembler;
  444. asm
  445. push ebx
  446. {$IFDEF REGCALL}
  447. mov ecx, edx
  448. mov edx, eax
  449. {$ELSE REGCALL}
  450. mov ecx, ShareMode
  451. mov edx, FileName
  452. {$ENDIF REGCALL}
  453. and ecx, 112
  454. or ecx, ecx
  455. jz @FCDefSharing
  456. cmp ecx, 64
  457. jbe @FCSharingOK
  458. @FCDefSharing:
  459. mov ecx, doDenyRW (* Sharing to DenyAll *)
  460. @FCSharingOK:
  461. or ecx, ofReadWrite or faCreate
  462. mov eax, 7F2Bh
  463. call syscall
  464. pop ebx
  465. end {['eax', 'ebx', 'ecx', 'edx']};
  466. function FileCreate (const FileName: RawByteString; ShareMode: integer; Rights: integer): longint;
  467. var
  468. SystemFileName: RawByteString;
  469. begin
  470. SystemFileName := ToSingleByteFileSystemEncodedFileName(FileName);
  471. FileCreate := FileCreate(pointer(SystemFileName),ShareMode,Rights);
  472. end;
  473. function FileRead (Handle: longint; Out Buffer; Count: longint): longint;
  474. assembler;
  475. asm
  476. push ebx
  477. {$IFDEF REGCALL}
  478. mov ebx, eax
  479. {$ELSE REGCALL}
  480. mov ebx, Handle
  481. mov ecx, Count
  482. mov edx, Buffer
  483. {$ENDIF REGCALL}
  484. mov eax, 3F00h
  485. call syscall
  486. jnc @FReadEnd
  487. mov eax, -1
  488. @FReadEnd:
  489. pop ebx
  490. end {['eax', 'ebx', 'ecx', 'edx']};
  491. function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
  492. assembler;
  493. asm
  494. push ebx
  495. {$IFDEF REGCALL}
  496. mov ebx, eax
  497. {$ELSE REGCALL}
  498. mov ebx, Handle
  499. mov ecx, Count
  500. mov edx, Buffer
  501. {$ENDIF REGCALL}
  502. mov eax, 4000h
  503. call syscall
  504. jnc @FWriteEnd
  505. mov eax, -1
  506. @FWriteEnd:
  507. pop ebx
  508. end {['eax', 'ebx', 'ecx', 'edx']};
  509. function FileSeek (Handle, FOffset, Origin: longint): longint; assembler;
  510. asm
  511. push ebx
  512. {$IFDEF REGCALL}
  513. mov ebx, eax
  514. mov eax, ecx
  515. {$ELSE REGCALL}
  516. mov ebx, Handle
  517. mov eax, Origin
  518. mov edx, FOffset
  519. {$ENDIF REGCALL}
  520. mov ah, 42h
  521. call syscall
  522. jnc @FSeekEnd
  523. mov eax, -1
  524. @FSeekEnd:
  525. pop ebx
  526. end {['eax', 'ebx', 'edx']};
  527. function FileSeek (Handle: longint; FOffset: Int64; Origin: longint): Int64;
  528. begin
  529. {$warning need to add 64bit call }
  530. Result:=FileSeek(Handle,Longint(Foffset),Longint(Origin));
  531. end;
  532. procedure FileClose (Handle: longint);
  533. begin
  534. if (Handle > 4) or ((os_mode = osOS2) and (Handle > 2)) then
  535. asm
  536. push ebx
  537. mov eax, 3E00h
  538. mov ebx, Handle
  539. call syscall
  540. pop ebx
  541. end ['eax'];
  542. end;
  543. function FileTruncate (Handle: THandle; Size: Int64): boolean; assembler;
  544. asm
  545. push ebx
  546. {$IFDEF REGCALL}
  547. mov ebx, eax
  548. {$ELSE REGCALL}
  549. mov ebx, Handle
  550. {$ENDIF REGCALL}
  551. mov edx, dword ptr Size
  552. mov eax, dword ptr Size+4
  553. or eax, eax
  554. mov eax, 0
  555. jz @FTruncEnd (* file sizes > 4 GB not supported with EMX *)
  556. mov eax, 7F25h
  557. push ebx
  558. call syscall
  559. pop ebx
  560. jc @FTruncEnd
  561. mov eax, 4202h
  562. mov edx, 0
  563. call syscall
  564. mov eax, 0
  565. jnc @FTruncEnd
  566. dec eax
  567. @FTruncEnd:
  568. pop ebx
  569. end {['eax', 'ebx', 'ecx', 'edx']};
  570. function FileAge (const FileName: RawByteString): Int64;
  571. var Handle: longint;
  572. begin
  573. Handle := FileOpen (FileName, 0);
  574. if Handle <> -1 then
  575. begin
  576. Result := FileGetDate (Handle);
  577. FileClose (Handle);
  578. end
  579. else
  580. Result := -1;
  581. end;
  582. function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
  583. begin
  584. Result := False;
  585. end;
  586. function FileExists (const FileName: RawByteString; FollowLink : Boolean): boolean;
  587. var
  588. L: longint;
  589. begin
  590. { no need to convert to DefaultFileSystemEncoding, FileGetAttr will do that }
  591. if FileName = '' then
  592. Result := false
  593. else
  594. begin
  595. L := FileGetAttr (FileName);
  596. Result := (L >= 0) and (L and (faDirectory or faVolumeID) = 0);
  597. (* Neither VolumeIDs nor directories are files. *)
  598. end;
  599. end;
  600. type
  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 (PAnsiChar (SystemEncodedPath), Rslt.FindHandle,
  618. Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, ilStandardL)
  619. else
  620. Err := DosFindFirst (PAnsiChar (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. Rslt.Time := cardinal (FStat^.DateLastWrite) shl 16 +
  629. FStat^.TimeLastWrite;
  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. Rslt.Time := cardinal (FStat^.DateLastWrite) shl 16 +
  687. FStat^.TimeLastWrite;
  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. xor 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 := PAnsiChar (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 := PAnsiChar (Path);
  1124. SD.PgmInputs := PAnsiChar (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.