sysutils.pp 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by Florian Klaempfl
  5. member of the Free Pascal development team
  6. Sysutils unit for win32
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. unit sysutils;
  14. interface
  15. {$IFNDEF VIRTUALPASCAL}
  16. {$MODE objfpc}
  17. {$ENDIF}
  18. { force ansistrings }
  19. {$H+}
  20. uses
  21. {$IFDEF VIRTUALPASCAL}
  22. vpglue,
  23. strings,
  24. crt,
  25. {$ENDIF}
  26. dos,
  27. windows;
  28. {$DEFINE HAS_SLEEP}
  29. { Include platform independent interface part }
  30. {$i sysutilh.inc}
  31. type
  32. TSystemTime = Windows.TSystemTime;
  33. EWin32Error = class(Exception)
  34. public
  35. ErrorCode : DWORD;
  36. end;
  37. Var
  38. Win32Platform : Longint;
  39. Win32MajorVersion,
  40. Win32MinorVersion,
  41. Win32BuildNumber : dword;
  42. Win32CSDVersion : ShortString; // CSD record is 128 bytes only?
  43. implementation
  44. uses
  45. sysconst;
  46. { Include platform independent implementation part }
  47. {$i sysutils.inc}
  48. {****************************************************************************
  49. File Functions
  50. ****************************************************************************}
  51. Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
  52. const
  53. AccessMode: array[0..2] of Cardinal = (
  54. GENERIC_READ,
  55. GENERIC_WRITE,
  56. GENERIC_READ or GENERIC_WRITE);
  57. ShareMode: array[0..4] of Integer = (
  58. 0,
  59. 0,
  60. FILE_SHARE_READ,
  61. FILE_SHARE_WRITE,
  62. FILE_SHARE_READ or FILE_SHARE_WRITE);
  63. Var
  64. FN : string;
  65. begin
  66. FN:=FileName+#0;
  67. result := CreateFile(@FN[1], dword(AccessMode[Mode and 3]),
  68. dword(ShareMode[(Mode and $F0) shr 4]), nil, OPEN_EXISTING,
  69. FILE_ATTRIBUTE_NORMAL, 0);
  70. end;
  71. Function FileCreate (Const FileName : String) : Longint;
  72. Var
  73. FN : string;
  74. begin
  75. FN:=FileName+#0;
  76. Result := CreateFile(@FN[1], GENERIC_READ or GENERIC_WRITE,
  77. 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  78. end;
  79. Function FileCreate (Const FileName : String; Mode:longint) : Longint;
  80. begin
  81. FileCreate:=FileCreate(FileName);
  82. end;
  83. Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
  84. Var
  85. res : dword;
  86. begin
  87. if ReadFile(Handle, Buffer, Count, res, nil) then
  88. FileRead:=Res
  89. else
  90. FileRead:=-1;
  91. end;
  92. Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
  93. Var
  94. Res : dword;
  95. begin
  96. if WriteFile(Handle, Buffer, Count, Res, nil) then
  97. FileWrite:=Res
  98. else
  99. FileWrite:=-1;
  100. end;
  101. Function FileSeek (Handle,FOffset,Origin : Longint) : Longint;
  102. begin
  103. Result := longint(SetFilePointer(Handle, FOffset, nil, Origin));
  104. end;
  105. Function FileSeek (Handle : Longint; FOffset,Origin : Int64) : Int64;
  106. begin
  107. {$warning need to add 64bit call }
  108. Result := longint(SetFilePointer(Handle, FOffset, nil, Origin));
  109. end;
  110. Procedure FileClose (Handle : Longint);
  111. begin
  112. if Handle<=4 then
  113. exit;
  114. CloseHandle(Handle);
  115. end;
  116. Function FileTruncate (Handle,Size: Longint) : boolean;
  117. begin
  118. Result:=longint(SetFilePointer(handle,Size,nil,FILE_BEGIN))<>-1;
  119. If Result then
  120. Result:=SetEndOfFile(handle);
  121. end;
  122. Function DosToWinTime (DTime:longint;Var Wtime : TFileTime):longbool;
  123. var
  124. lft : TFileTime;
  125. begin
  126. {$IFDEF VIRTUALPASCAL}
  127. DosToWinTime:=DosDateTimeToFileTime(longrec(dtime).hi,longrec(dtime).lo,lft) and
  128. LocalFileTimeToFileTime(lft,Wtime);
  129. {$ELSE}
  130. DosToWinTime:=DosDateTimeToFileTime(longrec(dtime).hi,longrec(dtime).lo,@lft) and
  131. LocalFileTimeToFileTime(lft,Wtime);
  132. {$ENDIF}
  133. end;
  134. Function WinToDosTime (Var Wtime : TFileTime;var DTime:longint):longbool;
  135. var
  136. lft : TFileTime;
  137. begin
  138. WinToDosTime:=FileTimeToLocalFileTime(WTime,lft) and
  139. FileTimeToDosDateTime(lft,Longrec(Dtime).Hi,LongRec(DTIME).lo);
  140. end;
  141. Function FileAge (Const FileName : String): Longint;
  142. var
  143. Handle: THandle;
  144. FindData: TWin32FindData;
  145. begin
  146. Handle := FindFirstFile(Pchar(FileName), FindData);
  147. if Handle <> INVALID_HANDLE_VALUE then
  148. begin
  149. Windows.FindClose(Handle);
  150. if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
  151. If WinToDosTime(FindData.ftLastWriteTime,Result) then
  152. exit;
  153. end;
  154. Result := -1;
  155. end;
  156. Function FileExists (Const FileName : String) : Boolean;
  157. var
  158. Handle: THandle;
  159. FindData: TWin32FindData;
  160. begin
  161. Handle := FindFirstFile(Pchar(FileName), FindData);
  162. Result:=Handle <> INVALID_HANDLE_VALUE;
  163. If Result then
  164. Windows.FindClose(Handle);
  165. end;
  166. Function DirectoryExists (Const Directory : String) : Boolean;
  167. var
  168. Handle: THandle;
  169. FindData: TWin32FindData;
  170. begin
  171. Result:=False;
  172. Handle := FindFirstFile(Pchar(Directory), FindData);
  173. If (Handle <> INVALID_HANDLE_VALUE) then
  174. begin
  175. Result:=((FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY);
  176. Windows.FindClose(Handle);
  177. end;
  178. end;
  179. Function FindMatch(var f: TSearchRec) : Longint;
  180. begin
  181. { Find file with correct attribute }
  182. While (F.FindData.dwFileAttributes and cardinal(F.ExcludeAttr))<>0 do
  183. begin
  184. if not FindNextFile (F.FindHandle,F.FindData) then
  185. begin
  186. Result:=GetLastError;
  187. exit;
  188. end;
  189. end;
  190. { Convert some attributes back }
  191. WinToDosTime(F.FindData.ftLastWriteTime,F.Time);
  192. f.size:=F.FindData.NFileSizeLow;
  193. f.attr:=F.FindData.dwFileAttributes;
  194. f.Name:=StrPas(@F.FindData.cFileName);
  195. Result:=0;
  196. end;
  197. Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
  198. begin
  199. Rslt.Name:=Path;
  200. Rslt.Attr:=attr;
  201. Rslt.ExcludeAttr:=(not Attr) and ($1e);
  202. { $1e = faHidden or faSysFile or faVolumeID or faDirectory }
  203. { FindFirstFile is a Win32 Call }
  204. Rslt.FindHandle:=FindFirstFile (PChar(Path),Rslt.FindData);
  205. If Rslt.FindHandle=Invalid_Handle_value then
  206. begin
  207. Result:=GetLastError;
  208. exit;
  209. end;
  210. { Find file with correct attribute }
  211. Result:=FindMatch(Rslt);
  212. end;
  213. Function FindNext (Var Rslt : TSearchRec) : Longint;
  214. begin
  215. if FindNextFile(Rslt.FindHandle, Rslt.FindData) then
  216. Result := FindMatch(Rslt)
  217. else
  218. Result := GetLastError;
  219. end;
  220. Procedure FindClose (Var F : TSearchrec);
  221. begin
  222. if F.FindHandle <> INVALID_HANDLE_VALUE then
  223. Windows.FindClose(F.FindHandle);
  224. end;
  225. Function FileGetDate (Handle : Longint) : Longint;
  226. Var
  227. FT : TFileTime;
  228. begin
  229. If GetFileTime(Handle,nil,nil,@ft) and
  230. WinToDosTime(FT,Result) then
  231. exit;
  232. Result:=-1;
  233. end;
  234. Function FileSetDate (Handle,Age : Longint) : Longint;
  235. Var
  236. FT: TFileTime;
  237. begin
  238. {$IFDEF VIRTUALPASCAL}
  239. Result := 0;
  240. {$ELSE}
  241. Result := 0;
  242. if DosToWinTime(Age,FT) and
  243. SetFileTime(Handle, ft, ft, FT) then
  244. Exit;
  245. Result := GetLastError;
  246. {$ENDIF}
  247. end;
  248. Function FileGetAttr (Const FileName : String) : Longint;
  249. begin
  250. Result:=GetFileAttributes(PChar(FileName));
  251. end;
  252. Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
  253. begin
  254. if not SetFileAttributes(PChar(FileName), Attr) then
  255. Result := GetLastError
  256. else
  257. Result:=0;
  258. end;
  259. Function DeleteFile (Const FileName : String) : Boolean;
  260. begin
  261. DeleteFile:=Windows.DeleteFile(Pchar(FileName));
  262. end;
  263. Function RenameFile (Const OldName, NewName : String) : Boolean;
  264. begin
  265. Result := MoveFile(PChar(OldName), PChar(NewName));
  266. end;
  267. {****************************************************************************
  268. Disk Functions
  269. ****************************************************************************}
  270. function GetDiskFreeSpace(drive:pchar;var sector_cluster,bytes_sector,
  271. freeclusters,totalclusters:longint):longbool;
  272. stdcall;external 'kernel32' name 'GetDiskFreeSpaceA';
  273. type
  274. {$IFDEF VIRTUALPASCAL}
  275. {&StdCall+}
  276. TGetDiskFreeSpaceEx = function(drive:pchar;var availableforcaller,total,free):longbool;
  277. {&StdCall-}
  278. {$ELSE}
  279. TGetDiskFreeSpaceEx = function(drive:pchar;var availableforcaller,total,free):longbool;stdcall;
  280. {$ENDIF}
  281. var
  282. GetDiskFreeSpaceEx : TGetDiskFreeSpaceEx;
  283. function diskfree(drive : byte) : int64;
  284. var
  285. disk : array[1..4] of char;
  286. secs,bytes,
  287. free,total : longint;
  288. qwtotal,qwfree,qwcaller : int64;
  289. begin
  290. if drive=0 then
  291. begin
  292. disk[1]:='\';
  293. disk[2]:=#0;
  294. end
  295. else
  296. begin
  297. disk[1]:=chr(drive+64);
  298. disk[2]:=':';
  299. disk[3]:='\';
  300. disk[4]:=#0;
  301. end;
  302. if assigned(GetDiskFreeSpaceEx) then
  303. begin
  304. if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then
  305. diskfree:=qwfree
  306. else
  307. diskfree:=-1;
  308. end
  309. else
  310. begin
  311. if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
  312. diskfree:=int64(free)*secs*bytes
  313. else
  314. diskfree:=-1;
  315. end;
  316. end;
  317. function disksize(drive : byte) : int64;
  318. var
  319. disk : array[1..4] of char;
  320. secs,bytes,
  321. free,total : longint;
  322. qwtotal,qwfree,qwcaller : int64;
  323. begin
  324. if drive=0 then
  325. begin
  326. disk[1]:='\';
  327. disk[2]:=#0;
  328. end
  329. else
  330. begin
  331. disk[1]:=chr(drive+64);
  332. disk[2]:=':';
  333. disk[3]:='\';
  334. disk[4]:=#0;
  335. end;
  336. if assigned(GetDiskFreeSpaceEx) then
  337. begin
  338. if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then
  339. disksize:=qwtotal
  340. else
  341. disksize:=-1;
  342. end
  343. else
  344. begin
  345. if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
  346. disksize:=int64(total)*secs*bytes
  347. else
  348. disksize:=-1;
  349. end;
  350. end;
  351. Function GetCurrentDir : String;
  352. begin
  353. GetDir(0, result);
  354. end;
  355. Function SetCurrentDir (Const NewDir : String) : Boolean;
  356. begin
  357. {$I-}
  358. ChDir(NewDir);
  359. {$I+}
  360. result := (IOResult = 0);
  361. end;
  362. Function CreateDir (Const NewDir : String) : Boolean;
  363. begin
  364. {$I-}
  365. MkDir(NewDir);
  366. {$I+}
  367. result := (IOResult = 0);
  368. end;
  369. Function RemoveDir (Const Dir : String) : Boolean;
  370. begin
  371. {$I-}
  372. RmDir(Dir);
  373. {$I+}
  374. result := (IOResult = 0);
  375. end;
  376. {****************************************************************************
  377. Time Functions
  378. ****************************************************************************}
  379. Procedure GetLocalTime(var SystemTime: TSystemTime);
  380. Var
  381. Syst : Windows.TSystemtime;
  382. begin
  383. windows.Getlocaltime(@syst);
  384. SystemTime.year:=syst.wYear;
  385. SystemTime.month:=syst.wMonth;
  386. SystemTime.day:=syst.wDay;
  387. SystemTime.hour:=syst.wHour;
  388. SystemTime.minute:=syst.wMinute;
  389. SystemTime.second:=syst.wSecond;
  390. SystemTime.millisecond:=syst.wMilliSeconds;
  391. end;
  392. {****************************************************************************
  393. Misc Functions
  394. ****************************************************************************}
  395. procedure Beep;
  396. begin
  397. MessageBeep(0);
  398. end;
  399. {****************************************************************************
  400. Locale Functions
  401. ****************************************************************************}
  402. Procedure InitAnsi;
  403. Var
  404. i : longint;
  405. begin
  406. { Fill table entries 0 to 127 }
  407. for i := 0 to 96 do
  408. UpperCaseTable[i] := chr(i);
  409. for i := 97 to 122 do
  410. UpperCaseTable[i] := chr(i - 32);
  411. for i := 123 to 191 do
  412. UpperCaseTable[i] := chr(i);
  413. Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
  414. for i := 0 to 64 do
  415. LowerCaseTable[i] := chr(i);
  416. for i := 65 to 90 do
  417. LowerCaseTable[i] := chr(i + 32);
  418. for i := 91 to 191 do
  419. LowerCaseTable[i] := chr(i);
  420. Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
  421. end;
  422. function GetLocaleStr(LID, LT: Longint; const Def: string): ShortString;
  423. var
  424. L: Integer;
  425. Buf: array[0..255] of Char;
  426. begin
  427. L := GetLocaleInfo(LID, LT, Buf, SizeOf(Buf));
  428. if L > 0 then
  429. SetString(Result, @Buf[0], L - 1)
  430. else
  431. Result := Def;
  432. end;
  433. function GetLocaleChar(LID, LT: Longint; Def: Char): Char;
  434. var
  435. Buf: array[0..1] of Char;
  436. begin
  437. if GetLocaleInfo(LID, LT, Buf, 2) > 0 then
  438. Result := Buf[0]
  439. else
  440. Result := Def;
  441. end;
  442. Function GetLocaleInt(LID,TP,Def: LongInt): LongInt;
  443. Var
  444. S: String;
  445. C: Integer;
  446. Begin
  447. S:=GetLocaleStr(LID,TP,'0');
  448. Val(S,Result,C);
  449. If C<>0 Then
  450. Result:=Def;
  451. End;
  452. procedure GetFormatSettings;
  453. var
  454. HF : Shortstring;
  455. LID : LCID;
  456. I,Day,DateOrder : longint;
  457. begin
  458. LID := GetThreadLocale;
  459. { Date stuff }
  460. for I := 1 to 12 do
  461. begin
  462. ShortMonthNames[I]:=GetLocaleStr(LID,LOCALE_SABBREVMONTHNAME1+I-1,ShortMonthNames[i]);
  463. LongMonthNames[I]:=GetLocaleStr(LID,LOCALE_SMONTHNAME1+I-1,LongMonthNames[i]);
  464. end;
  465. for I := 1 to 7 do
  466. begin
  467. Day := (I + 5) mod 7;
  468. ShortDayNames[I]:=GetLocaleStr(LID,LOCALE_SABBREVDAYNAME1+Day,ShortDayNames[i]);
  469. LongDayNames[I]:=GetLocaleStr(LID,LOCALE_SDAYNAME1+Day,LongDayNames[i]);
  470. end;
  471. DateSeparator := GetLocaleChar(LID, LOCALE_SDATE, '/');
  472. DateOrder := GetLocaleInt(LID, LOCALE_IDate, 0);
  473. Case DateOrder Of
  474. 1: Begin
  475. ShortDateFormat := 'dd/mm/yyyy';
  476. LongDateFormat := 'dddd, d. mmmm yyyy';
  477. End;
  478. 2: Begin
  479. ShortDateFormat := 'yyyy/mm/dd';
  480. LongDateFormat := 'dddd, yyyy mmmm d.';
  481. End;
  482. else
  483. // Default american settings...
  484. ShortDateFormat := 'mm/dd/yyyy';
  485. LongDateFormat := 'dddd, mmmm d. yyyy';
  486. End;
  487. { Time stuff }
  488. TimeSeparator := GetLocaleChar(LID, LOCALE_STIME, ':');
  489. TimeAMString := GetLocaleStr(LID, LOCALE_S1159, 'AM');
  490. TimePMString := GetLocaleStr(LID, LOCALE_S2359, 'PM');
  491. if StrToIntDef(GetLocaleStr(LID, LOCALE_ITLZERO, '0'), 0) = 0 then
  492. HF:='h'
  493. else
  494. HF:='hh';
  495. // No support for 12 hour stuff at the moment...
  496. ShortTimeFormat := HF+':nn';
  497. LongTimeFormat := HF + ':nn:ss';
  498. { Currency stuff }
  499. CurrencyString:=GetLocaleStr(LID, LOCALE_SCURRENCY, '');
  500. CurrencyFormat:=StrToIntDef(GetLocaleStr(LID, LOCALE_ICURRENCY, '0'), 0);
  501. NegCurrFormat:=StrToIntDef(GetLocaleStr(LID, LOCALE_INEGCURR, '0'), 0);
  502. { Number stuff }
  503. ThousandSeparator:=GetLocaleChar(LID, LOCALE_STHOUSAND, ',');
  504. DecimalSeparator:=GetLocaleChar(LID, LOCALE_SDECIMAL, '.');
  505. CurrencyDecimals:=StrToIntDef(GetLocaleStr(LID, LOCALE_ICURRDIGITS, '0'), 0);
  506. end;
  507. Procedure InitInternational;
  508. begin
  509. InitAnsi;
  510. GetFormatSettings;
  511. end;
  512. {****************************************************************************
  513. Target Dependent
  514. ****************************************************************************}
  515. function FormatMessageA(dwFlags : DWORD;
  516. lpSource : Pointer;
  517. dwMessageId : DWORD;
  518. dwLanguageId: DWORD;
  519. lpBuffer : PCHAR;
  520. nSize : DWORD;
  521. Arguments : Pointer): DWORD; stdcall;external 'kernel32' name 'FormatMessageA';
  522. function SysErrorMessage(ErrorCode: Integer): String;
  523. const
  524. MaxMsgSize = Format_Message_Max_Width_Mask;
  525. var
  526. MsgBuffer: pChar;
  527. begin
  528. GetMem(MsgBuffer, MaxMsgSize);
  529. FillChar(MsgBuffer^, MaxMsgSize, #0);
  530. FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,
  531. nil,
  532. ErrorCode,
  533. MakeLangId(LANG_NEUTRAL, SUBLANG_DEFAULT),
  534. MsgBuffer, { This function allocs the memory }
  535. MaxMsgSize, { Maximum message size }
  536. nil);
  537. SysErrorMessage := StrPas(MsgBuffer);
  538. FreeMem(MsgBuffer, MaxMsgSize);
  539. end;
  540. {****************************************************************************
  541. Initialization code
  542. ****************************************************************************}
  543. Function GetEnvironmentVariable(Const EnvVar : String) : String;
  544. var
  545. s : string;
  546. i : longint;
  547. hp,p : pchar;
  548. begin
  549. Result:='';
  550. p:=GetEnvironmentStrings;
  551. hp:=p;
  552. while hp^<>#0 do
  553. begin
  554. s:=strpas(hp);
  555. i:=pos('=',s);
  556. if uppercase(copy(s,1,i-1))=upcase(envvar) then
  557. begin
  558. Result:=copy(s,i+1,length(s)-i);
  559. break;
  560. end;
  561. { next string entry}
  562. hp:=hp+strlen(hp)+1;
  563. end;
  564. FreeEnvironmentStrings(p);
  565. end;
  566. function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
  567. var
  568. SI: TStartupInfo;
  569. PI: TProcessInformation;
  570. Proc : TWin32Handle;
  571. l : DWord;
  572. CommandLine : ansistring;
  573. e : EOSError;
  574. begin
  575. DosError := 0;
  576. FillChar(SI, SizeOf(SI), 0);
  577. SI.cb:=SizeOf(SI);
  578. SI.wShowWindow:=1;
  579. { always surround the name of the application by quotes
  580. so that long filenames will always be accepted. But don't
  581. do it if there are already double quotes, since Win32 does not
  582. like double quotes which are duplicated!
  583. }
  584. if pos('"',path)=0 then
  585. CommandLine:='"'+path+'"'
  586. else
  587. CommandLine:=path;
  588. if ComLine <> '' then
  589. CommandLine:=Commandline+' '+ComLine+#0
  590. else
  591. CommandLine := CommandLine + #0;
  592. if not CreateProcess(nil, pchar(CommandLine),
  593. Nil, Nil, ExecInheritsHandles,$20, Nil, Nil, SI, PI) then
  594. begin
  595. e:=EOSError.CreateFmt(SExecuteProcessFailed,[CommandLine,GetLastError]);
  596. e.ErrorCode:=GetLastError;
  597. raise e;
  598. end;
  599. Proc:=PI.hProcess;
  600. CloseHandle(PI.hThread);
  601. if WaitForSingleObject(Proc, dword($ffffffff)) <> $ffffffff then
  602. begin
  603. GetExitCodeProcess(Proc,l);
  604. CloseHandle(Proc);
  605. result:=l;
  606. end
  607. else
  608. begin
  609. e:=EOSError.CreateFmt(SExecuteProcessFailed,[CommandLine,GetLastError]);
  610. e.ErrorCode:=GetLastError;
  611. CloseHandle(Proc);
  612. raise e;
  613. end;
  614. end;
  615. Procedure Sleep(Milliseconds : Cardinal);
  616. begin
  617. Windows.Sleep(MilliSeconds)
  618. end;
  619. {****************************************************************************
  620. Initialization code
  621. ****************************************************************************}
  622. var
  623. kernel32dll : THandle;
  624. Procedure LoadVersionInfo;
  625. // and getfreespaceex
  626. Var
  627. versioninfo : TOSVERSIONINFO;
  628. i : Integer;
  629. begin
  630. kernel32dll:=0;
  631. GetDiskFreeSpaceEx:=nil;
  632. versioninfo.dwOSVersionInfoSize:=sizeof(versioninfo);
  633. GetVersionEx(versioninfo);
  634. Win32Platform:=versionInfo.dwPlatformId;
  635. Win32MajorVersion:=versionInfo.dwMajorVersion;
  636. Win32MinorVersion:=versionInfo.dwMinorVersion;
  637. Win32BuildNumber:=versionInfo.dwBuildNumber;
  638. Move (versioninfo.szCSDVersion ,Win32CSDVersion[1],128);
  639. win32CSDVersion[0]:=chr(strlen(pchar(@versioninfo.szCSDVersion)));
  640. if ((versioninfo.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS) and
  641. (versioninfo.dwBuildNUmber>=1000)) or
  642. (versioninfo.dwPlatformId=VER_PLATFORM_WIN32_NT) then
  643. begin
  644. kernel32dll:=LoadLibrary('kernel32');
  645. if kernel32dll<>0 then
  646. {$IFDEF VIRTUALPASCAL}
  647. @GetDiskFreeSpaceEx:=GetProcAddress(0,'GetDiskFreeSpaceExA');
  648. {$ELSE}
  649. GetDiskFreeSpaceEx:=TGetDiskFreeSpaceEx(GetProcAddress(kernel32dll,'GetDiskFreeSpaceExA'));
  650. {$ENDIF}
  651. end;
  652. end;
  653. function FreeLibrary(hLibModule : THANDLE) : longbool;
  654. stdcall;external 'kernel32' name 'FreeLibrary';
  655. function GetVersionEx(var VersionInformation:TOSVERSIONINFO) : longbool;
  656. stdcall;external 'kernel32' name 'GetVersionExA';
  657. function LoadLibrary(lpLibFileName : pchar):THandle;
  658. stdcall;external 'kernel32' name 'LoadLibraryA';
  659. function GetProcAddress(hModule : THandle;lpProcName : pchar) : pointer;
  660. stdcall;external 'kernel32' name 'GetProcAddress';
  661. Initialization
  662. InitExceptions; { Initialize exceptions. OS independent }
  663. InitInternational; { Initialize internationalization settings }
  664. LoadVersionInfo;
  665. Finalization
  666. DoneExceptions;
  667. if kernel32dll<>0 then
  668. FreeLibrary(kernel32dll);
  669. end.
  670. {
  671. $Log$
  672. Revision 1.31 2004-01-20 23:12:49 hajny
  673. * ExecuteProcess fixes, ProcessID and ThreadID added
  674. Revision 1.30 2004/01/16 20:53:33 michael
  675. + DirectoryExists now closes findfirst handle
  676. Revision 1.29 2004/01/10 17:40:25 michael
  677. + Added Sleep() function
  678. Revision 1.28 2004/01/05 22:56:08 florian
  679. * changed sysutils.exec to ExecuteProcess
  680. Revision 1.27 2003/11/26 20:00:19 florian
  681. * error handling for Variants improved
  682. Revision 1.26 2003/11/06 22:25:10 marco
  683. * added some more of win32* delphi pseudo constants
  684. Revision 1.25 2003/10/25 23:44:33 hajny
  685. * THandle in sysutils common using System.THandle
  686. Revision 1.24 2003/09/17 15:06:36 peter
  687. * stdcall patch
  688. Revision 1.23 2003/09/06 22:23:35 marco
  689. * VP fixes.
  690. Revision 1.22 2003/04/01 15:57:41 peter
  691. * made THandle platform dependent and unique type
  692. Revision 1.21 2003/03/29 18:21:42 hajny
  693. * DirectoryExists declaration changed to that one from fixes branch
  694. Revision 1.20 2003/03/28 19:06:59 peter
  695. * directoryexists added
  696. Revision 1.19 2003/01/03 20:41:04 peter
  697. * FileCreate(string,mode) overload added
  698. Revision 1.18 2003/01/01 20:56:57 florian
  699. + added invalid instruction exception
  700. Revision 1.17 2002/12/15 20:24:17 peter
  701. * some more C style functions
  702. Revision 1.16 2002/10/02 21:17:03 florian
  703. * we've to reimport TSystemTime time from the windows unit
  704. Revision 1.15 2002/09/07 16:01:29 peter
  705. * old logs removed and tabs fixed
  706. Revision 1.14 2002/05/09 08:28:23 carl
  707. * Merges from Fixes branch
  708. Revision 1.13 2002/03/24 19:26:49 marco
  709. * Added win32platform
  710. Revision 1.12 2002/01/25 16:23:04 peter
  711. * merged filesearch() fix
  712. }