Quick.Commons.pas 28 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087
  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. Result := 'N/A';
  604. //raise ENotImplemented.Create('Not Android GetLoggedUserName implemented!');
  605. end;
  606. {$ENDIF}
  607. {$ENDIF}
  608. function GetComputerName : string;
  609. {$IFDEF MSWINDOWS}
  610. var
  611. dwLength: dword;
  612. begin
  613. dwLength := 253;
  614. SetLength(Result, dwLength+1);
  615. if not Windows.GetComputerName(pchar(result), dwLength) then Result := 'Not detected!';
  616. Result := pchar(result);
  617. end;
  618. {$ELSE}
  619. {$IF DEFINED(FPC) AND DEFINED(LINUX)}
  620. begin
  621. Result := GetEnvironmentVariable('COMPUTERNAME');
  622. end;
  623. {$ELSE} //Android gets model name
  624. begin
  625. Result := JStringToString(TJBuild.JavaClass.MODEL);
  626. end;
  627. {$ENDIF}
  628. {$ENDIF}
  629. function NormalizePathDelim(const cPath : string; const Delim : Char) : string;
  630. begin
  631. if Delim = '\' then Result := StringReplace(cPath,'/',Delim,[rfReplaceAll])
  632. else Result := StringReplace(cPath,'\',Delim,[rfReplaceAll]);
  633. end;
  634. function RemoveLastPathSegment(cDir : string) : string;
  635. var
  636. posi : Integer;
  637. delim : Char;
  638. EndsWithDelim : Boolean;
  639. begin
  640. if cDir.Contains('\') then delim := '\'
  641. else if cDir.Contains('/') then delim := '/'
  642. else
  643. begin
  644. Result := '';
  645. Exit;
  646. end;
  647. NormalizePathDelim(cDir,delim);
  648. if cDir.EndsWith(delim) then
  649. begin
  650. cDir := Copy(cDir,1,cDir.Length-1);
  651. EndsWithDelim := True;
  652. end
  653. else EndsWithDelim := False;
  654. if cDir.CountChar(delim) > 1 then posi := cDir.LastDelimiter(delim)
  655. else posi := Pos(delim,cDir)-1;
  656. if posi = cDir.Length then posi := 0;
  657. Result := Copy(cDir,1,posi);
  658. if (Result <> '') and (EndsWithDelim) then Result := Result + delim;
  659. end;
  660. function ParamFindSwitch(const Switch : string) : Boolean;
  661. begin
  662. Result := FindCmdLineSwitch(Switch,['-', '/'],True);
  663. end;
  664. {$IFDEF FPC}
  665. function FindCmdLineSwitch(const Switch: string; var Value: string; IgnoreCase: Boolean = True;
  666. const SwitchTypes: TCmdLineSwitchTypes = [clstValueNextParam, clstValueAppended]): Boolean; overload;
  667. type
  668. TCompareProc = function(const S1, S2: string): Boolean;
  669. var
  670. Param: string;
  671. I, ValueOfs,
  672. SwitchLen, ParamLen: Integer;
  673. SameSwitch: TCompareProc;
  674. begin
  675. Result := False;
  676. Value := '';
  677. if IgnoreCase then
  678. SameSwitch := SameText else
  679. SameSwitch := SameStr;
  680. SwitchLen := Switch.Length;
  681. for I := 1 to ParamCount do
  682. begin
  683. Param := ParamStr(I);
  684. if CharInSet(Param.Chars[0], SwitchChars) and SameSwitch(Param.SubString(1,SwitchLen), Switch) then
  685. begin
  686. ParamLen := Param.Length;
  687. // Look for an appended value if the param is longer than the switch
  688. if (ParamLen > SwitchLen + 1) then
  689. begin
  690. // If not looking for appended value switches then this is not a matching switch
  691. if not (clstValueAppended in SwitchTypes) then
  692. Continue;
  693. ValueOfs := SwitchLen + 1;
  694. if Param.Chars[ValueOfs] = ':' then
  695. Inc(ValueOfs);
  696. Value := Param.SubString(ValueOfs, MaxInt);
  697. end
  698. // If the next param is not a switch, then treat it as the value
  699. else if (clstValueNextParam in SwitchTypes) and (I < ParamCount) and
  700. not CharInSet(ParamStr(I+1).Chars[0], SwitchChars) then
  701. Value := ParamStr(I+1);
  702. Result := True;
  703. Break;
  704. end;
  705. end;
  706. end;
  707. {$ENDIF}
  708. function ParamGetSwitch(const Switch : string; var cvalue : string) : Boolean;
  709. begin
  710. Result := FindCmdLineSwitch(Switch,cvalue,True,[clstValueAppended]);
  711. end;
  712. function GetAppName : string;
  713. begin
  714. Result := ExtractFilenameWithoutExt(ParamStr(0));
  715. end;
  716. function GetAppVersionStr: string;
  717. {$IFDEF MSWINDOWS}
  718. var
  719. Rec: LongRec;
  720. ver : Cardinal;
  721. begin
  722. ver := GetFileVersion(ParamStr(0));
  723. if ver <> Cardinal(-1) then
  724. begin
  725. Rec := LongRec(ver);
  726. Result := Format('%d.%d', [Rec.Hi, Rec.Lo]);
  727. end
  728. else Result := '';
  729. end;
  730. {$ELSE}
  731. {$IF DEFINED(FPC) AND DEFINED(LINUX)}
  732. var
  733. version : TProgramVersion;
  734. begin
  735. if GetProgramVersion(version) then Result := Format('%d.%d', [version.Major, version.Minor])
  736. else Result := '';
  737. end;
  738. {$ELSE}
  739. var
  740. PkgInfo : JPackageInfo;
  741. begin
  742. PkgInfo := SharedActivity.getPackageManager.getPackageInfo(SharedActivity.getPackageName,0);
  743. Result := IntToStr(PkgInfo.VersionCode);
  744. end;
  745. {$ENDIF}
  746. {$ENDIF}
  747. function GetAppVersionFullStr: string;
  748. {$IFDEF MSWINDOWS}
  749. var
  750. Exe: string;
  751. Size, Handle: DWORD;
  752. Buffer: TBytes;
  753. FixedPtr: PVSFixedFileInfo;
  754. begin
  755. Result := '';
  756. Exe := ParamStr(0);
  757. Size := GetFileVersionInfoSize(PChar(Exe), Handle);
  758. if Size = 0 then
  759. begin
  760. //RaiseLastOSError;
  761. //no version info in file
  762. Exit;
  763. end;
  764. SetLength(Buffer, Size);
  765. if not GetFileVersionInfo(PChar(Exe), Handle, Size, Buffer) then
  766. RaiseLastOSError;
  767. if not VerQueryValue(Buffer, '\', Pointer(FixedPtr), Size) then
  768. RaiseLastOSError;
  769. if (LongRec(FixedPtr.dwFileVersionLS).Hi = 0) and (LongRec(FixedPtr.dwFileVersionLS).Lo = 0) then
  770. begin
  771. Result := Format('%d.%d',
  772. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  773. LongRec(FixedPtr.dwFileVersionMS).Lo]); //minor
  774. end
  775. else if (LongRec(FixedPtr.dwFileVersionLS).Lo = 0) then
  776. begin
  777. Result := Format('%d.%d.%d',
  778. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  779. LongRec(FixedPtr.dwFileVersionMS).Lo, //minor
  780. LongRec(FixedPtr.dwFileVersionLS).Hi]); //release
  781. end
  782. else
  783. begin
  784. Result := Format('%d.%d.%d.%d',
  785. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  786. LongRec(FixedPtr.dwFileVersionMS).Lo, //minor
  787. LongRec(FixedPtr.dwFileVersionLS).Hi, //release
  788. LongRec(FixedPtr.dwFileVersionLS).Lo]); //build
  789. end;
  790. end;
  791. {$ELSE}
  792. {$IF DEFINED(FPC) AND DEFINED(LINUX)}
  793. var
  794. version : TProgramVersion;
  795. begin
  796. if GetProgramVersion(version) then Result := Format('%d.%d.%d.%d', [version.Major, version.Minor, version.Revision, version.Build])
  797. else Result := '';
  798. end;
  799. {$ELSE}
  800. var
  801. PkgInfo : JPackageInfo;
  802. begin
  803. PkgInfo := SharedActivity.getPackageManager.getPackageInfo(SharedActivity.getPackageName,0);
  804. Result := JStringToString(PkgInfo.versionName);
  805. end;
  806. {$ENDIF}
  807. {$ENDIF}
  808. function UTCToLocalTime(GMTTime: TDateTime): TDateTime;
  809. begin
  810. {$IFDEF FPC}
  811. Result := LocalTimeToUniversal(GMTTime);
  812. {$ELSE}
  813. Result := TTimeZone.Local.ToLocalTime(GMTTime);
  814. {$ENDIF}
  815. end;
  816. function LocalTimeToUTC(LocalTime : TDateTime): TDateTime;
  817. begin
  818. {$IFDEF FPC}
  819. Result := UniversalTimeToLocal(Localtime);
  820. {$ELSE}
  821. Result := TTimeZone.Local.ToUniversalTime(LocalTime);
  822. {$ENDIF}
  823. end;
  824. function DateTimeToGMT(aDate : TDateTime) : string;
  825. var
  826. FmtSettings : TFormatSettings;
  827. begin
  828. FmtSettings.DateSeparator := '-';
  829. FmtSettings.TimeSeparator := ':';
  830. FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ" GMT"';
  831. Result := DateTimeToStr(aDate,FmtSettings);
  832. end;
  833. function GMTToDateTime(aDate : string) : TDateTime;
  834. var
  835. FmtSettings : TFormatSettings;
  836. begin
  837. FmtSettings.DateSeparator := '-';
  838. FmtSettings.TimeSeparator := ':';
  839. FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ" GMT"';
  840. Result := StrToDateTime(aDate,FmtSettings);
  841. end;
  842. function DateTimeToJsonDate(aDateTime : TDateTime) : string;
  843. {$IFNDEF DELPHIXE7_UP}
  844. var
  845. FmtSettings : TFormatSettings;
  846. {$ENDIF}
  847. begin
  848. {$IFDEF DELPHIXE7_UP}
  849. Result := DateToISO8601(aDateTime);
  850. {$ELSE}
  851. FmtSettings.DateSeparator := '-';
  852. FmtSettings.TimeSeparator := ':';
  853. FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ"Z"';
  854. Result := DateTimeToStr(aDateTime,FmtSettings);
  855. {$ENDIF}
  856. end;
  857. function JsonDateToDateTime(const aJsonDate : string) : TDateTime;
  858. {$IFNDEF DELPHIXE7_UP}
  859. var
  860. FmtSettings : TFormatSettings;
  861. {$ENDIF}
  862. {$IFDEF FPC}
  863. var
  864. jdate : string;
  865. {$ENDIF}
  866. begin
  867. {$IFDEF DELPHIXE7_UP}
  868. Result := ISO8601ToDate(aJsonDate);
  869. {$ELSE}
  870. FmtSettings.DateSeparator := '-';
  871. FmtSettings.TimeSeparator := ':';
  872. FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ"Z"';
  873. {$IFDEF FPC}
  874. jdate := StringReplace(aJsondate,'T',' ',[rfIgnoreCase]);
  875. jdate := Copy(jdate,1,Pos('.',jdate)-1);
  876. Result := StrToDateTime(jdate,FmtSettings);
  877. {$ELSE}
  878. Result := StrToDateTime(aJsonDate,FmtSettings);
  879. {$ENDIF}
  880. {$ENDIF}
  881. end;
  882. function CountDigits(anInt: Cardinal): Cardinal; inline;
  883. var
  884. cmp: Cardinal;
  885. begin
  886. cmp := 10;
  887. Result := 1;
  888. while (Result < 10) and (cmp <= anInt) do
  889. begin
  890. cmp := cmp*10;
  891. Inc(Result);
  892. end;
  893. end;
  894. procedure SaveStreamToFile(stream : TStream; const filename : string);
  895. var
  896. fs : TFileStream;
  897. begin
  898. fs := TFileStream.Create(filename,fmCreate);
  899. try
  900. stream.Seek(0,soBeginning);
  901. fs.CopyFrom(stream,stream.Size);
  902. finally
  903. fs.Free;
  904. end;
  905. end;
  906. { TCounter }
  907. procedure TCounter.Init(aMaxValue : Integer);
  908. begin
  909. fMaxValue := aMaxValue;
  910. fCurrentValue := 0;
  911. end;
  912. function TCounter.Count : Integer;
  913. begin
  914. Result := fCurrentValue;
  915. end;
  916. function TCounter.CountIs(aValue : Integer) : Boolean;
  917. begin
  918. Result := fCurrentValue = aValue;
  919. end;
  920. function TCounter.Check : Boolean;
  921. begin
  922. if fCurrentValue = fMaxValue then
  923. begin
  924. Result := True;
  925. Reset;
  926. end
  927. else
  928. begin
  929. Result := False;
  930. Inc(fCurrentValue);
  931. end;
  932. end;
  933. procedure TCounter.Reset;
  934. begin
  935. fCurrentValue := fMaxValue;
  936. end;
  937. { TimeCounter }
  938. procedure TTimeCounter.Init(MillisecondsToReach : Integer);
  939. begin
  940. fDoneEvery := MillisecondsToReach;
  941. end;
  942. function TTimeCounter.Check : Boolean;
  943. begin
  944. if MilliSecondsBetween(fCurrentTime,Now) > fDoneEvery then
  945. begin
  946. fCurrentTime := Now();
  947. Result := True;
  948. end
  949. else Result := False;
  950. end;
  951. procedure TTimeCounter.Reset;
  952. begin
  953. fCurrentTime := Now();
  954. end;
  955. {$IFDEF MSWINDOWS}
  956. procedure ProcessMessages;
  957. var
  958. Msg: TMsg;
  959. begin
  960. while integer(PeekMessage(Msg, 0, 0, 0, PM_REMOVE)) <> 0 do
  961. begin
  962. TranslateMessage(Msg);
  963. DispatchMessage(Msg);
  964. end;
  965. end;
  966. function GetLastOSError: String;
  967. begin
  968. Result := SysErrorMessage(Windows.GetLastError);
  969. end;
  970. {$ENDIF}
  971. {$IFDEF MSWINDOWS}
  972. initialization
  973. try
  974. GetEnvironmentPaths;
  975. except
  976. on E : Exception do
  977. begin
  978. if not IsService then
  979. begin
  980. if IsConsole then Writeln(Format('[WARN] GetEnvironmentPaths: %s',[E.Message]))
  981. else raise EEnvironmentPath.Create(Format('Get environment path error: %s',[E.Message]));
  982. end;
  983. end;
  984. end;
  985. {$ENDIF}
  986. end.