Quick.Commons.pas 35 KB

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