Quick.Commons.pas 24 KB

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