Quick.Commons.pas 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860
  1. { ***************************************************************************
  2. Copyright (c) 2016-2018 Kike Pérez
  3. Unit : Quick.Commons
  4. Description : Common functions
  5. Author : Kike Pérez
  6. Version : 1.2
  7. Created : 14/07/2017
  8. Modified : 22/01/2018
  9. This file is part of QuickLib: https://github.com/exilon/QuickLib
  10. ***************************************************************************
  11. Licensed under the Apache License, Version 2.0 (the "License");
  12. you may not use this file except in compliance with the License.
  13. You may obtain a copy of the License at
  14. http://www.apache.org/licenses/LICENSE-2.0
  15. Unless required by applicable law or agreed to in writing, software
  16. distributed under the License is distributed on an "AS IS" BASIS,
  17. WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  18. See the License for the specific language governing permissions and
  19. limitations under the License.
  20. *************************************************************************** }
  21. unit Quick.Commons;
  22. interface
  23. uses
  24. Classes,
  25. System.SysUtils,
  26. System.Types,
  27. {$IFDEF MSWINDOWS}
  28. Windows,
  29. Winapi.ShlObj,
  30. System.Win.Registry,
  31. {$ENDIF MSWINDOWS}
  32. System.IOUtils,
  33. System.DateUtils;
  34. type
  35. TLogEventType = (etInfo, etSuccess, etWarning, etError, etDebug, etTrace);
  36. TLogVerbose = set of TLogEventType;
  37. const
  38. LOG_ONLYERRORS = [etInfo,etError];
  39. LOG_ERRORSANDWARNINGS = [etInfo,etWarning,etError];
  40. LOG_TRACE = [etInfo,etError,etWarning,etTrace];
  41. LOG_ALL = [etInfo,etSuccess,etWarning,etError,etTrace];
  42. LOG_DEBUG = [etInfo,etSuccess,etWarning,etError,etDebug];
  43. EventStr : array of string = ['INFO','SUCC','WARN','ERROR','DEBUG','TRACE'];
  44. type
  45. TPasswordComplexity = set of (pfIncludeNumbers,pfIncludeSigns);
  46. {$IFDEF MSWINDOWS}
  47. TEnvironmentPath = record
  48. EXEPATH : string;
  49. WINDOWS : string;
  50. SYSTEM : string;
  51. PROGRAMFILES : string;
  52. COMMONFILES : string;
  53. HOMEDRIVE : string;
  54. TEMP : string;
  55. USERPROFILE : string;
  56. INSTDRIVE : string;
  57. DESKTOP : string;
  58. STARTMENU : string;
  59. DESKTOP_ALLUSERS : string;
  60. STARTMENU_ALLUSERS : string;
  61. STARTUP : string;
  62. APPDATA : String;
  63. PROGRAMDATA : string;
  64. ALLUSERSPROFILE : string;
  65. end;
  66. {$ENDIF MSWINDOWS}
  67. TFileHelper = record helper for TFile
  68. class function IsInUse(const FileName : string) : Boolean; static;
  69. class function GetSize(const FileName: String): Int64; static;
  70. end;
  71. TDirectoryHelper = record helper for TDirectory
  72. class function GetSize(const Path: String): Int64; static;
  73. end;
  74. TTextFileOperation = (tfOpenRead,tfOpenOverwrite,tfOpenAppend);
  75. TTextStreamFile = class
  76. private
  77. fReadStream : TStreamReader;
  78. fWriteStream : TStreamWriter;
  79. function GetEOF : Boolean;
  80. public
  81. constructor Create(const FileName : string; OpenMode : TTextFileOperation);
  82. destructor Destroy; override;
  83. function ReadLn: string; overload;
  84. function ReadLn(out Data: string): Boolean; overload;
  85. procedure WriteLn (const Data : string);
  86. procedure Close;
  87. property EOF: Boolean read GetEOF;
  88. end;
  89. TCounter = record
  90. private
  91. fMaxValue : Integer;
  92. fCurrentValue : Integer;
  93. public
  94. property MaxValue : Integer read fMaxValue;
  95. procedure Init(aMaxValue : Integer);
  96. function Count : Integer;
  97. function CountIs(aValue : Integer) : Boolean;
  98. function Check : Boolean;
  99. procedure Reset;
  100. end;
  101. TTimeCounter = record
  102. private
  103. fCurrentTime : TDateTime;
  104. fDoneEvery : Integer;
  105. public
  106. property DoneEvery : Integer read fDoneEvery;
  107. procedure Init(MillisecondsToReach : Integer);
  108. function Check : Boolean;
  109. procedure Reset;
  110. end;
  111. EEnvironmentPath = class(Exception);
  112. EShellError = class(Exception);
  113. //generates a random password with complexity options
  114. function RandomPassword(const PasswordLength : Integer; Complexity : TPasswordComplexity = [pfIncludeNumbers,pfIncludeSigns]) : string;
  115. //extracts file extension from a filename
  116. function ExtractFileNameWithoutExt(const FileName: String): String;
  117. //converts a Unix path to Windows path
  118. function UnixToWindowsPath(const UnixPath: string): string;
  119. //converts a Windows path to Unix path
  120. function WindowsToUnixPath(const WindowsPath: string): string;
  121. //corrects malformed urls
  122. function CorrectURLPath(cUrl : string) : string;
  123. {$IFDEF MSWINDOWS}
  124. //get typical environment paths as temp, desktop, etc
  125. procedure GetEnvironmentPaths;
  126. function GetSpecialFolderPath(folderID : Integer) : string;
  127. //checks if running on a 64bit OS
  128. function Is64bitOS : Boolean;
  129. //checks if is a console app
  130. function IsConsole : Boolean;
  131. //checks if compiled in debug mode
  132. function IsDebug : Boolean;
  133. //checks if running as a service
  134. function IsService : Boolean;
  135. //gets number of seconds without user interaction (mouse, keyboard)
  136. function SecondsIdle: DWord;
  137. //frees process memory not needed
  138. procedure FreeUnusedMem;
  139. //changes screen resolution
  140. function SetScreenResolution(Width, Height: integer): Longint;
  141. {$ENDIF MSWINDOWS}
  142. //returns last day of current month
  143. function LastDayCurrentMonth: TDateTime;
  144. //checks if two datetimes are in same day
  145. function IsSameDay(cBefore, cNow : TDateTime) : Boolean;
  146. //returns n times a char
  147. function FillStr(const C : Char; const Count : Byte) : string;
  148. //returns a number leading zero
  149. function Zeroes(const Number, Len : Int64) : string;
  150. //converts a number to thousand delimeter string
  151. function NumberToStr(const Number : Int64) : string;
  152. //returns n spaces
  153. function Spaces(const Count : Integer) : string;
  154. //returns current date as a string
  155. function NowStr : string;
  156. //returns a new GUID as string
  157. function NewGuidStr : string;
  158. //compare a string with a wildcard pattern (? or *)
  159. function IsLike(cText, Pattern: string) : Boolean;
  160. //Upper case for first letter
  161. function Capitalize(s: string): string;
  162. function CapitalizeWords(s: string): string;
  163. //returns current logged user
  164. function GetLoggedUserName : string;
  165. //returns computer name
  166. function GetComputerName : string;
  167. //Changes incorrect delims in path
  168. function NormalizePathDelim(const cPath : string; const Delim : Char) : string;
  169. //Removes last segment of a path
  170. function RemoveLastPathSegment(cDir : string) : string;
  171. //finds swith in commandline params
  172. function ParamFindSwitch(const Switch : string) : Boolean;
  173. //gets value for a switch if exists
  174. function ParamGetSwitch(const Switch : string; var cvalue : string) : Boolean;
  175. //returns app version (major & minor)
  176. function GetAppVersionStr: string;
  177. //returns app version full (major, minor, release & compiled)
  178. function GetAppVersionFullStr: string;
  179. //UTC DateTime to Local DateTime
  180. function UTCToLocalTime(GMTTime: TDateTime): TDateTime;
  181. //Local DateTime to UTC DateTime
  182. function LocalTimeToUTC(LocalTime : TDateTime): TDateTime;
  183. //count number of digits of a Integer
  184. function CountDigits(anInt: Cardinal): Cardinal; inline;
  185. //save stream to file
  186. procedure SaveStreamToFile(stream : TStream; const filename : string);
  187. //process messages on console applications
  188. procedure ProcessMessages;
  189. var
  190. {$IFDEF MSWINDOWS}
  191. path : TEnvironmentPath;
  192. {$ENDIF MSWINDOWS}
  193. implementation
  194. {TFileHelper}
  195. class function TFileHelper.IsInUse(const FileName : string) : Boolean;
  196. var
  197. HFileRes: HFILE;
  198. begin
  199. Result := False;
  200. if not FileExists(FileName) then Exit;
  201. try
  202. HFileRes := CreateFile(PChar(FileName)
  203. ,GENERIC_READ or GENERIC_WRITE
  204. ,0
  205. ,nil
  206. ,OPEN_EXISTING
  207. ,FILE_ATTRIBUTE_NORMAL
  208. ,0);
  209. Result := (HFileRes = INVALID_HANDLE_VALUE);
  210. if not(Result) then begin
  211. CloseHandle(HFileRes);
  212. end;
  213. except
  214. Result := True;
  215. end;
  216. end;
  217. class function TFileHelper.GetSize(const FileName: String): Int64;
  218. var
  219. info: TWin32FileAttributeData;
  220. begin
  221. Result := -1;
  222. if not GetFileAttributesEx(PWideChar(FileName), GetFileExInfoStandard, @info) then Exit;
  223. Result := Int64(info.nFileSizeLow) or Int64(info.nFileSizeHigh shl 32);
  224. end;
  225. {TDirectoryHelper}
  226. class function TDirectoryHelper.GetSize(const Path: String): Int64;
  227. var
  228. filename : string;
  229. begin
  230. Result := -1;
  231. for filename in TDirectory.GetFiles(Path) do
  232. begin
  233. Result := Result + TFile.GetSize(filename);
  234. end;
  235. end;
  236. {TTextStreamFile}
  237. constructor TTextStreamFile.Create(const FileName : string; OpenMode : TTextFileOperation);
  238. var
  239. Append : Boolean;
  240. begin
  241. if OpenMode = tfOpenRead then fReadStream := TStreamReader.Create(FileName,True)
  242. else
  243. begin
  244. if OpenMode = tfOpenAppend then Append := True
  245. else Append := False;
  246. fWriteStream := TStreamWriter.Create(FileName,Append);
  247. end;
  248. end;
  249. destructor TTextStreamFile.Destroy;
  250. begin
  251. if Assigned(fReadStream) then fReadStream.Free;
  252. if Assigned(fWriteStream) then fWriteStream.Free;
  253. inherited Destroy;
  254. end;
  255. function TTextStreamFile.ReadLn(out Data: string): Boolean;
  256. begin
  257. Data := fReadStream.ReadLine;
  258. Result := Data <> '';
  259. end;
  260. function TTextStreamFile.ReadLn: string;
  261. begin
  262. Result := fReadStream.ReadLine;
  263. end;
  264. procedure TTextStreamFile.WriteLn (const Data : string);
  265. begin
  266. fWriteStream.WriteLine(Data);
  267. end;
  268. function TTextStreamFile.GetEOF : Boolean;
  269. begin
  270. Result := fReadStream.EndOfStream;
  271. end;
  272. procedure TTextStreamFile.Close;
  273. begin
  274. if Assigned(fReadStream) then fReadStream.Close;
  275. if Assigned(fWriteStream) then fWriteStream.Close;
  276. end;
  277. {other functions}
  278. function RandomPassword(const PasswordLength : Integer; Complexity : TPasswordComplexity = [pfIncludeNumbers,pfIncludeSigns]) : string;
  279. const
  280. PassAlpha = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
  281. PassSigns = '@!&$';
  282. PassNumbers = '1234567890';
  283. var
  284. MinNumbers,
  285. MinSigns : Integer;
  286. NumNumbers,
  287. NumSigns : Integer;
  288. begin
  289. Result := '';
  290. Randomize;
  291. //fill all alfa
  292. repeat
  293. Result := Result + PassAlpha[Random(Length(PassAlpha))+1];
  294. until (Length(Result) = PasswordLength);
  295. //checks if need include numbers
  296. if pfIncludeNumbers in Complexity then
  297. begin
  298. MinNumbers := Round(PasswordLength / 10 * 2);
  299. NumNumbers := 0;
  300. if MinNumbers = 0 then MinNumbers := 1;
  301. repeat
  302. Result[Random(PasswordLength)+1] := PassNumbers[Random(Length(PassNumbers))+1];
  303. Inc(NumNumbers);
  304. until NumNumbers = MinNumbers;
  305. end;
  306. //checks if need include signs
  307. if pfIncludeNumbers in Complexity then
  308. begin
  309. MinSigns := Round(PasswordLength / 10 * 1);
  310. NumSigns := 0;
  311. if MinSigns = 0 then MinSigns := 1;
  312. repeat
  313. Result[Random(PasswordLength)+1] := PassSigns[Random(Length(PassSigns))+1];
  314. Inc(NumSigns);
  315. until NumSigns = MinSigns;
  316. end;
  317. end;
  318. function ExtractFileNameWithoutExt(const FileName: String): String;
  319. begin
  320. Result := TPath.GetFileNameWithoutExtension(FileName);
  321. end;
  322. function UnixToWindowsPath(const UnixPath: string): string;
  323. begin
  324. Result := StringReplace(UnixPath, '/', '\',[rfReplaceAll, rfIgnoreCase]);
  325. end;
  326. function WindowsToUnixPath(const WindowsPath: string): string;
  327. begin
  328. Result := StringReplace(WindowsPath, '\', '/',[rfReplaceAll, rfIgnoreCase]);
  329. end;
  330. function CorrectURLPath(cUrl : string) : string;
  331. var
  332. nurl : string;
  333. begin
  334. nurl := WindowsToUnixPath(cUrl);
  335. nurl := StringReplace(nurl,'//','/',[rfReplaceAll]);
  336. Result := StringReplace(nurl,' ','%20',[rfReplaceAll]);
  337. //TNetEncoding.Url.Encode()
  338. end;
  339. {$IFDEF MSWINDOWS}
  340. procedure GetEnvironmentPaths;
  341. begin
  342. //gets path
  343. path.EXEPATH := TPath.GetDirectoryName(ParamStr(0));
  344. path.WINDOWS := GetEnvironmentVariable('windir');
  345. path.PROGRAMFILES := GetEnvironmentVariable('ProgramFiles');
  346. path.COMMONFILES := GetEnvironmentVariable('CommonProgramFiles(x86)');
  347. path.HOMEDRIVE := GetEnvironmentVariable('SystemDrive');
  348. path.USERPROFILE := GetEnvironmentVariable('USERPROFILE');
  349. path.PROGRAMDATA := GetEnvironmentVariable('ProgramData');
  350. path.ALLUSERSPROFILE := GetEnvironmentVariable('AllUsersProfile');
  351. path.INSTDRIVE := path.HOMEDRIVE;
  352. path.TEMP := GetEnvironmentVariable('TEMP');
  353. path.SYSTEM := GetSpecialFolderPath(CSIDL_SYSTEM);
  354. path.APPDATA:=GetSpecialFolderPath(CSIDL_APPDATA);
  355. //these paths fail if user is SYSTEM
  356. try
  357. path.DESKTOP := GetSpecialFolderPath(CSIDL_DESKTOP);
  358. path.DESKTOP_ALLUSERS := GetSpecialFolderPath(CSIDL_COMMON_DESKTOPDIRECTORY);
  359. path.STARTMENU:=GetSpecialFolderPath(CSIDL_PROGRAMS);
  360. path.STARTMENU_ALLUSERS:=GetSpecialFolderPath(CSIDL_COMMON_PROGRAMS);
  361. path.STARTMENU_ALLUSERS := path.STARTMENU;
  362. path.STARTUP:=GetSpecialFolderPath(CSIDL_STARTUP);
  363. except
  364. //
  365. end;
  366. end;
  367. function GetSpecialFolderPath(folderID : Integer) : string;
  368. var
  369. ppidl: PItemIdList;
  370. begin
  371. SHGetSpecialFolderLocation(0, folderID, ppidl);
  372. SetLength(Result, MAX_PATH);
  373. if not SHGetPathFromIDList(ppidl, PChar(Result)) then
  374. begin
  375. raise EShellError.create(Format('GetSpecialFolderPath: Invalid PIPL (%d)',[folderID]));
  376. end;
  377. SetLength(Result, lStrLen(PChar(Result)));
  378. end;
  379. function Is64bitOS : Boolean;
  380. begin
  381. {$IFDEF WIN64}
  382. Result := True;
  383. {$ELSE}
  384. Result := False;
  385. {$ENDIF WIN64}
  386. end;
  387. function IsConsole: Boolean;
  388. begin
  389. {$IFDEF CONSOLE}
  390. Result := True;
  391. {$ELSE}
  392. Result := False;
  393. {$ENDIF CONSOLE}
  394. end;
  395. function IsDebug: Boolean;
  396. begin
  397. {$IFDEF DEBUG}
  398. Result := True;
  399. {$ELSE}
  400. Result := False;
  401. {$ENDIF DEBUG}
  402. end;
  403. function IsService : Boolean;
  404. begin
  405. //only working with my Quick.AppService unit
  406. try
  407. Result := (IsConsole) and (GetStdHandle(STD_OUTPUT_HANDLE) = 0);
  408. except
  409. Result := False;
  410. end;
  411. end;
  412. function SecondsIdle: DWord;
  413. var
  414. liInfo: TLastInputInfo;
  415. begin
  416. liInfo.cbSize := SizeOf(TLastInputInfo) ;
  417. GetLastInputInfo(liInfo) ;
  418. Result := (GetTickCount - liInfo.dwTime) DIV 1000;
  419. end;
  420. procedure FreeUnusedMem;
  421. begin
  422. if Win32Platform = VER_PLATFORM_WIN32_NT then SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);
  423. end;
  424. function SetScreenResolution(Width, Height: integer): Longint;
  425. var
  426. DeviceMode: TDeviceMode;
  427. begin
  428. with DeviceMode do
  429. begin
  430. dmSize := SizeOf(TDeviceMode);
  431. dmPelsWidth := Width;
  432. dmPelsHeight := Height;
  433. dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
  434. end;
  435. Result := ChangeDisplaySettings(DeviceMode, CDS_UPDATEREGISTRY);
  436. end;
  437. {$ENDIF MSWINDOWS}
  438. function LastDayCurrentMonth: TDateTime;
  439. begin
  440. Result := EncodeDate(YearOf(Now),MonthOf(Now), DaysInMonth(Now));
  441. end;
  442. function IsSameDay(cBefore, cNow : TDateTime) : Boolean;
  443. begin
  444. Result := DateTimeInRange(cNow,StartOfTheDay(cBefore),EndOfTheDay(cBefore),True);
  445. end;
  446. function FillStr(const C : Char; const Count : Byte) : string;
  447. var
  448. i : Byte;
  449. begin
  450. Result := '';
  451. for i := 1 to Count do Result := Result + C;
  452. end;
  453. function Zeroes(const Number, Len : Int64) : string;
  454. begin
  455. if Len > Length(IntToStr(Number)) then Result := FillStr('0',Len - Length(IntToStr(Number))) + IntToStr(Number)
  456. else Result := IntToStr(Number);
  457. end;
  458. function NumberToStr(const Number : Int64) : string;
  459. begin
  460. try
  461. Result := FormatFloat('0,',Number);
  462. except
  463. Result := '#Error';
  464. end;
  465. end;
  466. function Spaces(const Count : Integer) : string;
  467. begin
  468. Result := FillStr(' ',Count);
  469. end;
  470. function NowStr : string;
  471. begin
  472. Result := DateTimeToStr(Now());
  473. end;
  474. function NewGuidStr : string;
  475. var
  476. guid : TGUID;
  477. begin
  478. guid.NewGuid;
  479. Result := guid.ToString
  480. //GUIDToString(guid);
  481. end;
  482. function IsLike(cText, Pattern: string) : Boolean;
  483. var
  484. i, n : Integer;
  485. match : Boolean;
  486. wildcard : Boolean;
  487. CurrentPattern : Char;
  488. aux : string;
  489. begin
  490. Result := False;
  491. wildcard := False;
  492. cText := LowerCase(cText);
  493. Pattern := LowerCase(Pattern);
  494. match := False;
  495. if (Pattern.Length > cText.Length) or (Pattern = '') then Exit;
  496. if Pattern = '*' then
  497. begin
  498. Result := True;
  499. Exit;
  500. end;
  501. for i := 1 to cText.Length do
  502. begin
  503. CurrentPattern := Pattern[i];
  504. if CurrentPattern = '*' then wildcard := True;
  505. if wildcard then
  506. begin
  507. aux := Copy(Pattern,i+1,Pattern.Length);
  508. n := Pos(Copy(Pattern,i+1,Pattern.Length),cText);
  509. if (n > i) or (Pattern.Length = i) then
  510. begin
  511. Result := True;
  512. Exit;
  513. end;
  514. end
  515. else
  516. begin
  517. if (cText[i] = CurrentPattern) or (CurrentPattern = '?') then match := True
  518. else match := False;
  519. end;
  520. end;
  521. Result := match;
  522. end;
  523. function Capitalize(s: string): string;
  524. begin
  525. Result := '';
  526. if s.Length = 0 then Exit;
  527. s := LowerCase(s,loUserLocale);
  528. Result := UpperCase(s[1],loUserLocale) + Trim(Copy(s, 2, s.Length));
  529. end;
  530. function CapitalizeWords(s: string): string;
  531. var
  532. cword : string;
  533. begin
  534. Result := '';
  535. if s.Length = 0 then Exit;
  536. s := LowerCase(s,loUserLocale);
  537. for cword in s.Split([' ']) do
  538. begin
  539. if Result = '' then Result := Capitalize(cword)
  540. else Result := Result + ' ' + Capitalize(cword);
  541. end;
  542. end;
  543. function GetLoggedUserName : string;
  544. const
  545. cnMaxUserNameLen = 254;
  546. var
  547. sUserName : string;
  548. dwUserNameLen : DWord;
  549. begin
  550. dwUserNameLen := cnMaxUserNameLen-1;
  551. SetLength( sUserName, cnMaxUserNameLen );
  552. GetUserName(PChar( sUserName ),dwUserNameLen );
  553. SetLength( sUserName, dwUserNameLen );
  554. Result := sUserName;
  555. end;
  556. function GetComputerName : string;
  557. var
  558. dwLength: dword;
  559. begin
  560. dwLength := 253;
  561. SetLength(Result, dwLength+1);
  562. if not Windows.GetComputerName(pchar(result), dwLength) then Result := 'Not detected!';
  563. Result := pchar(result);
  564. end;
  565. function NormalizePathDelim(const cPath : string; const Delim : Char) : string;
  566. begin
  567. if Delim = '\' then Result := StringReplace(cPath,'/',Delim,[rfReplaceAll])
  568. else Result := StringReplace(cPath,'\',Delim,[rfReplaceAll]);
  569. end;
  570. function RemoveLastPathSegment(cDir : string) : string;
  571. var
  572. posi : Integer;
  573. delim : Char;
  574. EndsWithDelim : Boolean;
  575. begin
  576. if cDir.Contains('\') then delim := '\'
  577. else if cDir.Contains('/') then delim := '/'
  578. else
  579. begin
  580. Result := '';
  581. Exit;
  582. end;
  583. NormalizePathDelim(cDir,delim);
  584. if cDir.EndsWith(delim) then
  585. begin
  586. cDir := Copy(cDir,1,cDir.Length-1);
  587. EndsWithDelim := True;
  588. end
  589. else EndsWithDelim := False;
  590. if cDir.CountChar(delim) > 1 then posi := cDir.LastDelimiter(delim)
  591. else posi := Pos(delim,cDir)-1;
  592. if posi = cDir.Length then posi := 0;
  593. Result := Copy(cDir,1,posi);
  594. if (Result <> '') and (EndsWithDelim) then Result := Result + delim;
  595. end;
  596. function ParamFindSwitch(const Switch : string) : Boolean;
  597. begin
  598. Result := FindCmdLineSwitch(Switch,['-', '/'],True);
  599. end;
  600. function ParamGetSwitch(const Switch : string; var cvalue : string) : Boolean;
  601. begin
  602. Result := FindCmdLineSwitch(Switch,cvalue,True,[clstValueAppended]);
  603. end;
  604. function GetAppVersionStr: string;
  605. var
  606. Rec: LongRec;
  607. ver : Cardinal;
  608. begin
  609. ver := GetFileVersion(ParamStr(0));
  610. if ver <> Cardinal(-1) then
  611. begin
  612. Rec := LongRec(ver);
  613. Result := Format('%d.%d', [Rec.Hi, Rec.Lo]);
  614. end
  615. else Result := '';
  616. end;
  617. function GetAppVersionFullStr: string;
  618. var
  619. Exe: string;
  620. Size, Handle: DWORD;
  621. Buffer: TBytes;
  622. FixedPtr: PVSFixedFileInfo;
  623. begin
  624. Result := '';
  625. Exe := ParamStr(0);
  626. Size := GetFileVersionInfoSize(PChar(Exe), Handle);
  627. if Size = 0 then
  628. begin
  629. //RaiseLastOSError;
  630. //no version info in file
  631. Exit;
  632. end;
  633. SetLength(Buffer, Size);
  634. if not GetFileVersionInfo(PChar(Exe), Handle, Size, Buffer) then
  635. RaiseLastOSError;
  636. if not VerQueryValue(Buffer, '\', Pointer(FixedPtr), Size) then
  637. RaiseLastOSError;
  638. if (LongRec(FixedPtr.dwFileVersionLS).Hi = 0) and (LongRec(FixedPtr.dwFileVersionLS).Lo = 0) then
  639. begin
  640. Result := Format('%d.%d',
  641. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  642. LongRec(FixedPtr.dwFileVersionMS).Lo]); //minor
  643. end
  644. else if (LongRec(FixedPtr.dwFileVersionLS).Lo = 0) then
  645. begin
  646. Result := Format('%d.%d.%d',
  647. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  648. LongRec(FixedPtr.dwFileVersionMS).Lo, //minor
  649. LongRec(FixedPtr.dwFileVersionLS).Hi]); //release
  650. end
  651. else
  652. begin
  653. Result := Format('%d.%d.%d.%d',
  654. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  655. LongRec(FixedPtr.dwFileVersionMS).Lo, //minor
  656. LongRec(FixedPtr.dwFileVersionLS).Hi, //release
  657. LongRec(FixedPtr.dwFileVersionLS).Lo]); //build
  658. end;
  659. end;
  660. function UTCToLocalTime(GMTTime: TDateTime): TDateTime;
  661. begin
  662. Result := TTimeZone.Local.ToLocalTime(GMTTime);
  663. end;
  664. function LocalTimeToUTC(LocalTime : TDateTime): TDateTime;
  665. begin
  666. Result := TTimeZone.Local.ToUniversalTime(LocalTime);
  667. end;
  668. function CountDigits(anInt: Cardinal): Cardinal; inline;
  669. var
  670. cmp: Cardinal;
  671. begin
  672. cmp := 10;
  673. Result := 1;
  674. while (Result < 10) and (cmp <= anInt) do
  675. begin
  676. cmp := cmp*10;
  677. Inc(Result);
  678. end;
  679. end;
  680. procedure SaveStreamToFile(stream : TStream; const filename : string);
  681. var
  682. fs : TFileStream;
  683. begin
  684. fs := TFileStream.Create(filename,fmCreate);
  685. try
  686. stream.Seek(0,soBeginning);
  687. fs.CopyFrom(stream,stream.Size);
  688. finally
  689. fs.Free;
  690. end;
  691. end;
  692. { TCounter }
  693. procedure TCounter.Init(aMaxValue : Integer);
  694. begin
  695. fMaxValue := aMaxValue;
  696. fCurrentValue := 0;
  697. end;
  698. function TCounter.Count : Integer;
  699. begin
  700. Result := fCurrentValue;
  701. end;
  702. function TCounter.CountIs(aValue : Integer) : Boolean;
  703. begin
  704. Result := fCurrentValue = aValue;
  705. end;
  706. function TCounter.Check : Boolean;
  707. begin
  708. if fCurrentValue = fMaxValue then
  709. begin
  710. Result := True;
  711. Reset;
  712. end
  713. else
  714. begin
  715. Result := False;
  716. Inc(fCurrentValue);
  717. end;
  718. end;
  719. procedure TCounter.Reset;
  720. begin
  721. fCurrentValue := fMaxValue;
  722. end;
  723. { TimeCounter }
  724. procedure TTimeCounter.Init(MillisecondsToReach : Integer);
  725. begin
  726. fDoneEvery := MillisecondsToReach;
  727. end;
  728. function TTimeCounter.Check : Boolean;
  729. begin
  730. if MilliSecondsBetween(fCurrentTime,Now) > fDoneEvery then
  731. begin
  732. fCurrentTime := Now();
  733. Result := True;
  734. end
  735. else Result := False;
  736. end;
  737. procedure TTimeCounter.Reset;
  738. begin
  739. fCurrentTime := Now();
  740. end;
  741. procedure ProcessMessages;
  742. var
  743. Msg: TMsg;
  744. begin
  745. while integer(PeekMessage(Msg, 0, 0, 0, PM_REMOVE)) <> 0 do
  746. begin
  747. TranslateMessage(Msg);
  748. DispatchMessage(Msg);
  749. end;
  750. end;
  751. initialization
  752. try
  753. GetEnvironmentPaths;
  754. except
  755. on E : Exception do
  756. begin
  757. if not IsService then
  758. begin
  759. if IsConsole then Writeln(Format('[WARN] GetEnvironmentPaths: %s',[E.Message]))
  760. else raise EEnvironmentPath.Create(Format('Get environment path error: %s',[E.Message]));
  761. end;
  762. end;
  763. end;
  764. end.