Quick.Commons.pas 28 KB

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