Quick.Commons.pas 34 KB

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