Quick.Commons.pas 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861
  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. //Test: Result := MinutesBetween(cBefore,cNow) < 1;
  445. Result := DateTimeInRange(cNow,StartOfTheDay(cBefore),EndOfTheDay(cBefore),True);
  446. end;
  447. function FillStr(const C : Char; const Count : Byte) : string;
  448. var
  449. i : Byte;
  450. begin
  451. Result := '';
  452. for i := 1 to Count do Result := Result + C;
  453. end;
  454. function Zeroes(const Number, Len : Int64) : string;
  455. begin
  456. if Len > Length(IntToStr(Number)) then Result := FillStr('0',Len - Length(IntToStr(Number))) + IntToStr(Number)
  457. else Result := IntToStr(Number);
  458. end;
  459. function NumberToStr(const Number : Int64) : string;
  460. begin
  461. try
  462. Result := FormatFloat('0,',Number);
  463. except
  464. Result := '#Error';
  465. end;
  466. end;
  467. function Spaces(const Count : Integer) : string;
  468. begin
  469. Result := FillStr(' ',Count);
  470. end;
  471. function NowStr : string;
  472. begin
  473. Result := DateTimeToStr(Now());
  474. end;
  475. function NewGuidStr : string;
  476. var
  477. guid : TGUID;
  478. begin
  479. guid.NewGuid;
  480. Result := guid.ToString
  481. //GUIDToString(guid);
  482. end;
  483. function IsLike(cText, Pattern: string) : Boolean;
  484. var
  485. i, n : Integer;
  486. match : Boolean;
  487. wildcard : Boolean;
  488. CurrentPattern : Char;
  489. aux : string;
  490. begin
  491. Result := False;
  492. wildcard := False;
  493. cText := LowerCase(cText);
  494. Pattern := LowerCase(Pattern);
  495. match := False;
  496. if (Pattern.Length > cText.Length) or (Pattern = '') then Exit;
  497. if Pattern = '*' then
  498. begin
  499. Result := True;
  500. Exit;
  501. end;
  502. for i := 1 to cText.Length do
  503. begin
  504. CurrentPattern := Pattern[i];
  505. if CurrentPattern = '*' then wildcard := True;
  506. if wildcard then
  507. begin
  508. aux := Copy(Pattern,i+1,Pattern.Length);
  509. n := Pos(Copy(Pattern,i+1,Pattern.Length),cText);
  510. if (n > i) or (Pattern.Length = i) then
  511. begin
  512. Result := True;
  513. Exit;
  514. end;
  515. end
  516. else
  517. begin
  518. if (cText[i] = CurrentPattern) or (CurrentPattern = '?') then match := True
  519. else match := False;
  520. end;
  521. end;
  522. Result := match;
  523. end;
  524. function Capitalize(s: string): string;
  525. begin
  526. Result := '';
  527. if s.Length = 0 then Exit;
  528. s := LowerCase(s,loUserLocale);
  529. Result := UpperCase(s[1],loUserLocale) + Trim(Copy(s, 2, s.Length));
  530. end;
  531. function CapitalizeWords(s: string): string;
  532. var
  533. cword : string;
  534. begin
  535. Result := '';
  536. if s.Length = 0 then Exit;
  537. s := LowerCase(s,loUserLocale);
  538. for cword in s.Split([' ']) do
  539. begin
  540. if Result = '' then Result := Capitalize(cword)
  541. else Result := Result + ' ' + Capitalize(cword);
  542. end;
  543. end;
  544. function GetLoggedUserName : string;
  545. const
  546. cnMaxUserNameLen = 254;
  547. var
  548. sUserName : string;
  549. dwUserNameLen : DWord;
  550. begin
  551. dwUserNameLen := cnMaxUserNameLen-1;
  552. SetLength( sUserName, cnMaxUserNameLen );
  553. GetUserName(PChar( sUserName ),dwUserNameLen );
  554. SetLength( sUserName, dwUserNameLen );
  555. Result := sUserName;
  556. end;
  557. function GetComputerName : string;
  558. var
  559. dwLength: dword;
  560. begin
  561. dwLength := 253;
  562. SetLength(Result, dwLength+1);
  563. if not Windows.GetComputerName(pchar(result), dwLength) then Result := 'Not detected!';
  564. Result := pchar(result);
  565. end;
  566. function NormalizePathDelim(const cPath : string; const Delim : Char) : string;
  567. begin
  568. if Delim = '\' then Result := StringReplace(cPath,'/',Delim,[rfReplaceAll])
  569. else Result := StringReplace(cPath,'\',Delim,[rfReplaceAll]);
  570. end;
  571. function RemoveLastPathSegment(cDir : string) : string;
  572. var
  573. posi : Integer;
  574. delim : Char;
  575. EndsWithDelim : Boolean;
  576. begin
  577. if cDir.Contains('\') then delim := '\'
  578. else if cDir.Contains('/') then delim := '/'
  579. else
  580. begin
  581. Result := '';
  582. Exit;
  583. end;
  584. NormalizePathDelim(cDir,delim);
  585. if cDir.EndsWith(delim) then
  586. begin
  587. cDir := Copy(cDir,1,cDir.Length-1);
  588. EndsWithDelim := True;
  589. end
  590. else EndsWithDelim := False;
  591. if cDir.CountChar(delim) > 1 then posi := cDir.LastDelimiter(delim)
  592. else posi := Pos(delim,cDir)-1;
  593. if posi = cDir.Length then posi := 0;
  594. Result := Copy(cDir,1,posi);
  595. if (Result <> '') and (EndsWithDelim) then Result := Result + delim;
  596. end;
  597. function ParamFindSwitch(const Switch : string) : Boolean;
  598. begin
  599. Result := FindCmdLineSwitch(Switch,['-', '/'],True);
  600. end;
  601. function ParamGetSwitch(const Switch : string; var cvalue : string) : Boolean;
  602. begin
  603. Result := FindCmdLineSwitch(Switch,cvalue,True,[clstValueAppended]);
  604. end;
  605. function GetAppVersionStr: string;
  606. var
  607. Rec: LongRec;
  608. ver : Cardinal;
  609. begin
  610. ver := GetFileVersion(ParamStr(0));
  611. if ver <> Cardinal(-1) then
  612. begin
  613. Rec := LongRec(ver);
  614. Result := Format('%d.%d', [Rec.Hi, Rec.Lo]);
  615. end
  616. else Result := '';
  617. end;
  618. function GetAppVersionFullStr: string;
  619. var
  620. Exe: string;
  621. Size, Handle: DWORD;
  622. Buffer: TBytes;
  623. FixedPtr: PVSFixedFileInfo;
  624. begin
  625. Result := '';
  626. Exe := ParamStr(0);
  627. Size := GetFileVersionInfoSize(PChar(Exe), Handle);
  628. if Size = 0 then
  629. begin
  630. //RaiseLastOSError;
  631. //no version info in file
  632. Exit;
  633. end;
  634. SetLength(Buffer, Size);
  635. if not GetFileVersionInfo(PChar(Exe), Handle, Size, Buffer) then
  636. RaiseLastOSError;
  637. if not VerQueryValue(Buffer, '\', Pointer(FixedPtr), Size) then
  638. RaiseLastOSError;
  639. if (LongRec(FixedPtr.dwFileVersionLS).Hi = 0) and (LongRec(FixedPtr.dwFileVersionLS).Lo = 0) then
  640. begin
  641. Result := Format('%d.%d',
  642. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  643. LongRec(FixedPtr.dwFileVersionMS).Lo]); //minor
  644. end
  645. else if (LongRec(FixedPtr.dwFileVersionLS).Lo = 0) then
  646. begin
  647. Result := Format('%d.%d.%d',
  648. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  649. LongRec(FixedPtr.dwFileVersionMS).Lo, //minor
  650. LongRec(FixedPtr.dwFileVersionLS).Hi]); //release
  651. end
  652. else
  653. begin
  654. Result := Format('%d.%d.%d.%d',
  655. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  656. LongRec(FixedPtr.dwFileVersionMS).Lo, //minor
  657. LongRec(FixedPtr.dwFileVersionLS).Hi, //release
  658. LongRec(FixedPtr.dwFileVersionLS).Lo]); //build
  659. end;
  660. end;
  661. function UTCToLocalTime(GMTTime: TDateTime): TDateTime;
  662. begin
  663. Result := TTimeZone.Local.ToLocalTime(GMTTime);
  664. end;
  665. function LocalTimeToUTC(LocalTime : TDateTime): TDateTime;
  666. begin
  667. Result := TTimeZone.Local.ToUniversalTime(LocalTime);
  668. end;
  669. function CountDigits(anInt: Cardinal): Cardinal; inline;
  670. var
  671. cmp: Cardinal;
  672. begin
  673. cmp := 10;
  674. Result := 1;
  675. while (Result < 10) and (cmp <= anInt) do
  676. begin
  677. cmp := cmp*10;
  678. Inc(Result);
  679. end;
  680. end;
  681. procedure SaveStreamToFile(stream : TStream; const filename : string);
  682. var
  683. fs : TFileStream;
  684. begin
  685. fs := TFileStream.Create(filename,fmCreate);
  686. try
  687. stream.Seek(0,soBeginning);
  688. fs.CopyFrom(stream,stream.Size);
  689. finally
  690. fs.Free;
  691. end;
  692. end;
  693. { TCounter }
  694. procedure TCounter.Init(aMaxValue : Integer);
  695. begin
  696. fMaxValue := aMaxValue;
  697. fCurrentValue := 0;
  698. end;
  699. function TCounter.Count : Integer;
  700. begin
  701. Result := fCurrentValue;
  702. end;
  703. function TCounter.CountIs(aValue : Integer) : Boolean;
  704. begin
  705. Result := fCurrentValue = aValue;
  706. end;
  707. function TCounter.Check : Boolean;
  708. begin
  709. if fCurrentValue = fMaxValue then
  710. begin
  711. Result := True;
  712. Reset;
  713. end
  714. else
  715. begin
  716. Result := False;
  717. Inc(fCurrentValue);
  718. end;
  719. end;
  720. procedure TCounter.Reset;
  721. begin
  722. fCurrentValue := fMaxValue;
  723. end;
  724. { TimeCounter }
  725. procedure TTimeCounter.Init(MillisecondsToReach : Integer);
  726. begin
  727. fDoneEvery := MillisecondsToReach;
  728. end;
  729. function TTimeCounter.Check : Boolean;
  730. begin
  731. if MilliSecondsBetween(fCurrentTime,Now) > fDoneEvery then
  732. begin
  733. fCurrentTime := Now();
  734. Result := True;
  735. end
  736. else Result := False;
  737. end;
  738. procedure TTimeCounter.Reset;
  739. begin
  740. fCurrentTime := Now();
  741. end;
  742. procedure ProcessMessages;
  743. var
  744. Msg: TMsg;
  745. begin
  746. while integer(PeekMessage(Msg, 0, 0, 0, PM_REMOVE)) <> 0 do
  747. begin
  748. TranslateMessage(Msg);
  749. DispatchMessage(Msg);
  750. end;
  751. end;
  752. initialization
  753. try
  754. GetEnvironmentPaths;
  755. except
  756. on E : Exception do
  757. begin
  758. if not IsService then
  759. begin
  760. if IsConsole then Writeln(Format('[WARN] GetEnvironmentPaths: %s',[E.Message]))
  761. else raise EEnvironmentPath.Create(Format('Get environment path error: %s',[E.Message]));
  762. end;
  763. end;
  764. end;
  765. end.