Quick.Commons.pas 27 KB

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