2
0

sysutils.pp 44 KB

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