Quick.Commons.pas 37 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427
  1. { ***************************************************************************
  2. Copyright (c) 2016-2019 Kike Pérez
  3. Unit : Quick.Commons
  4. Description : Common functions
  5. Author : Kike Pérez
  6. Version : 1.8
  7. Created : 14/07/2017
  8. Modified : 01/07/2019
  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. {$ENDIF MSWINDOWS}
  32. {$IFDEF FPC}
  33. Quick.Files,
  34. {$IFDEF LINUX}
  35. FileInfo,
  36. {$ENDIF}
  37. {$ELSE}
  38. IOUtils,
  39. {$ENDIF}
  40. {$IFDEF ANDROID}
  41. Androidapi.JNI.Os,
  42. Androidapi.Helpers,
  43. Androidapi.JNI.JavaTypes,
  44. Androidapi.JNI.GraphicsContentViewText,
  45. {$ENDIF}
  46. {$IFDEF IOS}
  47. iOSapi.UIKit,
  48. Posix.SysSysctl,
  49. Posix.StdDef,
  50. iOSapi.Foundation,
  51. Macapi.ObjectiveC,
  52. Macapi.Helpers,
  53. {$ENDIF}
  54. {$IFDEF OSX}
  55. Macapi.Foundation,
  56. Macapi.Helpers,
  57. FMX.Helpers.Mac,
  58. Macapi.ObjectiveC,
  59. {$ENDIF}
  60. {$IFDEF POSIX}
  61. Posix.Unistd,
  62. {$ENDIF}
  63. DateUtils;
  64. type
  65. TLogEventType = (etInfo, etSuccess, etWarning, etError, etDebug, etTrace);
  66. TLogVerbose = set of TLogEventType;
  67. const
  68. LOG_ONLYERRORS = [etInfo,etError];
  69. LOG_ERRORSANDWARNINGS = [etInfo,etWarning,etError];
  70. LOG_TRACE = [etInfo,etError,etWarning,etTrace];
  71. LOG_ALL = [etInfo,etSuccess,etWarning,etError,etTrace];
  72. LOG_DEBUG = [etInfo,etSuccess,etWarning,etError,etDebug];
  73. {$IFDEF DELPHIXE7_UP}
  74. EventStr : array of string = ['INFO','SUCC','WARN','ERROR','DEBUG','TRACE'];
  75. {$ELSE}
  76. EventStr : array[0..5] of string = ('INFO','SUCC','WARN','ERROR','DEBUG','TRACE');
  77. {$ENDIF}
  78. type
  79. TPasswordComplexity = set of (pfIncludeNumbers,pfIncludeSigns);
  80. {$IFDEF MSWINDOWS}
  81. TEnvironmentPath = record
  82. EXEPATH : string;
  83. WINDOWS : string;
  84. SYSTEM : string;
  85. PROGRAMFILES : string;
  86. COMMONFILES : string;
  87. HOMEDRIVE : string;
  88. TEMP : string;
  89. USERPROFILE : string;
  90. INSTDRIVE : string;
  91. DESKTOP : string;
  92. STARTMENU : string;
  93. DESKTOP_ALLUSERS : string;
  94. STARTMENU_ALLUSERS : string;
  95. STARTUP : string;
  96. APPDATA : String;
  97. PROGRAMDATA : string;
  98. ALLUSERSPROFILE : string;
  99. end;
  100. {$ENDIF MSWINDOWS}
  101. {$IFNDEF FPC}
  102. TFileHelper = record helper for TFile
  103. {$IF DEFINED(MSWINDOWS) OR DEFINED(DELPHILINUX)}
  104. class function IsInUse(const FileName : string) : Boolean; static;
  105. {$ENDIF}
  106. class function GetSize(const FileName: String): Int64; static;
  107. end;
  108. TDirectoryHelper = record helper for TDirectory
  109. class function GetSize(const Path: String): Int64; static;
  110. end;
  111. {$ENDIF}
  112. {$IFDEF FPC}
  113. {$IFDEF LINUX}
  114. UINT = cardinal;
  115. {$ENDIF}
  116. PLASTINPUTINFO = ^LASTINPUTINFO;
  117. tagLASTINPUTINFO = record
  118. cbSize: UINT;
  119. dwTime: DWORD;
  120. end;
  121. LASTINPUTINFO = tagLASTINPUTINFO;
  122. TLastInputInfo = LASTINPUTINFO;
  123. type
  124. TCmdLineSwitchType = (clstValueNextParam, clstValueAppended);
  125. TCmdLineSwitchTypes = set of TCmdLineSwitchType;
  126. {$ENDIF}
  127. TCounter = record
  128. private
  129. fMaxValue : Integer;
  130. fCurrentValue : Integer;
  131. public
  132. property MaxValue : Integer read fMaxValue;
  133. procedure Init(aMaxValue : Integer);
  134. function Count : Integer;
  135. function CountIs(aValue : Integer) : Boolean;
  136. function Check : Boolean;
  137. procedure Reset;
  138. end;
  139. TTimeCounter = record
  140. private
  141. fCurrentTime : TDateTime;
  142. fDoneEvery : Integer;
  143. public
  144. property DoneEvery : Integer read fDoneEvery;
  145. procedure Init(MillisecondsToReach : Integer);
  146. function Check : Boolean;
  147. procedure Reset;
  148. end;
  149. EEnvironmentPath = class(Exception);
  150. EShellError = class(Exception);
  151. //generates a random password with complexity options
  152. function RandomPassword(const PasswordLength : Integer; Complexity : TPasswordComplexity = [pfIncludeNumbers,pfIncludeSigns]) : string;
  153. //extracts file extension from a filename
  154. function ExtractFileNameWithoutExt(const FileName: string): string;
  155. //converts a Unix path to Windows path
  156. function UnixToWindowsPath(const UnixPath: string): string;
  157. //converts a Windows path to Unix path
  158. function WindowsToUnixPath(const WindowsPath: string): string;
  159. //corrects malformed urls
  160. function CorrectURLPath(cUrl : string) : string;
  161. {$IFDEF MSWINDOWS}
  162. //get typical environment paths as temp, desktop, etc
  163. procedure GetEnvironmentPaths;
  164. function GetSpecialFolderPath(folderID : Integer) : string;
  165. //checks if running on a 64bit OS
  166. function Is64bitOS : Boolean;
  167. //checks if is a console app
  168. function IsConsole : Boolean;
  169. function HasConsoleOutput : Boolean;
  170. //checks if compiled in debug mode
  171. {$ENDIF}
  172. function IsDebug : Boolean;
  173. {$IFDEF MSWINDOWS}
  174. //checks if running as a service
  175. function IsService : Boolean;
  176. //gets number of seconds without user interaction (mouse, keyboard)
  177. function SecondsIdle: DWord;
  178. //frees process memory not needed
  179. procedure FreeUnusedMem;
  180. //changes screen resolution
  181. function SetScreenResolution(Width, Height: integer): Longint;
  182. {$ENDIF MSWINDOWS}
  183. //returns last day of current month
  184. function LastDayCurrentMonth: TDateTime;
  185. {$IFDEF FPC}
  186. function DateTimeInRange(ADateTime: TDateTime; AStartDateTime, AEndDateTime: TDateTime; aInclusive: Boolean = True): Boolean;
  187. {$ENDIF}
  188. //checks if two datetimes are in same day
  189. function IsSameDay(cBefore, cNow : TDateTime) : Boolean;
  190. //change Time of a DateTime
  191. function ChangeTimeOfADay(aDate : TDateTime; aHour, aMinute, aSecond : Word; aMilliSecond : Word = 0) : TDateTime;
  192. //change Date of a DateTime
  193. function ChangeDateOfADay(aDate : TDateTime; aYear, aMonth, aDay : Word) : TDateTime;
  194. //returns n times a char
  195. function FillStr(const C : Char; const Count : Byte) : string;
  196. //checks if string exists in array of string
  197. function StrInArray(const aValue : string; const aInArray : array of string) : Boolean;
  198. //checks if integer exists in array of integer
  199. function IntInArray(const aValue : Integer; const aInArray : array of Integer) : Boolean;
  200. //check if array is empty
  201. function IsEmptyArray(aArray : TArray<string>) : Boolean; overload;
  202. function IsEmptyArray(aArray : TArray<Integer>) : Boolean; overload;
  203. //returns a number leading zero
  204. function Zeroes(const Number, Len : Int64) : string;
  205. //converts a number to thousand delimeter string
  206. function NumberToStr(const Number : Int64) : string;
  207. //returns n spaces
  208. function Spaces(const Count : Integer) : string;
  209. //returns current date as a string
  210. function NowStr : string;
  211. //returns a new GUID as string
  212. function NewGuidStr : string;
  213. //compare a string with a wildcard pattern (? or *)
  214. function IsLike(cText, Pattern: string) : Boolean;
  215. //Upper case for first letter
  216. function Capitalize(s: string): string;
  217. function CapitalizeWords(s: string): string;
  218. //returns current logged user
  219. function GetLoggedUserName : string;
  220. //returns computer name
  221. function GetComputerName : string;
  222. //Changes incorrect delims in path
  223. function NormalizePathDelim(const cPath : string; const Delim : Char) : string;
  224. //Removes last segment of a path
  225. function RemoveLastPathSegment(cDir : string) : string;
  226. //finds swith in commandline params
  227. function ParamFindSwitch(const Switch : string) : Boolean;
  228. //gets value for a switch if exists
  229. function ParamGetSwitch(const Switch : string; var cvalue : string) : Boolean;
  230. //returns app name (filename based)
  231. function GetAppName : string;
  232. //returns app version (major & minor)
  233. function GetAppVersionStr: string;
  234. //returns app version full (major, minor, release & compiled)
  235. function GetAppVersionFullStr: string;
  236. //convert UTC DateTime to Local DateTime
  237. function UTCToLocalTime(GMTTime: TDateTime): TDateTime;
  238. //convert Local DateTime to UTC DateTime
  239. function LocalTimeToUTC(LocalTime : TDateTime): TDateTime;
  240. //convert DateTime to GTM Time string
  241. function DateTimeToGMT(aDate : TDateTime) : string;
  242. //convert GMT Time string to DateTime
  243. function GMTToDateTime(aDate : string) : TDateTime;
  244. //convert DateTime to Json Date format
  245. function DateTimeToJsonDate(aDateTime : TDateTime) : string;
  246. //convert Json Date format to DateTime
  247. function JsonDateToDateTime(const aJsonDate : string) : TDateTime;
  248. //count number of digits of a Integer
  249. function CountDigits(anInt: Cardinal): Cardinal; inline;
  250. //save stream to file
  251. procedure SaveStreamToFile(stream : TStream; const filename : string);
  252. //save stream to string
  253. function StreamToString(stream : TStream) : string;
  254. //returns a real comma separated text from stringlist
  255. function CommaText(aList : TStringList) : string; overload;
  256. //returns a real comma separated text from array of string
  257. function CommaText(aArray : TArray<string>) : string; overload;
  258. {$IFDEF MSWINDOWS}
  259. //process messages on console applications
  260. procedure ProcessMessages;
  261. //get last error message
  262. function GetLastOSError : String;
  263. {$ENDIF}
  264. {$IF DEFINED(FPC) AND DEFINED(MSWINDOWS)}
  265. function GetLastInputInfo(var plii: TLastInputInfo): BOOL;stdcall; external 'user32' name 'GetLastInputInfo';
  266. {$ENDIF}
  267. function RemoveLastChar(const aText : string) : string;
  268. function DateTimeToSQL(aDateTime : TDateTime) : string;
  269. function IsInteger(const aValue : string) : Boolean;
  270. //extract a substring and deletes from source string
  271. function ExtractStr(var vSource : string; aIndex : Integer; aCount : Integer) : string;
  272. //get first string between string delimiters
  273. function GetSubString(const aSource, aFirstDelimiter, aLastDelimiter : string) : string;
  274. //get double quoted or dequoted string
  275. function DbQuotedStr(const str : string): string;
  276. function UnDbQuotedStr(const str: string) : string;
  277. {$IFDEF MSWINDOWS}
  278. var
  279. path : TEnvironmentPath;
  280. {$ENDIF}
  281. implementation
  282. {TFileHelper}
  283. {$IFNDEF FPC}
  284. {$IFDEF MSWINDOWS}
  285. class function TFileHelper.IsInUse(const FileName : string) : Boolean;
  286. var
  287. HFileRes: HFILE;
  288. begin
  289. Result := False;
  290. if not FileExists(FileName) then Exit;
  291. try
  292. HFileRes := CreateFile(PChar(FileName)
  293. ,GENERIC_READ or GENERIC_WRITE
  294. ,0
  295. ,nil
  296. ,OPEN_EXISTING
  297. ,FILE_ATTRIBUTE_NORMAL
  298. ,0);
  299. Result := (HFileRes = INVALID_HANDLE_VALUE);
  300. if not(Result) then begin
  301. CloseHandle(HFileRes);
  302. end;
  303. except
  304. Result := True;
  305. end;
  306. end;
  307. {$ENDIF}
  308. {$IFDEF DELPHILINUX}
  309. class function TFileHelper.IsInUse(const FileName : string) : Boolean;
  310. var
  311. fs : TFileStream;
  312. begin
  313. try
  314. fs := TFileStream.Create(FileName, fmOpenReadWrite, fmShareExclusive);
  315. Result := True;
  316. fs.Free;
  317. except
  318. Result := False;
  319. end;
  320. end;
  321. {$ENDIF}
  322. {$IFDEF MSWINDOWS}
  323. class function TFileHelper.GetSize(const FileName: String): Int64;
  324. var
  325. info: TWin32FileAttributeData;
  326. begin
  327. Result := -1;
  328. if not GetFileAttributesEx(PWideChar(FileName), GetFileExInfoStandard, @info) then Exit;
  329. Result := Int64(info.nFileSizeLow) or Int64(info.nFileSizeHigh shl 32);
  330. end;
  331. {$ELSE}
  332. class function TFileHelper.GetSize(const FileName: String): Int64;
  333. var
  334. sr : TSearchRec;
  335. begin
  336. if FindFirst(fileName, faAnyFile, sr ) = 0 then Result := sr.Size
  337. else Result := -1;
  338. end;
  339. {$ENDIF}
  340. {TDirectoryHelper}
  341. class function TDirectoryHelper.GetSize(const Path: String): Int64;
  342. var
  343. filename : string;
  344. begin
  345. Result := -1;
  346. for filename in TDirectory.GetFiles(Path) do
  347. begin
  348. Result := Result + TFile.GetSize(filename);
  349. end;
  350. end;
  351. {$ENDIF}
  352. {other functions}
  353. function RandomPassword(const PasswordLength : Integer; Complexity : TPasswordComplexity = [pfIncludeNumbers,pfIncludeSigns]) : string;
  354. const
  355. PassAlpha = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
  356. PassSigns = '@!&$';
  357. PassNumbers = '1234567890';
  358. var
  359. MinNumbers,
  360. MinSigns : Integer;
  361. NumNumbers,
  362. NumSigns : Integer;
  363. begin
  364. Result := '';
  365. Randomize;
  366. //fill all alfa
  367. repeat
  368. Result := Result + PassAlpha[Random(Length(PassAlpha))+1];
  369. until (Length(Result) = PasswordLength);
  370. //checks if need include numbers
  371. if pfIncludeNumbers in Complexity then
  372. begin
  373. MinNumbers := Round(PasswordLength / 10 * 2);
  374. NumNumbers := 0;
  375. if MinNumbers = 0 then MinNumbers := 1;
  376. repeat
  377. Result[Random(PasswordLength)+1] := PassNumbers[Random(Length(PassNumbers))+1];
  378. Inc(NumNumbers);
  379. until NumNumbers = MinNumbers;
  380. end;
  381. //checks if need include signs
  382. if pfIncludeNumbers in Complexity then
  383. begin
  384. MinSigns := Round(PasswordLength / 10 * 1);
  385. NumSigns := 0;
  386. if MinSigns = 0 then MinSigns := 1;
  387. repeat
  388. Result[Random(PasswordLength)+1] := PassSigns[Random(Length(PassSigns))+1];
  389. Inc(NumSigns);
  390. until NumSigns = MinSigns;
  391. end;
  392. end;
  393. function ExtractFileNameWithoutExt(const FileName: string): string;
  394. begin
  395. Result := TPath.GetFileNameWithoutExtension(FileName);
  396. end;
  397. function UnixToWindowsPath(const UnixPath: string): string;
  398. begin
  399. Result := StringReplace(UnixPath, '/', '\',[rfReplaceAll, rfIgnoreCase]);
  400. end;
  401. function WindowsToUnixPath(const WindowsPath: string): string;
  402. begin
  403. Result := StringReplace(WindowsPath, '\', '/',[rfReplaceAll, rfIgnoreCase]);
  404. end;
  405. function CorrectURLPath(cUrl : string) : string;
  406. var
  407. nurl : string;
  408. begin
  409. nurl := WindowsToUnixPath(cUrl);
  410. nurl := StringReplace(nurl,'//','/',[rfReplaceAll]);
  411. Result := StringReplace(nurl,' ','%20',[rfReplaceAll]);
  412. //TNetEncoding.Url.Encode()
  413. end;
  414. {$IFDEF MSWINDOWS}
  415. procedure GetEnvironmentPaths;
  416. begin
  417. //gets path
  418. path.EXEPATH := TPath.GetDirectoryName(ParamStr(0));
  419. path.WINDOWS := SysUtils.GetEnvironmentVariable('windir');
  420. path.PROGRAMFILES := SysUtils.GetEnvironmentVariable('ProgramFiles');
  421. path.COMMONFILES := SysUtils.GetEnvironmentVariable('CommonProgramFiles(x86)');
  422. path.HOMEDRIVE := SysUtils.GetEnvironmentVariable('SystemDrive');
  423. path.USERPROFILE := SysUtils.GetEnvironmentVariable('USERPROFILE');
  424. path.PROGRAMDATA := SysUtils.GetEnvironmentVariable('ProgramData');
  425. path.ALLUSERSPROFILE := SysUtils.GetEnvironmentVariable('AllUsersProfile');
  426. path.INSTDRIVE := path.HOMEDRIVE;
  427. path.TEMP := SysUtils.GetEnvironmentVariable('TEMP');
  428. //these paths fail if user is SYSTEM
  429. try
  430. path.SYSTEM := GetSpecialFolderPath(CSIDL_SYSTEM);
  431. path.APPDATA := GetSpecialFolderPath(CSIDL_APPDATA);
  432. path.DESKTOP := GetSpecialFolderPath(CSIDL_DESKTOP);
  433. path.DESKTOP_ALLUSERS := GetSpecialFolderPath(CSIDL_COMMON_DESKTOPDIRECTORY);
  434. path.STARTMENU:=GetSpecialFolderPath(CSIDL_PROGRAMS);
  435. path.STARTMENU_ALLUSERS:=GetSpecialFolderPath(CSIDL_COMMON_PROGRAMS);
  436. path.STARTMENU_ALLUSERS := path.STARTMENU;
  437. path.STARTUP:=GetSpecialFolderPath(CSIDL_STARTUP);
  438. except
  439. //
  440. end;
  441. end;
  442. function GetSpecialFolderPath(folderID : Integer) : string;
  443. var
  444. ppidl: PItemIdList;
  445. begin
  446. SHGetSpecialFolderLocation(0, folderID, ppidl);
  447. SetLength(Result, MAX_PATH);
  448. if not SHGetPathFromIDList(ppidl,{$IFDEF FPC}PAnsiChar(Result){$ELSE}PChar(Result){$ENDIF}) then
  449. begin
  450. raise EShellError.create(Format('GetSpecialFolderPath: Invalid PIPL (%d)',[folderID]));
  451. end;
  452. SetLength(Result, lStrLen({$IFDEF FPC}PAnsiChar(Result){$ELSE}PChar(Result){$ENDIF}));
  453. end;
  454. function Is64bitOS : Boolean;
  455. begin
  456. {$IFDEF WIN64}
  457. Result := True;
  458. {$ELSE}
  459. Result := False;
  460. {$ENDIF WIN64}
  461. end;
  462. function IsConsole: Boolean;
  463. begin
  464. {$IFDEF CONSOLE}
  465. Result := True;
  466. {$ELSE}
  467. Result := False;
  468. {$ENDIF CONSOLE}
  469. end;
  470. {$ENDIF}
  471. function HasConsoleOutput : Boolean;
  472. {$IFDEF MSWINDOWS}
  473. var
  474. stout : THandle;
  475. begin
  476. stout := GetStdHandle(Std_Output_Handle);
  477. Win32Check(stout <> Invalid_Handle_Value);
  478. Result := stout <> 0;
  479. end;
  480. {$ELSE}
  481. begin
  482. Result := IsConsole;
  483. end;
  484. {$ENDIF}
  485. function IsDebug: Boolean;
  486. begin
  487. {$IFDEF DEBUG}
  488. Result := True;
  489. {$ELSE}
  490. Result := False;
  491. {$ENDIF DEBUG}
  492. end;
  493. {$IFDEF MSWINDOWS}
  494. function IsService : Boolean;
  495. begin
  496. //only working with my Quick.AppService unit
  497. try
  498. Result := (IsConsole) and (not HasConsoleOutput);
  499. except
  500. Result := False;
  501. end;
  502. end;
  503. function SecondsIdle: DWord;
  504. var
  505. liInfo: TLastInputInfo;
  506. begin
  507. liInfo.cbSize := SizeOf(TLastInputInfo) ;
  508. GetLastInputInfo(liInfo) ;
  509. Result := (GetTickCount - liInfo.dwTime) DIV 1000;
  510. end;
  511. procedure FreeUnusedMem;
  512. begin
  513. if Win32Platform = VER_PLATFORM_WIN32_NT then SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);
  514. end;
  515. function SetScreenResolution(Width, Height: integer): Longint;
  516. var
  517. DeviceMode: TDeviceMode;
  518. begin
  519. with DeviceMode do
  520. begin
  521. dmSize := SizeOf(TDeviceMode);
  522. dmPelsWidth := Width;
  523. dmPelsHeight := Height;
  524. dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
  525. end;
  526. Result := ChangeDisplaySettings(DeviceMode, CDS_UPDATEREGISTRY);
  527. end;
  528. {$ENDIF MSWINDOWS}
  529. function LastDayCurrentMonth: TDateTime;
  530. begin
  531. Result := EncodeDate(YearOf(Now),MonthOf(Now), DaysInMonth(Now));
  532. end;
  533. {$IFDEF FPC}
  534. function DateTimeInRange(ADateTime: TDateTime; AStartDateTime, AEndDateTime: TDateTime; aInclusive: Boolean = True): Boolean;
  535. begin
  536. if aInclusive then
  537. Result := (AStartDateTime <= ADateTime) and (ADateTime <= AEndDateTime)
  538. else
  539. Result := (AStartDateTime < ADateTime) and (ADateTime < AEndDateTime);
  540. end;
  541. {$ENDIF}
  542. function IsSameDay(cBefore, cNow : TDateTime) : Boolean;
  543. begin
  544. //Test: Result := MinutesBetween(cBefore,cNow) < 1;
  545. Result := DateTimeInRange(cNow,StartOfTheDay(cBefore),EndOfTheDay(cBefore),True);
  546. end;
  547. function ChangeTimeOfADay(aDate : TDateTime; aHour, aMinute, aSecond : Word; aMilliSecond : Word = 0) : TDateTime;
  548. var
  549. y, m, d : Word;
  550. begin
  551. DecodeDate(aDate,y,m,d);
  552. Result := EncodeDateTime(y,m,d,aHour,aMinute,aSecond,aMilliSecond);
  553. end;
  554. function ChangeDateOfADay(aDate : TDateTime; aYear, aMonth, aDay : Word) : TDateTime;
  555. var
  556. h, m, s, ms : Word;
  557. begin
  558. DecodeTime(aDate,h,m,s,ms);
  559. Result := EncodeDateTime(aYear,aMonth,aDay,h,m,s,0);
  560. end;
  561. function FillStr(const C : Char; const Count : Byte) : string;
  562. var
  563. i : Byte;
  564. begin
  565. Result := '';
  566. for i := 1 to Count do Result := Result + C;
  567. end;
  568. function StrInArray(const aValue : string; const aInArray : array of string) : Boolean;
  569. var
  570. s : string;
  571. begin
  572. for s in aInArray do
  573. begin
  574. if s = aValue then Exit(True);
  575. end;
  576. Result := False;
  577. end;
  578. function IntInArray(const aValue : Integer; const aInArray : array of Integer) : Boolean;
  579. var
  580. i : Integer;
  581. begin
  582. for i in aInArray do
  583. begin
  584. if i = aValue then Exit(True);
  585. end;
  586. Result := False;
  587. end;
  588. function IsEmptyArray(aArray : TArray<string>) : Boolean;
  589. begin
  590. Result := Length(aArray) = 0;
  591. end;
  592. function IsEmptyArray(aArray : TArray<Integer>) : Boolean;
  593. begin
  594. Result := Length(aArray) = 0;
  595. end;
  596. function Zeroes(const Number, Len : Int64) : string;
  597. begin
  598. if Len > Length(IntToStr(Number)) then Result := FillStr('0',Len - Length(IntToStr(Number))) + IntToStr(Number)
  599. else Result := IntToStr(Number);
  600. end;
  601. function NumberToStr(const Number : Int64) : string;
  602. begin
  603. try
  604. Result := FormatFloat('0,',Number);
  605. except
  606. Result := '#Error';
  607. end;
  608. end;
  609. function Spaces(const Count : Integer) : string;
  610. begin
  611. Result := FillStr(' ',Count);
  612. end;
  613. function NowStr : string;
  614. begin
  615. Result := DateTimeToStr(Now());
  616. end;
  617. function NewGuidStr : string;
  618. var
  619. guid : TGUID;
  620. begin
  621. guid.NewGuid;
  622. Result := guid.ToString
  623. //GUIDToString(guid);
  624. end;
  625. function IsLike(cText, Pattern: string) : Boolean;
  626. var
  627. i, n : Integer;
  628. match : Boolean;
  629. wildcard : Boolean;
  630. CurrentPattern : Char;
  631. begin
  632. Result := False;
  633. wildcard := False;
  634. cText := LowerCase(cText);
  635. Pattern := LowerCase(Pattern);
  636. match := False;
  637. if (Pattern.Length > cText.Length) or (Pattern = '') then Exit;
  638. if Pattern = '*' then
  639. begin
  640. Result := True;
  641. Exit;
  642. end;
  643. for i := 1 to cText.Length do
  644. begin
  645. CurrentPattern := Pattern[i];
  646. if CurrentPattern = '*' then wildcard := True;
  647. if wildcard then
  648. begin
  649. n := Pos(Copy(Pattern,i+1,Pattern.Length),cText);
  650. if (n > i) or (Pattern.Length = i) then
  651. begin
  652. Result := True;
  653. Exit;
  654. end;
  655. end
  656. else
  657. begin
  658. if (cText[i] = CurrentPattern) or (CurrentPattern = '?') then match := True
  659. else match := False;
  660. end;
  661. end;
  662. Result := match;
  663. end;
  664. function Capitalize(s: string): string;
  665. begin
  666. Result := '';
  667. if s.Length = 0 then Exit;
  668. s := LowerCase(s,loUserLocale);
  669. Result := UpperCase(s[1],loUserLocale) + Trim(Copy(s, 2, s.Length));
  670. end;
  671. function CapitalizeWords(s: string): string;
  672. var
  673. cword : string;
  674. begin
  675. Result := '';
  676. if s.Length = 0 then Exit;
  677. s := LowerCase(s,loUserLocale);
  678. for cword in s.Split([' ']) do
  679. begin
  680. if Result = '' then Result := Capitalize(cword)
  681. else Result := Result + ' ' + Capitalize(cword);
  682. end;
  683. end;
  684. function GetLoggedUserName : string;
  685. {$IFDEF MSWINDOWS}
  686. const
  687. cnMaxUserNameLen = 254;
  688. var
  689. sUserName : string;
  690. dwUserNameLen : DWord;
  691. begin
  692. dwUserNameLen := cnMaxUserNameLen-1;
  693. SetLength( sUserName, cnMaxUserNameLen );
  694. GetUserName(PChar( sUserName ),dwUserNameLen );
  695. SetLength( sUserName, dwUserNameLen );
  696. Result := sUserName;
  697. end;
  698. {$ELSE}
  699. {$IF DEFINED(FPC) AND DEFINED(LINUX)}
  700. begin
  701. Result := GetEnvironmentVariable('USERNAME');
  702. end;
  703. {$ELSE}
  704. begin
  705. {$IFDEF POSIX}
  706. Result := string(getlogin);
  707. {$ELSE}
  708. Result := 'N/A';
  709. {$ENDIF}
  710. //raise ENotImplemented.Create('Not Android GetLoggedUserName implemented!');
  711. end;
  712. {$ENDIF}
  713. {$ENDIF}
  714. {$IFDEF IOS}
  715. function GetDeviceModel : String;
  716. var
  717. size : size_t;
  718. buffer : array of Byte;
  719. begin
  720. sysctlbyname('hw.machine',nil,@size,nil,0);
  721. if size > 0 then
  722. begin
  723. SetLength(buffer, size);
  724. sysctlbyname('hw.machine',@buffer[0],@size,nil,0);
  725. Result := UTF8ToString(MarshaledAString(buffer));
  726. end
  727. else Result := EmptyStr;
  728. end;
  729. {$ENDIF}
  730. function GetComputerName : string;
  731. {$IFDEF MSWINDOWS}
  732. var
  733. dwLength: dword;
  734. begin
  735. dwLength := 253;
  736. SetLength(Result, dwLength+1);
  737. if not Windows.GetComputerName(pchar(result), dwLength) then Result := 'Not detected!';
  738. Result := pchar(result);
  739. end;
  740. {$ELSE}
  741. {$IF DEFINED(FPC) AND DEFINED(LINUX)}
  742. begin
  743. Result := GetEnvironmentVariable('COMPUTERNAME');
  744. end;
  745. {$ELSE} //Android gets model name
  746. {$IFDEF NEXTGEN}
  747. begin
  748. {$IFDEF ANDROID}
  749. Result := JStringToString(TJBuild.JavaClass.MODEL);
  750. {$ELSE} //IOS
  751. Result := GetDeviceModel;
  752. {$ENDIF}
  753. end;
  754. {$ELSE}
  755. {$IFDEF DELPHILINUX}
  756. var
  757. puser : PAnsiChar;
  758. begin
  759. //puser := '';
  760. try
  761. if gethostname(puser,_SC_HOST_NAME_MAX) = 0 then Result := string(puser)
  762. else Result := 'N/A';
  763. except
  764. Result := 'N/A';
  765. end;
  766. end;
  767. {$ELSE} //OSX
  768. begin
  769. Result := NSStrToStr(TNSHost.Wrap(TNSHost.OCClass.currentHost).localizedName);
  770. end;
  771. {$ENDIF}
  772. {$ENDIF}
  773. {$ENDIF}
  774. {$ENDIF}
  775. function NormalizePathDelim(const cPath : string; const Delim : Char) : string;
  776. begin
  777. if Delim = '\' then Result := StringReplace(cPath,'/',Delim,[rfReplaceAll])
  778. else Result := StringReplace(cPath,'\',Delim,[rfReplaceAll]);
  779. end;
  780. function RemoveLastPathSegment(cDir : string) : string;
  781. var
  782. posi : Integer;
  783. delim : Char;
  784. EndsWithDelim : Boolean;
  785. begin
  786. if cDir.Contains('\') then delim := '\'
  787. else if cDir.Contains('/') then delim := '/'
  788. else
  789. begin
  790. Result := '';
  791. Exit;
  792. end;
  793. NormalizePathDelim(cDir,delim);
  794. if cDir.EndsWith(delim) then
  795. begin
  796. cDir := Copy(cDir,1,cDir.Length-1);
  797. EndsWithDelim := True;
  798. end
  799. else EndsWithDelim := False;
  800. if cDir.CountChar(delim) > 1 then posi := cDir.LastDelimiter(delim)
  801. else posi := Pos(delim,cDir)-1;
  802. if posi = cDir.Length then posi := 0;
  803. Result := Copy(cDir,1,posi);
  804. if (Result <> '') and (EndsWithDelim) then Result := Result + delim;
  805. end;
  806. function ParamFindSwitch(const Switch : string) : Boolean;
  807. begin
  808. Result := FindCmdLineSwitch(Switch,['-', '/'],True);
  809. end;
  810. {$IFDEF FPC}
  811. function FindCmdLineSwitch(const Switch: string; var Value: string; IgnoreCase: Boolean = True;
  812. const SwitchTypes: TCmdLineSwitchTypes = [clstValueNextParam, clstValueAppended]): Boolean; overload;
  813. type
  814. TCompareProc = function(const S1, S2: string): Boolean;
  815. var
  816. Param: string;
  817. I, ValueOfs,
  818. SwitchLen, ParamLen: Integer;
  819. SameSwitch: TCompareProc;
  820. begin
  821. Result := False;
  822. Value := '';
  823. if IgnoreCase then
  824. SameSwitch := SameText else
  825. SameSwitch := SameStr;
  826. SwitchLen := Switch.Length;
  827. for I := 1 to ParamCount do
  828. begin
  829. Param := ParamStr(I);
  830. if CharInSet(Param.Chars[0], SwitchChars) and SameSwitch(Param.SubString(1,SwitchLen), Switch) then
  831. begin
  832. ParamLen := Param.Length;
  833. // Look for an appended value if the param is longer than the switch
  834. if (ParamLen > SwitchLen + 1) then
  835. begin
  836. // If not looking for appended value switches then this is not a matching switch
  837. if not (clstValueAppended in SwitchTypes) then
  838. Continue;
  839. ValueOfs := SwitchLen + 1;
  840. if Param.Chars[ValueOfs] = ':' then
  841. Inc(ValueOfs);
  842. Value := Param.SubString(ValueOfs, MaxInt);
  843. end
  844. // If the next param is not a switch, then treat it as the value
  845. else if (clstValueNextParam in SwitchTypes) and (I < ParamCount) and
  846. not CharInSet(ParamStr(I+1).Chars[0], SwitchChars) then
  847. Value := ParamStr(I+1);
  848. Result := True;
  849. Break;
  850. end;
  851. end;
  852. end;
  853. {$ENDIF}
  854. function ParamGetSwitch(const Switch : string; var cvalue : string) : Boolean;
  855. begin
  856. Result := FindCmdLineSwitch(Switch,cvalue,True,[clstValueAppended]);
  857. end;
  858. function GetAppName : string;
  859. begin
  860. Result := ExtractFilenameWithoutExt(ParamStr(0));
  861. end;
  862. function GetAppVersionStr: string;
  863. {$IFDEF MSWINDOWS}
  864. var
  865. Rec: LongRec;
  866. ver : Cardinal;
  867. begin
  868. ver := GetFileVersion(ParamStr(0));
  869. if ver <> Cardinal(-1) then
  870. begin
  871. Rec := LongRec(ver);
  872. Result := Format('%d.%d', [Rec.Hi, Rec.Lo]);
  873. end
  874. else Result := '';
  875. end;
  876. {$ELSE}
  877. {$IF DEFINED(FPC) AND DEFINED(LINUX)}
  878. var
  879. version : TProgramVersion;
  880. begin
  881. if GetProgramVersion(version) then Result := Format('%d.%d', [version.Major, version.Minor])
  882. else Result := '';
  883. end;
  884. {$ELSE}
  885. {$IFDEF NEXTGEN}
  886. {$IFDEF ANDROID}
  887. var
  888. PkgInfo : JPackageInfo;
  889. begin
  890. PkgInfo := SharedActivity.getPackageManager.getPackageInfo(SharedActivity.getPackageName,0);
  891. Result := IntToStr(PkgInfo.VersionCode);
  892. end;
  893. {$ELSE} //IOS
  894. var
  895. AppKey: Pointer;
  896. AppBundle: NSBundle;
  897. BuildStr : NSString;
  898. begin
  899. try
  900. AppKey := (StrToNSStr('CFBundleVersion') as ILocalObject).GetObjectID;
  901. AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
  902. BuildStr := TNSString.Wrap(AppBundle.infoDictionary.objectForKey(AppKey));
  903. Result := UTF8ToString(BuildStr.UTF8String);
  904. except
  905. Result := '';
  906. end;
  907. end;
  908. {$ENDIF}
  909. {$ELSE} //OSX
  910. {$IFDEF OSX}
  911. var
  912. AppKey: Pointer;
  913. AppBundle: NSBundle;
  914. BuildStr : NSString;
  915. begin
  916. try
  917. AppKey := (StrToNSStr('CFBundleVersion') as ILocalObject).GetObjectID;
  918. AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
  919. BuildStr := TNSString.Wrap(AppBundle.infoDictionary.objectForKey(AppKey));
  920. Result := UTF8ToString(BuildStr.UTF8String);
  921. except
  922. Result := '';
  923. end;
  924. end;
  925. {$ELSE}
  926. begin
  927. Result := '';
  928. end;
  929. {$ENDIF}
  930. {$ENDIF}
  931. {$ENDIF}
  932. {$ENDIF}
  933. function GetAppVersionFullStr: string;
  934. {$IFDEF MSWINDOWS}
  935. var
  936. Exe: string;
  937. Size, Handle: DWORD;
  938. Buffer: TBytes;
  939. FixedPtr: PVSFixedFileInfo;
  940. begin
  941. Result := '';
  942. Exe := ParamStr(0);
  943. Size := GetFileVersionInfoSize(PChar(Exe), Handle);
  944. if Size = 0 then
  945. begin
  946. //RaiseLastOSError;
  947. //no version info in file
  948. Exit;
  949. end;
  950. SetLength(Buffer, Size);
  951. if not GetFileVersionInfo(PChar(Exe), Handle, Size, Buffer) then
  952. RaiseLastOSError;
  953. if not VerQueryValue(Buffer, '\', Pointer(FixedPtr), Size) then
  954. RaiseLastOSError;
  955. if (LongRec(FixedPtr.dwFileVersionLS).Hi = 0) and (LongRec(FixedPtr.dwFileVersionLS).Lo = 0) then
  956. begin
  957. Result := Format('%d.%d',
  958. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  959. LongRec(FixedPtr.dwFileVersionMS).Lo]); //minor
  960. end
  961. else if (LongRec(FixedPtr.dwFileVersionLS).Lo = 0) then
  962. begin
  963. Result := Format('%d.%d.%d',
  964. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  965. LongRec(FixedPtr.dwFileVersionMS).Lo, //minor
  966. LongRec(FixedPtr.dwFileVersionLS).Hi]); //release
  967. end
  968. else
  969. begin
  970. Result := Format('%d.%d.%d.%d',
  971. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  972. LongRec(FixedPtr.dwFileVersionMS).Lo, //minor
  973. LongRec(FixedPtr.dwFileVersionLS).Hi, //release
  974. LongRec(FixedPtr.dwFileVersionLS).Lo]); //build
  975. end;
  976. end;
  977. {$ELSE}
  978. {$IF DEFINED(FPC) AND DEFINED(LINUX)}
  979. var
  980. version : TProgramVersion;
  981. begin
  982. if GetProgramVersion(version) then Result := Format('%d.%d.%d.%d', [version.Major, version.Minor, version.Revision, version.Build])
  983. else Result := '';
  984. end;
  985. {$ELSE}
  986. {$IFDEF NEXTGEN}
  987. {$IFDEF ANDROID}
  988. var
  989. PkgInfo : JPackageInfo;
  990. begin
  991. PkgInfo := SharedActivity.getPackageManager.getPackageInfo(SharedActivity.getPackageName,0);
  992. Result := JStringToString(PkgInfo.versionName);
  993. end;
  994. {$ELSE} //IOS
  995. var
  996. AppKey: Pointer;
  997. AppBundle: NSBundle;
  998. BuildStr : NSString;
  999. begin
  1000. AppKey := (StrToNSStr('CFBundleVersion') as ILocalObject).GetObjectID;
  1001. AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
  1002. BuildStr := TNSString.Wrap(AppBundle.infoDictionary.objectForKey(AppKey));
  1003. Result := UTF8ToString(BuildStr.UTF8String);
  1004. end;
  1005. {$ENDIF}
  1006. {$ELSE}
  1007. {$IFDEF OSX}
  1008. var
  1009. AppKey: Pointer;
  1010. AppBundle: NSBundle;
  1011. BuildStr : NSString;
  1012. begin
  1013. AppKey := (StrToNSStr('CFBundleVersion') as ILocalObject).GetObjectID;
  1014. AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
  1015. BuildStr := TNSString.Wrap(AppBundle.infoDictionary.objectForKey(AppKey));
  1016. Result := UTF8ToString(BuildStr.UTF8String);
  1017. end;
  1018. {$ELSE}
  1019. begin
  1020. Result := '';
  1021. end;
  1022. {$ENDIF}
  1023. {$ENDIF}
  1024. {$ENDIF}
  1025. {$ENDIF}
  1026. function UTCToLocalTime(GMTTime: TDateTime): TDateTime;
  1027. begin
  1028. {$IFDEF FPC}
  1029. Result := LocalTimeToUniversal(GMTTime);
  1030. {$ELSE}
  1031. Result := TTimeZone.Local.ToLocalTime(GMTTime);
  1032. {$ENDIF}
  1033. end;
  1034. function LocalTimeToUTC(LocalTime : TDateTime): TDateTime;
  1035. begin
  1036. {$IFDEF FPC}
  1037. Result := UniversalTimeToLocal(Localtime);
  1038. {$ELSE}
  1039. Result := TTimeZone.Local.ToUniversalTime(LocalTime);
  1040. {$ENDIF}
  1041. end;
  1042. function DateTimeToGMT(aDate : TDateTime) : string;
  1043. var
  1044. FmtSettings : TFormatSettings;
  1045. begin
  1046. FmtSettings.DateSeparator := '-';
  1047. FmtSettings.TimeSeparator := ':';
  1048. FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ" GMT"';
  1049. Result := DateTimeToStr(aDate,FmtSettings).Trim;
  1050. end;
  1051. function GMTToDateTime(aDate : string) : TDateTime;
  1052. var
  1053. FmtSettings : TFormatSettings;
  1054. begin
  1055. FmtSettings.DateSeparator := '-';
  1056. FmtSettings.TimeSeparator := ':';
  1057. FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ" GMT"';
  1058. Result := StrToDateTime(aDate,FmtSettings);
  1059. end;
  1060. function DateTimeToJsonDate(aDateTime : TDateTime) : string;
  1061. {$IFNDEF DELPHIXE7_UP}
  1062. var
  1063. FmtSettings : TFormatSettings;
  1064. {$ENDIF}
  1065. begin
  1066. {$IFDEF DELPHIXE7_UP}
  1067. Result := DateToISO8601(aDateTime);
  1068. {$ELSE}
  1069. FmtSettings.DateSeparator := '-';
  1070. FmtSettings.TimeSeparator := ':';
  1071. FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ"Z"';
  1072. Result := DateTimeToStr(aDateTime,FmtSettings).Trim;
  1073. {$ENDIF}
  1074. end;
  1075. function JsonDateToDateTime(const aJsonDate : string) : TDateTime;
  1076. {$IFNDEF DELPHIXE7_UP}
  1077. var
  1078. FmtSettings : TFormatSettings;
  1079. {$ENDIF}
  1080. {$IFDEF FPC}
  1081. var
  1082. jdate : string;
  1083. {$ENDIF}
  1084. begin
  1085. {$IFDEF DELPHIXE7_UP}
  1086. Result := ISO8601ToDate(aJsonDate);
  1087. {$ELSE}
  1088. FmtSettings.DateSeparator := '-';
  1089. FmtSettings.TimeSeparator := ':';
  1090. FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ"Z"';
  1091. {$IFDEF FPC}
  1092. jdate := StringReplace(aJsondate,'T',' ',[rfIgnoreCase]);
  1093. jdate := Copy(jdate,1,Pos('.',jdate)-1);
  1094. Result := StrToDateTime(jdate,FmtSettings);
  1095. {$ELSE}
  1096. Result := StrToDateTime(aJsonDate,FmtSettings);
  1097. {$ENDIF}
  1098. {$ENDIF}
  1099. end;
  1100. function CountDigits(anInt: Cardinal): Cardinal; inline;
  1101. var
  1102. cmp: Cardinal;
  1103. begin
  1104. cmp := 10;
  1105. Result := 1;
  1106. while (Result < 10) and (cmp <= anInt) do
  1107. begin
  1108. cmp := cmp*10;
  1109. Inc(Result);
  1110. end;
  1111. end;
  1112. procedure SaveStreamToFile(stream : TStream; const filename : string);
  1113. var
  1114. fs : TFileStream;
  1115. begin
  1116. fs := TFileStream.Create(filename,fmCreate);
  1117. try
  1118. stream.Seek(0,soBeginning);
  1119. fs.CopyFrom(stream,stream.Size);
  1120. finally
  1121. fs.Free;
  1122. end;
  1123. end;
  1124. function StreamToString(stream : TStream) : string;
  1125. var
  1126. ss : TStringStream;
  1127. begin
  1128. if stream = nil then Exit;
  1129. ss := TStringStream.Create;
  1130. try
  1131. stream.Seek(0,soBeginning);
  1132. ss.CopyFrom(stream,stream.Size);
  1133. Result := ss.DataString;
  1134. finally
  1135. ss.Free;
  1136. end;
  1137. end;
  1138. function CommaText(aList : TStringList) : string;
  1139. var
  1140. value : string;
  1141. sb : TStringBuilder;
  1142. begin
  1143. if aList.Text = '' then Exit;
  1144. sb := TStringBuilder.Create;
  1145. try
  1146. for value in aList do
  1147. begin
  1148. sb.Append(value);
  1149. sb.Append(',');
  1150. end;
  1151. if sb.Length > 1 then Result := sb.ToString(0, sb.Length - 1);
  1152. finally
  1153. sb.Free;
  1154. end;
  1155. end;
  1156. function CommaText(aArray : TArray<string>) : string;
  1157. var
  1158. value : string;
  1159. sb : TStringBuilder;
  1160. begin
  1161. if High(aArray) < 0 then Exit;
  1162. sb := TStringBuilder.Create;
  1163. try
  1164. for value in aArray do
  1165. begin
  1166. sb.Append(value);
  1167. sb.Append(',');
  1168. end;
  1169. if sb.Length > 1 then Result := sb.ToString(0, sb.Length - 1);
  1170. finally
  1171. sb.Free;
  1172. end;
  1173. end;
  1174. { TCounter }
  1175. procedure TCounter.Init(aMaxValue : Integer);
  1176. begin
  1177. fMaxValue := aMaxValue;
  1178. fCurrentValue := 0;
  1179. end;
  1180. function TCounter.Count : Integer;
  1181. begin
  1182. Result := fCurrentValue;
  1183. end;
  1184. function TCounter.CountIs(aValue : Integer) : Boolean;
  1185. begin
  1186. Result := fCurrentValue = aValue;
  1187. end;
  1188. function TCounter.Check : Boolean;
  1189. begin
  1190. if fCurrentValue = fMaxValue then
  1191. begin
  1192. Result := True;
  1193. Reset;
  1194. end
  1195. else
  1196. begin
  1197. Result := False;
  1198. Inc(fCurrentValue);
  1199. end;
  1200. end;
  1201. procedure TCounter.Reset;
  1202. begin
  1203. fCurrentValue := fMaxValue;
  1204. end;
  1205. { TimeCounter }
  1206. procedure TTimeCounter.Init(MillisecondsToReach : Integer);
  1207. begin
  1208. fDoneEvery := MillisecondsToReach;
  1209. end;
  1210. function TTimeCounter.Check : Boolean;
  1211. begin
  1212. if MilliSecondsBetween(fCurrentTime,Now) > fDoneEvery then
  1213. begin
  1214. fCurrentTime := Now();
  1215. Result := True;
  1216. end
  1217. else Result := False;
  1218. end;
  1219. procedure TTimeCounter.Reset;
  1220. begin
  1221. fCurrentTime := Now();
  1222. end;
  1223. {$IFDEF MSWINDOWS}
  1224. procedure ProcessMessages;
  1225. var
  1226. Msg: TMsg;
  1227. begin
  1228. while integer(PeekMessage(Msg, 0, 0, 0, PM_REMOVE)) <> 0 do
  1229. begin
  1230. TranslateMessage(Msg);
  1231. DispatchMessage(Msg);
  1232. end;
  1233. end;
  1234. function GetLastOSError: String;
  1235. begin
  1236. Result := SysErrorMessage(Windows.GetLastError);
  1237. end;
  1238. {$ENDIF}
  1239. function RemoveLastChar(const aText : string) : string;
  1240. begin
  1241. Result := aText.Remove(aText.Length - 1);
  1242. end;
  1243. function DateTimeToSQL(aDateTime : TDateTime) : string;
  1244. begin
  1245. Result := FormatDateTime('YYYYMMDD hh:mm:ss',aDateTime);
  1246. end;
  1247. function IsInteger(const aValue : string) : Boolean;
  1248. var
  1249. i : Integer;
  1250. begin
  1251. Result := TryStrToInt(aValue,i);
  1252. end;
  1253. function ExtractStr(var vSource : string; aIndex : Integer; aCount : Integer) : string;
  1254. begin
  1255. if aIndex > vSource.Length then Exit('');
  1256. Result := Copy(vSource,aIndex,aCount);
  1257. Delete(vSource,aIndex,aCount);
  1258. end;
  1259. function GetSubString(const aSource, aFirstDelimiter, aLastDelimiter : string) : string;
  1260. var
  1261. i : Integer;
  1262. begin
  1263. i := Pos(aFirstDelimiter,aSource);
  1264. if i > -1 then Result := Copy(aSource, i + aFirstDelimiter.Length, Pos(aLastDelimiter, aSource, i + aFirstDelimiter.Length) - i - aFirstDelimiter.Length)
  1265. else Result := '';
  1266. end;
  1267. function DbQuotedStr(const str : string): string;
  1268. var
  1269. i : Integer;
  1270. begin
  1271. Result := str;
  1272. for i := Result.Length - 1 downto 0 do
  1273. begin
  1274. if Result.Chars[i] = '"' then Result := Result.Insert(i, '"');
  1275. end;
  1276. Result := '"' + Result + '"';
  1277. end;
  1278. function UnDbQuotedStr(const str: string) : string;
  1279. begin
  1280. Result := Trim(str);
  1281. if not Result.IsEmpty then
  1282. begin
  1283. if Result.StartsWith('"') then Result := Copy(Result, 2, Result.Length - 2);
  1284. end;
  1285. end;
  1286. {$IFDEF MSWINDOWS}
  1287. initialization
  1288. try
  1289. GetEnvironmentPaths;
  1290. except
  1291. {$IFDEF SHOW_ENVIRONMENTPATH_ERRORS}
  1292. on E : Exception do
  1293. begin
  1294. if not IsService then
  1295. begin
  1296. if HasConsoleOutput then Writeln(Format('[WARN] GetEnvironmentPaths: %s',[E.Message]))
  1297. else MessageBox(0,PWideChar(Format('Get environment path error: %s',[E.Message])),'GetEnvironmentPaths',MB_ICONEXCLAMATION);
  1298. end;
  1299. end;
  1300. {$ENDIF}
  1301. end;
  1302. {$ENDIF}
  1303. end.