Quick.Commons.pas 48 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894
  1. { ***************************************************************************
  2. Copyright (c) 2016-2020 Kike Pérez
  3. Unit : Quick.Commons
  4. Description : Common functions
  5. Author : Kike Pérez
  6. Version : 1.9
  7. Created : 14/07/2017
  8. Modified : 14/03/2020
  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. TEnvironmentPath = record
  81. EXEPATH : string;
  82. {$IFDEF MSWINDOWS}
  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. {$ENDIF MSWINDOWS}
  100. end;
  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. {$IFNDEF FPC}
  150. TArrayOfStringHelper = record helper for TArray<string>
  151. public
  152. function Any : Boolean; overload;
  153. function Any(const aValue : string) : Boolean; overload;
  154. function Add(const aValue : string) : Integer;
  155. function AddIfNotExists(const aValue : string; aCaseSense : Boolean = False) : Integer;
  156. function Remove(const aValue : string) : Boolean;
  157. function Exists(const aValue : string) : Boolean;
  158. function Count : Integer;
  159. end;
  160. TDelegate<T> = reference to procedure(Value : T);
  161. {$ENDIF}
  162. TPairItem = record
  163. Name : string;
  164. Value : string;
  165. constructor Create(const aName, aValue : string);
  166. end;
  167. TPairList = class
  168. type
  169. TPairEnumerator = class
  170. private
  171. fArray : ^TArray<TPairItem>;
  172. fIndex : Integer;
  173. function GetCurrent: TPairItem;
  174. public
  175. constructor Create(var aArray: TArray<TPairItem>);
  176. property Current : TPairItem read GetCurrent;
  177. function MoveNext: Boolean;
  178. end;
  179. private
  180. fItems : TArray<TPairItem>;
  181. public
  182. function GetEnumerator : TPairEnumerator;
  183. function GetValue(const aName : string) : string;
  184. function GetPair(const aName : string) : TPairItem;
  185. function Add(aPair : TPairItem) : Integer; overload;
  186. function Add(const aName, aValue : string) : Integer; overload;
  187. procedure AddOrUpdate(const aName, aValue : string);
  188. function Exists(const aName : string) : Boolean;
  189. function Remove(const aName : string) : Boolean;
  190. function Count : Integer;
  191. property Items[const aName : string] : string read GetValue write AddOrUpdate;
  192. function ToArray : TArray<TPairItem>;
  193. procedure FromArray(aValue : TArray<TPairItem>);
  194. end;
  195. EEnvironmentPath = class(Exception);
  196. EShellError = class(Exception);
  197. //generates a random password with complexity options
  198. function RandomPassword(const PasswordLength : Integer; Complexity : TPasswordComplexity = [pfIncludeNumbers,pfIncludeSigns]) : string;
  199. //generates a random string
  200. function RandomString(const aLength: Integer) : string;
  201. //extracts file extension from a filename
  202. function ExtractFileNameWithoutExt(const FileName: string): string;
  203. //converts a Unix path to Windows path
  204. function UnixToWindowsPath(const UnixPath: string): string;
  205. //converts a Windows path to Unix path
  206. function WindowsToUnixPath(const WindowsPath: string): string;
  207. //corrects malformed urls
  208. function CorrectURLPath(cUrl : string) : string;
  209. //get typical environment paths as temp, desktop, etc
  210. procedure GetEnvironmentPaths;
  211. {$IFDEF MSWINDOWS}
  212. function GetSpecialFolderPath(folderID : Integer) : string;
  213. //checks if running on a 64bit OS
  214. function Is64bitOS : Boolean;
  215. //checks if is a console app
  216. function IsConsole : Boolean;
  217. function HasConsoleOutput : Boolean;
  218. //checks if compiled in debug mode
  219. {$ENDIF}
  220. function IsDebug : Boolean;
  221. {$IFDEF MSWINDOWS}
  222. //checks if running as a service
  223. function IsService : Boolean;
  224. //gets number of seconds without user interaction (mouse, keyboard)
  225. function SecondsIdle: DWord;
  226. //frees process memory not needed
  227. procedure FreeUnusedMem;
  228. //changes screen resolution
  229. function SetScreenResolution(Width, Height: integer): Longint;
  230. {$ENDIF MSWINDOWS}
  231. //returns last day of current month
  232. function LastDayCurrentMonth: TDateTime;
  233. {$IFDEF FPC}
  234. function DateTimeInRange(ADateTime: TDateTime; AStartDateTime, AEndDateTime: TDateTime; aInclusive: Boolean = True): Boolean;
  235. {$ENDIF}
  236. //checks if two datetimes are in same day
  237. function IsSameDay(cBefore, cNow : TDateTime) : Boolean;
  238. //change Time of a DateTime
  239. function ChangeTimeOfADay(aDate : TDateTime; aHour, aMinute, aSecond : Word; aMilliSecond : Word = 0) : TDateTime;
  240. //change Date of a DateTime
  241. function ChangeDateOfADay(aDate : TDateTime; aYear, aMonth, aDay : Word) : TDateTime;
  242. //returns n times a char
  243. function FillStr(const C : Char; const Count : Integer) : string;
  244. //checks if string exists in array of string
  245. function StrInArray(const aValue : string; const aInArray : array of string) : Boolean;
  246. //checks if integer exists in array of integer
  247. function IntInArray(const aValue : Integer; const aInArray : array of Integer) : Boolean;
  248. //check if array is empty
  249. function IsEmptyArray(aArray : TArray<string>) : Boolean; overload;
  250. function IsEmptyArray(aArray : TArray<Integer>) : Boolean; overload;
  251. //returns a number leading zero
  252. function Zeroes(const Number, Len : Int64) : string;
  253. //converts a number to thousand delimeter string
  254. function NumberToStr(const Number : Int64) : string;
  255. //returns n spaces
  256. function Spaces(const Count : Integer) : string;
  257. //returns current date as a string
  258. function NowStr : string;
  259. //returns a new GUID as string
  260. function NewGuidStr : string;
  261. //compare a string with a wildcard pattern (? or *)
  262. function IsLike(cText, Pattern: string) : Boolean;
  263. //Upper case for first letter
  264. function Capitalize(s: string): string;
  265. function CapitalizeWords(s: string): string;
  266. //returns current logged user
  267. function GetLoggedUserName : string;
  268. //returns computer name
  269. function GetComputerName : string;
  270. //Changes incorrect delims in path
  271. function NormalizePathDelim(const cPath : string; const Delim : Char) : string;
  272. //Removes last segment of a path
  273. function RemoveLastPathSegment(cDir : string) : string;
  274. //returns path delimiter if found
  275. function GetPathDelimiter(const aPath : string) : string;
  276. //returns first segment of a path
  277. function GetFirstPathSegment(const aPath : string) : string;
  278. //returns last segment of a path
  279. function GetLastPathSegment(const aPath : string) : string;
  280. //finds swith in commandline params
  281. function ParamFindSwitch(const Switch : string) : Boolean;
  282. //gets value for a switch if exists
  283. function ParamGetSwitch(const Switch : string; var cvalue : string) : Boolean;
  284. //returns app name (filename based)
  285. function GetAppName : string;
  286. //returns app version (major & minor)
  287. function GetAppVersionStr: string;
  288. //returns app version full (major, minor, release & compiled)
  289. function GetAppVersionFullStr: string;
  290. //convert UTC DateTime to Local DateTime
  291. function UTCToLocalTime(GMTTime: TDateTime): TDateTime;
  292. //convert Local DateTime to UTC DateTime
  293. function LocalTimeToUTC(LocalTime : TDateTime): TDateTime;
  294. //convert DateTime to GTM Time string
  295. function DateTimeToGMT(aDate : TDateTime) : string;
  296. //convert GMT Time string to DateTime
  297. function GMTToDateTime(aDate : string) : TDateTime;
  298. //convert DateTime to Json Date format
  299. function DateTimeToJsonDate(aDateTime : TDateTime) : string;
  300. //convert Json Date format to DateTime
  301. function JsonDateToDateTime(const aJsonDate : string) : TDateTime;
  302. //count number of digits of a Integer
  303. function CountDigits(anInt: Cardinal): Cardinal; inline;
  304. //count times a string is present in other string
  305. function CountStr(const aFindStr, aSourceStr : string) : Integer;
  306. //save stream to file
  307. procedure SaveStreamToFile(aStream : TStream; const aFilename : string);
  308. //save stream to string
  309. function StreamToString(aStream : TStream) : string;
  310. function StreamToString2(const aStream: TStream; const aEncoding: TEncoding): string;
  311. //save string to stream
  312. procedure StringToStream(const aStr : string; aStream : TStream);
  313. procedure StringToStream2(const aStr : string; aStream : TStream);
  314. //returns a real comma separated text from stringlist
  315. function CommaText(aList : TStringList) : string; overload;
  316. //returns a real comma separated text from array of string
  317. function CommaText(aArray : TArray<string>) : string; overload;
  318. //returns a string CRLF from array of string
  319. function ArrayToString(aArray : TArray<string>) : string;
  320. //converts TStrings to array
  321. function StringsToArray(aStrings : TStrings) : TArray<string>;
  322. {$IFDEF MSWINDOWS}
  323. //process messages on console applications
  324. procedure ProcessMessages;
  325. //get last error message
  326. function GetLastOSError : String;
  327. {$ENDIF}
  328. {$IF DEFINED(FPC) AND DEFINED(MSWINDOWS)}
  329. function GetLastInputInfo(var plii: TLastInputInfo): BOOL;stdcall; external 'user32' name 'GetLastInputInfo';
  330. {$ENDIF}
  331. function RemoveLastChar(const aText : string) : string;
  332. function DateTimeToSQL(aDateTime : TDateTime) : string;
  333. function IsInteger(const aValue : string) : Boolean;
  334. //extract a substring and deletes from source string
  335. function ExtractStr(var vSource : string; aIndex : Integer; aCount : Integer) : string;
  336. //get first string between string delimiters
  337. function GetSubString(const aSource, aFirstDelimiter, aLastDelimiter : string) : string;
  338. //get double quoted or dequoted string
  339. function DbQuotedStr(const str : string): string;
  340. function UnDbQuotedStr(const str: string) : string;
  341. //get simple quoted or dequoted string
  342. function SpQuotedStr(const str : string): string;
  343. function UnSpQuotedStr(const str : string): string;
  344. //ternary operator
  345. function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : string) : string; overload;
  346. function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : Integer) : Integer; overload;
  347. function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : Extended) : Extended; overload;
  348. function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : TObject) : TObject; overload;
  349. var
  350. path : TEnvironmentPath;
  351. implementation
  352. {TFileHelper}
  353. {$IFNDEF FPC}
  354. {$IFDEF MSWINDOWS}
  355. class function TFileHelper.IsInUse(const FileName : string) : Boolean;
  356. var
  357. HFileRes: HFILE;
  358. begin
  359. Result := False;
  360. if not FileExists(FileName) then Exit;
  361. try
  362. HFileRes := CreateFile(PChar(FileName)
  363. ,GENERIC_READ or GENERIC_WRITE
  364. ,0
  365. ,nil
  366. ,OPEN_EXISTING
  367. ,FILE_ATTRIBUTE_NORMAL
  368. ,0);
  369. Result := (HFileRes = INVALID_HANDLE_VALUE);
  370. if not(Result) then begin
  371. CloseHandle(HFileRes);
  372. end;
  373. except
  374. Result := True;
  375. end;
  376. end;
  377. {$ENDIF}
  378. {$IFDEF DELPHILINUX}
  379. class function TFileHelper.IsInUse(const FileName : string) : Boolean;
  380. var
  381. fs : TFileStream;
  382. begin
  383. try
  384. fs := TFileStream.Create(FileName, fmOpenReadWrite, fmShareExclusive);
  385. Result := True;
  386. fs.Free;
  387. except
  388. Result := False;
  389. end;
  390. end;
  391. {$ENDIF}
  392. {$IFDEF MSWINDOWS}
  393. class function TFileHelper.GetSize(const FileName: String): Int64;
  394. var
  395. info: TWin32FileAttributeData;
  396. begin
  397. Result := -1;
  398. if not GetFileAttributesEx(PWideChar(FileName), GetFileExInfoStandard, @info) then Exit;
  399. Result := Int64(info.nFileSizeLow) or Int64(info.nFileSizeHigh shl 32);
  400. end;
  401. {$ELSE}
  402. class function TFileHelper.GetSize(const FileName: String): Int64;
  403. var
  404. sr : TSearchRec;
  405. begin
  406. if FindFirst(fileName, faAnyFile, sr ) = 0 then Result := sr.Size
  407. else Result := -1;
  408. end;
  409. {$ENDIF}
  410. {TDirectoryHelper}
  411. class function TDirectoryHelper.GetSize(const Path: String): Int64;
  412. var
  413. filename : string;
  414. begin
  415. Result := -1;
  416. for filename in TDirectory.GetFiles(Path) do
  417. begin
  418. Result := Result + TFile.GetSize(filename);
  419. end;
  420. end;
  421. {$ENDIF}
  422. {other functions}
  423. function RandomPassword(const PasswordLength : Integer; Complexity : TPasswordComplexity = [pfIncludeNumbers,pfIncludeSigns]) : string;
  424. const
  425. PassAlpha = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
  426. PassSigns = '@!&$';
  427. PassNumbers = '1234567890';
  428. var
  429. MinNumbers,
  430. MinSigns : Integer;
  431. NumNumbers,
  432. NumSigns : Integer;
  433. begin
  434. Result := '';
  435. Randomize;
  436. //fill all alfa
  437. repeat
  438. Result := Result + PassAlpha[Random(Length(PassAlpha))+1];
  439. until (Length(Result) = PasswordLength);
  440. //checks if need include numbers
  441. if pfIncludeNumbers in Complexity then
  442. begin
  443. MinNumbers := Round(PasswordLength / 10 * 2);
  444. NumNumbers := 0;
  445. if MinNumbers = 0 then MinNumbers := 1;
  446. repeat
  447. Result[Random(PasswordLength)+1] := PassNumbers[Random(Length(PassNumbers))+1];
  448. Inc(NumNumbers);
  449. until NumNumbers = MinNumbers;
  450. end;
  451. //checks if need include signs
  452. if pfIncludeNumbers in Complexity then
  453. begin
  454. MinSigns := Round(PasswordLength / 10 * 1);
  455. NumSigns := 0;
  456. if MinSigns = 0 then MinSigns := 1;
  457. repeat
  458. Result[Random(PasswordLength)+1] := PassSigns[Random(Length(PassSigns))+1];
  459. Inc(NumSigns);
  460. until NumSigns = MinSigns;
  461. end;
  462. end;
  463. function RandomString(const aLength: Integer) : string;
  464. const
  465. chars : string = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890';
  466. var
  467. i : Integer;
  468. clong : Integer;
  469. begin
  470. clong := High(chars);
  471. SetLength(Result, aLength);
  472. for i := 1 to aLength do
  473. begin
  474. Result[i] := chars[Random(clong) + 1];
  475. end;
  476. end;
  477. function ExtractFileNameWithoutExt(const FileName: string): string;
  478. begin
  479. Result := TPath.GetFileNameWithoutExtension(FileName);
  480. end;
  481. function UnixToWindowsPath(const UnixPath: string): string;
  482. begin
  483. Result := StringReplace(UnixPath, '/', '\',[rfReplaceAll, rfIgnoreCase]);
  484. end;
  485. function WindowsToUnixPath(const WindowsPath: string): string;
  486. begin
  487. Result := StringReplace(WindowsPath, '\', '/',[rfReplaceAll, rfIgnoreCase]);
  488. end;
  489. function CorrectURLPath(cUrl : string) : string;
  490. var
  491. nurl : string;
  492. begin
  493. nurl := WindowsToUnixPath(cUrl);
  494. nurl := StringReplace(nurl,'//','/',[rfReplaceAll]);
  495. Result := StringReplace(nurl,' ','%20',[rfReplaceAll]);
  496. //TNetEncoding.Url.Encode()
  497. end;
  498. procedure GetEnvironmentPaths;
  499. begin
  500. //gets path
  501. path.EXEPATH := TPath.GetDirectoryName(ParamStr(0));
  502. {$IFDEF MSWINDOWS}
  503. path.WINDOWS := SysUtils.GetEnvironmentVariable('windir');
  504. path.PROGRAMFILES := SysUtils.GetEnvironmentVariable('ProgramFiles');
  505. path.COMMONFILES := SysUtils.GetEnvironmentVariable('CommonProgramFiles(x86)');
  506. path.HOMEDRIVE := SysUtils.GetEnvironmentVariable('SystemDrive');
  507. path.USERPROFILE := SysUtils.GetEnvironmentVariable('USERPROFILE');
  508. path.PROGRAMDATA := SysUtils.GetEnvironmentVariable('ProgramData');
  509. path.ALLUSERSPROFILE := SysUtils.GetEnvironmentVariable('AllUsersProfile');
  510. path.INSTDRIVE := path.HOMEDRIVE;
  511. path.TEMP := SysUtils.GetEnvironmentVariable('TEMP');
  512. //these paths fail if user is SYSTEM
  513. try
  514. path.SYSTEM := GetSpecialFolderPath(CSIDL_SYSTEM);
  515. path.APPDATA := GetSpecialFolderPath(CSIDL_APPDATA);
  516. path.DESKTOP := GetSpecialFolderPath(CSIDL_DESKTOP);
  517. path.DESKTOP_ALLUSERS := GetSpecialFolderPath(CSIDL_COMMON_DESKTOPDIRECTORY);
  518. path.STARTMENU:=GetSpecialFolderPath(CSIDL_PROGRAMS);
  519. path.STARTMENU_ALLUSERS:=GetSpecialFolderPath(CSIDL_COMMON_PROGRAMS);
  520. path.STARTMENU_ALLUSERS := path.STARTMENU;
  521. path.STARTUP:=GetSpecialFolderPath(CSIDL_STARTUP);
  522. except
  523. //
  524. end;
  525. {$ENDIF}
  526. end;
  527. {$IFDEF MSWINDOWS}
  528. function GetSpecialFolderPath(folderID : Integer) : string;
  529. var
  530. ppidl: PItemIdList;
  531. begin
  532. SHGetSpecialFolderLocation(0, folderID, ppidl);
  533. SetLength(Result, MAX_PATH);
  534. if not SHGetPathFromIDList(ppidl,{$IFDEF FPC}PAnsiChar(Result){$ELSE}PChar(Result){$ENDIF}) then
  535. begin
  536. raise EShellError.create(Format('GetSpecialFolderPath: Invalid PIPL (%d)',[folderID]));
  537. end;
  538. SetLength(Result, lStrLen({$IFDEF FPC}PAnsiChar(Result){$ELSE}PChar(Result){$ENDIF}));
  539. end;
  540. function Is64bitOS : Boolean;
  541. begin
  542. {$IFDEF WIN64}
  543. Result := True;
  544. {$ELSE}
  545. Result := False;
  546. {$ENDIF WIN64}
  547. end;
  548. function IsConsole: Boolean;
  549. begin
  550. {$IFDEF CONSOLE}
  551. Result := True;
  552. {$ELSE}
  553. Result := False;
  554. {$ENDIF CONSOLE}
  555. end;
  556. {$ENDIF}
  557. function HasConsoleOutput : Boolean;
  558. {$IFDEF MSWINDOWS}
  559. var
  560. stout : THandle;
  561. begin
  562. try
  563. stout := GetStdHandle(Std_Output_Handle);
  564. Win32Check(stout <> Invalid_Handle_Value);
  565. Result := stout <> 0;
  566. except
  567. Result := False;
  568. end;
  569. end;
  570. {$ELSE}
  571. begin
  572. Result := IsConsole;
  573. end;
  574. {$ENDIF}
  575. function IsDebug: Boolean;
  576. begin
  577. {$IFDEF DEBUG}
  578. Result := True;
  579. {$ELSE}
  580. Result := False;
  581. {$ENDIF DEBUG}
  582. end;
  583. {$IFDEF MSWINDOWS}
  584. function IsService : Boolean;
  585. begin
  586. //only working with my Quick.AppService unit
  587. try
  588. Result := (IsConsole) and (not HasConsoleOutput);
  589. except
  590. Result := False;
  591. end;
  592. end;
  593. function SecondsIdle: DWord;
  594. var
  595. liInfo: TLastInputInfo;
  596. begin
  597. liInfo.cbSize := SizeOf(TLastInputInfo) ;
  598. GetLastInputInfo(liInfo) ;
  599. Result := (GetTickCount - liInfo.dwTime) DIV 1000;
  600. end;
  601. procedure FreeUnusedMem;
  602. begin
  603. if Win32Platform = VER_PLATFORM_WIN32_NT then SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);
  604. end;
  605. function SetScreenResolution(Width, Height: integer): Longint;
  606. var
  607. DeviceMode: TDeviceMode;
  608. begin
  609. with DeviceMode do
  610. begin
  611. dmSize := SizeOf(TDeviceMode);
  612. dmPelsWidth := Width;
  613. dmPelsHeight := Height;
  614. dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
  615. end;
  616. Result := ChangeDisplaySettings(DeviceMode, CDS_UPDATEREGISTRY);
  617. end;
  618. {$ENDIF MSWINDOWS}
  619. function LastDayCurrentMonth: TDateTime;
  620. begin
  621. Result := EncodeDate(YearOf(Now),MonthOf(Now), DaysInMonth(Now));
  622. end;
  623. {$IFDEF FPC}
  624. function DateTimeInRange(ADateTime: TDateTime; AStartDateTime, AEndDateTime: TDateTime; aInclusive: Boolean = True): Boolean;
  625. begin
  626. if aInclusive then
  627. Result := (AStartDateTime <= ADateTime) and (ADateTime <= AEndDateTime)
  628. else
  629. Result := (AStartDateTime < ADateTime) and (ADateTime < AEndDateTime);
  630. end;
  631. {$ENDIF}
  632. function IsSameDay(cBefore, cNow : TDateTime) : Boolean;
  633. begin
  634. //Test: Result := MinutesBetween(cBefore,cNow) < 1;
  635. Result := DateTimeInRange(cNow,StartOfTheDay(cBefore),EndOfTheDay(cBefore),True);
  636. end;
  637. function ChangeTimeOfADay(aDate : TDateTime; aHour, aMinute, aSecond : Word; aMilliSecond : Word = 0) : TDateTime;
  638. var
  639. y, m, d : Word;
  640. begin
  641. DecodeDate(aDate,y,m,d);
  642. Result := EncodeDateTime(y,m,d,aHour,aMinute,aSecond,aMilliSecond);
  643. end;
  644. function ChangeDateOfADay(aDate : TDateTime; aYear, aMonth, aDay : Word) : TDateTime;
  645. var
  646. h, m, s, ms : Word;
  647. begin
  648. DecodeTime(aDate,h,m,s,ms);
  649. Result := EncodeDateTime(aYear,aMonth,aDay,h,m,s,0);
  650. end;
  651. function FillStr(const C : Char; const Count : Integer) : string;
  652. var
  653. i : Integer;
  654. begin
  655. Result := '';
  656. for i := 1 to Count do Result := Result + C;
  657. end;
  658. function StrInArray(const aValue : string; const aInArray : array of string) : Boolean;
  659. var
  660. s : string;
  661. begin
  662. for s in aInArray do
  663. begin
  664. if s = aValue then Exit(True);
  665. end;
  666. Result := False;
  667. end;
  668. function IntInArray(const aValue : Integer; const aInArray : array of Integer) : Boolean;
  669. var
  670. i : Integer;
  671. begin
  672. for i in aInArray do
  673. begin
  674. if i = aValue then Exit(True);
  675. end;
  676. Result := False;
  677. end;
  678. function IsEmptyArray(aArray : TArray<string>) : Boolean;
  679. begin
  680. Result := Length(aArray) = 0;
  681. end;
  682. function IsEmptyArray(aArray : TArray<Integer>) : Boolean;
  683. begin
  684. Result := Length(aArray) = 0;
  685. end;
  686. function Zeroes(const Number, Len : Int64) : string;
  687. begin
  688. if Len > Length(IntToStr(Number)) then Result := FillStr('0',Len - Length(IntToStr(Number))) + IntToStr(Number)
  689. else Result := IntToStr(Number);
  690. end;
  691. function NumberToStr(const Number : Int64) : string;
  692. begin
  693. try
  694. Result := FormatFloat('0,',Number);
  695. except
  696. Result := '#Error';
  697. end;
  698. end;
  699. function Spaces(const Count : Integer) : string;
  700. begin
  701. Result := FillStr(' ',Count);
  702. end;
  703. function NowStr : string;
  704. begin
  705. Result := DateTimeToStr(Now());
  706. end;
  707. function NewGuidStr : string;
  708. var
  709. guid : TGUID;
  710. begin
  711. guid.NewGuid;
  712. Result := guid.ToString
  713. //GUIDToString(guid);
  714. end;
  715. function IsLike(cText, Pattern: string) : Boolean;
  716. var
  717. i, n : Integer;
  718. match : Boolean;
  719. wildcard : Boolean;
  720. CurrentPattern : Char;
  721. begin
  722. Result := False;
  723. wildcard := False;
  724. cText := LowerCase(cText);
  725. Pattern := LowerCase(Pattern);
  726. match := False;
  727. if (Pattern.Length > cText.Length) or (Pattern = '') then Exit;
  728. if Pattern = '*' then
  729. begin
  730. Result := True;
  731. Exit;
  732. end;
  733. for i := 1 to cText.Length do
  734. begin
  735. CurrentPattern := Pattern[i];
  736. if CurrentPattern = '*' then wildcard := True;
  737. if wildcard then
  738. begin
  739. n := Pos(Copy(Pattern,i+1,Pattern.Length),cText);
  740. if (n > i) or (Pattern.Length = i) then
  741. begin
  742. Result := True;
  743. Exit;
  744. end;
  745. end
  746. else
  747. begin
  748. if (cText[i] = CurrentPattern) or (CurrentPattern = '?') then match := True
  749. else match := False;
  750. end;
  751. end;
  752. Result := match;
  753. end;
  754. function Capitalize(s: string): string;
  755. begin
  756. Result := '';
  757. if s.Length = 0 then Exit;
  758. s := LowerCase(s,loUserLocale);
  759. Result := UpperCase(s[1],loUserLocale) + Trim(Copy(s, 2, s.Length));
  760. end;
  761. function CapitalizeWords(s: string): string;
  762. var
  763. cword : string;
  764. begin
  765. Result := '';
  766. if s.Length = 0 then Exit;
  767. s := LowerCase(s,loUserLocale);
  768. for cword in s.Split([' ']) do
  769. begin
  770. if Result = '' then Result := Capitalize(cword)
  771. else Result := Result + ' ' + Capitalize(cword);
  772. end;
  773. end;
  774. function GetLoggedUserName : string;
  775. {$IFDEF MSWINDOWS}
  776. const
  777. cnMaxUserNameLen = 254;
  778. var
  779. sUserName : string;
  780. dwUserNameLen : DWord;
  781. begin
  782. dwUserNameLen := cnMaxUserNameLen-1;
  783. SetLength( sUserName, cnMaxUserNameLen );
  784. GetUserName(PChar( sUserName ),dwUserNameLen );
  785. SetLength( sUserName, dwUserNameLen );
  786. Result := sUserName;
  787. end;
  788. {$ELSE}
  789. {$IF DEFINED(FPC) AND DEFINED(LINUX)}
  790. begin
  791. Result := GetEnvironmentVariable('USERNAME');
  792. end;
  793. {$ELSE}
  794. var
  795. {$IFNDEF NEXTGEN}
  796. plogin : PAnsiChar;
  797. {$ELSE}
  798. plogin : MarshaledAString;
  799. {$ENDIF}
  800. begin
  801. {$IFDEF POSIX}
  802. try
  803. plogin := getlogin;
  804. Result := Copy(plogin,1,Length(Trim(plogin)));
  805. except
  806. Result := 'N/A';
  807. end;
  808. {$ELSE}
  809. Result := 'N/A';
  810. {$ENDIF}
  811. //raise ENotImplemented.Create('Not Android GetLoggedUserName implemented!');
  812. end;
  813. {$ENDIF}
  814. {$ENDIF}
  815. {$IFDEF IOS}
  816. function GetDeviceModel : String;
  817. var
  818. size : size_t;
  819. buffer : array of Byte;
  820. begin
  821. sysctlbyname('hw.machine',nil,@size,nil,0);
  822. if size > 0 then
  823. begin
  824. SetLength(buffer, size);
  825. sysctlbyname('hw.machine',@buffer[0],@size,nil,0);
  826. Result := UTF8ToString(MarshaledAString(buffer));
  827. end
  828. else Result := EmptyStr;
  829. end;
  830. {$ENDIF}
  831. function GetComputerName : string;
  832. {$IFDEF MSWINDOWS}
  833. var
  834. dwLength: dword;
  835. begin
  836. dwLength := 253;
  837. SetLength(Result, dwLength+1);
  838. if not Windows.GetComputerName(pchar(result), dwLength) then Result := 'Not detected!';
  839. Result := pchar(result);
  840. end;
  841. {$ELSE}
  842. {$IF DEFINED(FPC) AND DEFINED(LINUX)}
  843. begin
  844. Result := GetEnvironmentVariable('COMPUTERNAME');
  845. end;
  846. {$ELSE} //Android gets model name
  847. {$IFDEF NEXTGEN}
  848. begin
  849. {$IFDEF ANDROID}
  850. Result := JStringToString(TJBuild.JavaClass.MODEL);
  851. {$ELSE} //IOS
  852. Result := GetDeviceModel;
  853. {$ENDIF}
  854. end;
  855. {$ELSE}
  856. {$IFDEF DELPHILINUX}
  857. var
  858. phost : PAnsiChar;
  859. begin
  860. try
  861. if gethostname(phost,_SC_HOST_NAME_MAX) = 0 then
  862. begin
  863. {$IFDEF DEBUG}
  864. Result := Copy(Trim(phost),1,Length(Trim(phost)));
  865. {$ELSE}
  866. Result := Copy(phost,1,Length(phost));
  867. {$ENDIF}
  868. end
  869. else Result := 'N/A.';
  870. except
  871. Result := 'N/A';
  872. end;
  873. end;
  874. {$ELSE} //OSX
  875. begin
  876. Result := NSStrToStr(TNSHost.Wrap(TNSHost.OCClass.currentHost).localizedName);
  877. end;
  878. {$ENDIF}
  879. {$ENDIF}
  880. {$ENDIF}
  881. {$ENDIF}
  882. function NormalizePathDelim(const cPath : string; const Delim : Char) : string;
  883. begin
  884. if Delim = '\' then Result := StringReplace(cPath,'/',Delim,[rfReplaceAll])
  885. else Result := StringReplace(cPath,'\',Delim,[rfReplaceAll]);
  886. end;
  887. function RemoveLastPathSegment(cDir : string) : string;
  888. var
  889. posi : Integer;
  890. delim : Char;
  891. EndsWithDelim : Boolean;
  892. begin
  893. if cDir.Contains('\') then delim := '\'
  894. else if cDir.Contains('/') then delim := '/'
  895. else
  896. begin
  897. Result := '';
  898. Exit;
  899. end;
  900. NormalizePathDelim(cDir,delim);
  901. if cDir.EndsWith(delim) then
  902. begin
  903. cDir := Copy(cDir,1,cDir.Length-1);
  904. EndsWithDelim := True;
  905. end
  906. else EndsWithDelim := False;
  907. if cDir.CountChar(delim) > 1 then posi := cDir.LastDelimiter(delim)
  908. else posi := Pos(delim,cDir)-1;
  909. if posi = cDir.Length then posi := 0;
  910. Result := Copy(cDir,1,posi);
  911. if (Result <> '') and (EndsWithDelim) then Result := Result + delim;
  912. end;
  913. function GetPathDelimiter(const aPath : string) : string;
  914. begin
  915. if aPath.Contains('/') then Result := '/'
  916. else if aPath.Contains('\') then Result := '\'
  917. else Result := '';
  918. end;
  919. function GetFirstPathSegment(const aPath : string) : string;
  920. var
  921. delimiter : string;
  922. spath : string;
  923. begin
  924. delimiter := GetPathDelimiter(aPath);
  925. if delimiter.IsEmpty then Exit(aPath);
  926. if aPath.StartsWith(delimiter) then spath := Copy(aPath,2,aPath.Length)
  927. else spath := aPath;
  928. Result := Copy(spath,0,spath.IndexOf(delimiter));
  929. end;
  930. function GetLastPathSegment(const aPath : string) : string;
  931. var
  932. delimiter : string;
  933. spath : string;
  934. begin
  935. delimiter := GetPathDelimiter(aPath);
  936. if delimiter.IsEmpty then Exit(aPath);
  937. if aPath.EndsWith(delimiter) then spath := Copy(aPath,0,aPath.Length - 1)
  938. else spath := aPath;
  939. Result := spath.Substring(spath.LastDelimiter(delimiter)+1);
  940. end;
  941. function ParamFindSwitch(const Switch : string) : Boolean;
  942. begin
  943. Result := FindCmdLineSwitch(Switch,['-', '/'],True);
  944. end;
  945. {$IFDEF FPC}
  946. function FindCmdLineSwitch(const Switch: string; var Value: string; IgnoreCase: Boolean = True;
  947. const SwitchTypes: TCmdLineSwitchTypes = [clstValueNextParam, clstValueAppended]): Boolean; overload;
  948. type
  949. TCompareProc = function(const S1, S2: string): Boolean;
  950. var
  951. Param: string;
  952. I, ValueOfs,
  953. SwitchLen, ParamLen: Integer;
  954. SameSwitch: TCompareProc;
  955. begin
  956. Result := False;
  957. Value := '';
  958. if IgnoreCase then
  959. SameSwitch := SameText else
  960. SameSwitch := SameStr;
  961. SwitchLen := Switch.Length;
  962. for I := 1 to ParamCount do
  963. begin
  964. Param := ParamStr(I);
  965. if CharInSet(Param.Chars[0], SwitchChars) and SameSwitch(Param.SubString(1,SwitchLen), Switch) then
  966. begin
  967. ParamLen := Param.Length;
  968. // Look for an appended value if the param is longer than the switch
  969. if (ParamLen > SwitchLen + 1) then
  970. begin
  971. // If not looking for appended value switches then this is not a matching switch
  972. if not (clstValueAppended in SwitchTypes) then
  973. Continue;
  974. ValueOfs := SwitchLen + 1;
  975. if Param.Chars[ValueOfs] = ':' then
  976. Inc(ValueOfs);
  977. Value := Param.SubString(ValueOfs, MaxInt);
  978. end
  979. // If the next param is not a switch, then treat it as the value
  980. else if (clstValueNextParam in SwitchTypes) and (I < ParamCount) and
  981. not CharInSet(ParamStr(I+1).Chars[0], SwitchChars) then
  982. Value := ParamStr(I+1);
  983. Result := True;
  984. Break;
  985. end;
  986. end;
  987. end;
  988. {$ENDIF}
  989. function ParamGetSwitch(const Switch : string; var cvalue : string) : Boolean;
  990. begin
  991. Result := FindCmdLineSwitch(Switch,cvalue,True,[clstValueAppended]);
  992. end;
  993. function GetAppName : string;
  994. begin
  995. Result := ExtractFilenameWithoutExt(ParamStr(0));
  996. end;
  997. function GetAppVersionStr: string;
  998. {$IFDEF MSWINDOWS}
  999. var
  1000. Rec: LongRec;
  1001. ver : Cardinal;
  1002. begin
  1003. ver := GetFileVersion(ParamStr(0));
  1004. if ver <> Cardinal(-1) then
  1005. begin
  1006. Rec := LongRec(ver);
  1007. Result := Format('%d.%d', [Rec.Hi, Rec.Lo]);
  1008. end
  1009. else Result := '';
  1010. end;
  1011. {$ELSE}
  1012. {$IF DEFINED(FPC) AND DEFINED(LINUX)}
  1013. var
  1014. version : TProgramVersion;
  1015. begin
  1016. if GetProgramVersion(version) then Result := Format('%d.%d', [version.Major, version.Minor])
  1017. else Result := '';
  1018. end;
  1019. {$ELSE}
  1020. {$IFDEF NEXTGEN}
  1021. {$IFDEF ANDROID}
  1022. var
  1023. PkgInfo : JPackageInfo;
  1024. begin
  1025. PkgInfo := SharedActivity.getPackageManager.getPackageInfo(SharedActivity.getPackageName,0);
  1026. Result := IntToStr(PkgInfo.VersionCode);
  1027. end;
  1028. {$ELSE} //IOS
  1029. var
  1030. AppKey: Pointer;
  1031. AppBundle: NSBundle;
  1032. BuildStr : NSString;
  1033. begin
  1034. try
  1035. AppKey := (StrToNSStr('CFBundleVersion') as ILocalObject).GetObjectID;
  1036. AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
  1037. BuildStr := TNSString.Wrap(AppBundle.infoDictionary.objectForKey(AppKey));
  1038. Result := UTF8ToString(BuildStr.UTF8String);
  1039. except
  1040. Result := '';
  1041. end;
  1042. end;
  1043. {$ENDIF}
  1044. {$ELSE} //OSX
  1045. {$IFDEF OSX}
  1046. var
  1047. AppKey: Pointer;
  1048. AppBundle: NSBundle;
  1049. BuildStr : NSString;
  1050. begin
  1051. try
  1052. AppKey := (StrToNSStr('CFBundleVersion') as ILocalObject).GetObjectID;
  1053. AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
  1054. BuildStr := TNSString.Wrap(AppBundle.infoDictionary.objectForKey(AppKey));
  1055. Result := UTF8ToString(BuildStr.UTF8String);
  1056. except
  1057. Result := '';
  1058. end;
  1059. end;
  1060. {$ELSE}
  1061. begin
  1062. Result := '';
  1063. end;
  1064. {$ENDIF}
  1065. {$ENDIF}
  1066. {$ENDIF}
  1067. {$ENDIF}
  1068. function GetAppVersionFullStr: string;
  1069. {$IFDEF MSWINDOWS}
  1070. var
  1071. Exe: string;
  1072. Size, Handle: DWORD;
  1073. Buffer: TBytes;
  1074. FixedPtr: PVSFixedFileInfo;
  1075. begin
  1076. Result := '';
  1077. Exe := ParamStr(0);
  1078. Size := GetFileVersionInfoSize(PChar(Exe), Handle);
  1079. if Size = 0 then
  1080. begin
  1081. //RaiseLastOSError;
  1082. //no version info in file
  1083. Exit;
  1084. end;
  1085. SetLength(Buffer, Size);
  1086. if not GetFileVersionInfo(PChar(Exe), Handle, Size, Buffer) then
  1087. RaiseLastOSError;
  1088. if not VerQueryValue(Buffer, '\', Pointer(FixedPtr), Size) then
  1089. RaiseLastOSError;
  1090. if (LongRec(FixedPtr.dwFileVersionLS).Hi = 0) and (LongRec(FixedPtr.dwFileVersionLS).Lo = 0) then
  1091. begin
  1092. Result := Format('%d.%d',
  1093. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  1094. LongRec(FixedPtr.dwFileVersionMS).Lo]); //minor
  1095. end
  1096. else if (LongRec(FixedPtr.dwFileVersionLS).Lo = 0) then
  1097. begin
  1098. Result := Format('%d.%d.%d',
  1099. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  1100. LongRec(FixedPtr.dwFileVersionMS).Lo, //minor
  1101. LongRec(FixedPtr.dwFileVersionLS).Hi]); //release
  1102. end
  1103. else
  1104. begin
  1105. Result := Format('%d.%d.%d.%d',
  1106. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  1107. LongRec(FixedPtr.dwFileVersionMS).Lo, //minor
  1108. LongRec(FixedPtr.dwFileVersionLS).Hi, //release
  1109. LongRec(FixedPtr.dwFileVersionLS).Lo]); //build
  1110. end;
  1111. end;
  1112. {$ELSE}
  1113. {$IF DEFINED(FPC) AND DEFINED(LINUX)}
  1114. var
  1115. version : TProgramVersion;
  1116. begin
  1117. if GetProgramVersion(version) then Result := Format('%d.%d.%d.%d', [version.Major, version.Minor, version.Revision, version.Build])
  1118. else Result := '';
  1119. end;
  1120. {$ELSE}
  1121. {$IFDEF NEXTGEN}
  1122. {$IFDEF ANDROID}
  1123. var
  1124. PkgInfo : JPackageInfo;
  1125. begin
  1126. PkgInfo := SharedActivity.getPackageManager.getPackageInfo(SharedActivity.getPackageName,0);
  1127. Result := JStringToString(PkgInfo.versionName);
  1128. end;
  1129. {$ELSE} //IOS
  1130. var
  1131. AppKey: Pointer;
  1132. AppBundle: NSBundle;
  1133. BuildStr : NSString;
  1134. begin
  1135. AppKey := (StrToNSStr('CFBundleVersion') as ILocalObject).GetObjectID;
  1136. AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
  1137. BuildStr := TNSString.Wrap(AppBundle.infoDictionary.objectForKey(AppKey));
  1138. Result := UTF8ToString(BuildStr.UTF8String);
  1139. end;
  1140. {$ENDIF}
  1141. {$ELSE}
  1142. {$IFDEF OSX}
  1143. var
  1144. AppKey: Pointer;
  1145. AppBundle: NSBundle;
  1146. BuildStr : NSString;
  1147. begin
  1148. AppKey := (StrToNSStr('CFBundleVersion') as ILocalObject).GetObjectID;
  1149. AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
  1150. BuildStr := TNSString.Wrap(AppBundle.infoDictionary.objectForKey(AppKey));
  1151. Result := UTF8ToString(BuildStr.UTF8String);
  1152. end;
  1153. {$ELSE}
  1154. begin
  1155. Result := '';
  1156. end;
  1157. {$ENDIF}
  1158. {$ENDIF}
  1159. {$ENDIF}
  1160. {$ENDIF}
  1161. function UTCToLocalTime(GMTTime: TDateTime): TDateTime;
  1162. begin
  1163. {$IFDEF FPC}
  1164. Result := LocalTimeToUniversal(GMTTime);
  1165. {$ELSE}
  1166. Result := TTimeZone.Local.ToLocalTime(GMTTime);
  1167. {$ENDIF}
  1168. end;
  1169. function LocalTimeToUTC(LocalTime : TDateTime): TDateTime;
  1170. begin
  1171. {$IFDEF FPC}
  1172. Result := UniversalTimeToLocal(Localtime);
  1173. {$ELSE}
  1174. Result := TTimeZone.Local.ToUniversalTime(LocalTime);
  1175. {$ENDIF}
  1176. end;
  1177. function DateTimeToGMT(aDate : TDateTime) : string;
  1178. var
  1179. FmtSettings : TFormatSettings;
  1180. begin
  1181. FmtSettings.DateSeparator := '-';
  1182. FmtSettings.TimeSeparator := ':';
  1183. FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ" GMT"';
  1184. Result := DateTimeToStr(aDate,FmtSettings).Trim;
  1185. end;
  1186. function GMTToDateTime(aDate : string) : TDateTime;
  1187. var
  1188. FmtSettings : TFormatSettings;
  1189. begin
  1190. FmtSettings.DateSeparator := '-';
  1191. FmtSettings.TimeSeparator := ':';
  1192. FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ" GMT"';
  1193. Result := StrToDateTime(aDate,FmtSettings);
  1194. end;
  1195. function DateTimeToJsonDate(aDateTime : TDateTime) : string;
  1196. {$IFNDEF DELPHIXE7_UP}
  1197. var
  1198. FmtSettings : TFormatSettings;
  1199. {$ENDIF}
  1200. begin
  1201. {$IFDEF DELPHIXE7_UP}
  1202. Result := DateToISO8601(aDateTime);
  1203. {$ELSE}
  1204. FmtSettings.DateSeparator := '-';
  1205. FmtSettings.TimeSeparator := ':';
  1206. FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ"Z"';
  1207. Result := DateTimeToStr(aDateTime,FmtSettings).Trim;
  1208. {$ENDIF}
  1209. end;
  1210. function JsonDateToDateTime(const aJsonDate : string) : TDateTime;
  1211. {$IFNDEF DELPHIXE7_UP}
  1212. var
  1213. FmtSettings : TFormatSettings;
  1214. {$ENDIF}
  1215. {$IFDEF FPC}
  1216. var
  1217. jdate : string;
  1218. {$ENDIF}
  1219. begin
  1220. {$IFDEF DELPHIXE7_UP}
  1221. Result := ISO8601ToDate(aJsonDate);
  1222. {$ELSE}
  1223. FmtSettings.DateSeparator := '-';
  1224. FmtSettings.TimeSeparator := ':';
  1225. FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ"Z"';
  1226. {$IFDEF FPC}
  1227. jdate := StringReplace(aJsondate,'T',' ',[rfIgnoreCase]);
  1228. jdate := Copy(jdate,1,Pos('.',jdate)-1);
  1229. Result := StrToDateTime(jdate,FmtSettings);
  1230. {$ELSE}
  1231. Result := StrToDateTime(aJsonDate,FmtSettings);
  1232. {$ENDIF}
  1233. {$ENDIF}
  1234. end;
  1235. function CountDigits(anInt: Cardinal): Cardinal; inline;
  1236. var
  1237. cmp: Cardinal;
  1238. begin
  1239. cmp := 10;
  1240. Result := 1;
  1241. while (Result < 10) and (cmp <= anInt) do
  1242. begin
  1243. cmp := cmp*10;
  1244. Inc(Result);
  1245. end;
  1246. end;
  1247. function CountStr(const aFindStr, aSourceStr : string) : Integer;
  1248. var
  1249. i : Integer;
  1250. found : Integer;
  1251. findstr : string;
  1252. mainstr : string;
  1253. begin
  1254. findstr := aFindStr.ToLower;
  1255. mainstr := aSourceStr.ToLower;
  1256. Result := 0;
  1257. i := 0;
  1258. while i < mainstr.Length do
  1259. begin
  1260. found := Pos(findstr,mainstr,i);
  1261. if found > 0 then
  1262. begin
  1263. i := found;
  1264. Inc(Result);
  1265. end
  1266. else Break;
  1267. end;
  1268. end;
  1269. procedure SaveStreamToFile(aStream : TStream; const aFileName : string);
  1270. var
  1271. fs : TFileStream;
  1272. begin
  1273. fs := TFileStream.Create(aFileName,fmCreate);
  1274. try
  1275. aStream.Seek(0,soBeginning);
  1276. fs.CopyFrom(aStream,aStream.Size);
  1277. finally
  1278. fs.Free;
  1279. end;
  1280. end;
  1281. function StreamToString(aStream : TStream) : string;
  1282. var
  1283. ss : TStringStream;
  1284. begin
  1285. aStream.Position := 0;
  1286. if aStream = nil then Exit;
  1287. if aStream is TMemoryStream then
  1288. begin
  1289. SetString(Result, PChar(TMemoryStream(aStream).Memory), TMemoryStream(aStream).Size div SizeOf(Char));
  1290. end
  1291. else if aStream is TStringStream then
  1292. begin
  1293. Result := TStringStream(aStream).DataString;
  1294. end
  1295. else
  1296. begin
  1297. ss := TStringStream.Create;
  1298. try
  1299. aStream.Seek(0,soBeginning);
  1300. ss.CopyFrom(aStream,aStream.Size);
  1301. Result := ss.DataString;
  1302. finally
  1303. ss.Free;
  1304. end;
  1305. end;
  1306. end;
  1307. function StreamToString2(const aStream: TStream; const aEncoding: TEncoding): string;
  1308. var
  1309. sbytes: TBytes;
  1310. begin
  1311. aStream.Position := 0;
  1312. SetLength(sbytes, aStream.Size);
  1313. aStream.ReadBuffer(sbytes,aStream.Size);
  1314. Result := aEncoding.GetString(sbytes);
  1315. end;
  1316. procedure StringToStream(const aStr : string; aStream : TStream);
  1317. begin
  1318. aStream.Seek(0,soBeginning);
  1319. aStream.WriteBuffer(Pointer(aStr)^,aStr.Length * SizeOf(Char));
  1320. end;
  1321. procedure StringToStream2(const aStr : string; aStream : TStream);
  1322. var
  1323. stream : TStringStream;
  1324. begin
  1325. stream := TStringStream.Create(aStr,TEncoding.UTF8);
  1326. try
  1327. aStream.CopyFrom(stream,stream.Size);
  1328. finally
  1329. stream.Free;
  1330. end;
  1331. end;
  1332. function CommaText(aList : TStringList) : string;
  1333. var
  1334. value : string;
  1335. sb : TStringBuilder;
  1336. begin
  1337. if aList.Text = '' then Exit;
  1338. sb := TStringBuilder.Create;
  1339. try
  1340. for value in aList do
  1341. begin
  1342. sb.Append(value);
  1343. sb.Append(',');
  1344. end;
  1345. if sb.Length > 1 then Result := sb.ToString(0, sb.Length - 1);
  1346. finally
  1347. sb.Free;
  1348. end;
  1349. end;
  1350. function CommaText(aArray : TArray<string>) : string;
  1351. var
  1352. value : string;
  1353. sb : TStringBuilder;
  1354. begin
  1355. if High(aArray) < 0 then Exit;
  1356. sb := TStringBuilder.Create;
  1357. try
  1358. for value in aArray do
  1359. begin
  1360. sb.Append(value);
  1361. sb.Append(',');
  1362. end;
  1363. if sb.Length > 1 then Result := sb.ToString(0, sb.Length - 1);
  1364. finally
  1365. sb.Free;
  1366. end;
  1367. end;
  1368. function ArrayToString(aArray : TArray<string>) : string;
  1369. var
  1370. value : string;
  1371. sb : TStringBuilder;
  1372. begin
  1373. if High(aArray) < 0 then Exit;
  1374. sb := TStringBuilder.Create;
  1375. try
  1376. for value in aArray do
  1377. begin
  1378. sb.Append(value);
  1379. sb.Append(#10#13);
  1380. end;
  1381. finally
  1382. sb.Free;
  1383. end;
  1384. end;
  1385. function StringsToArray(aStrings : TStrings) : TArray<string>;
  1386. var
  1387. i : Integer;
  1388. begin
  1389. if aStrings.Count = 0 then Exit;
  1390. SetLength(Result,aStrings.Count);
  1391. for i := 0 to aStrings.Count - 1 do
  1392. begin
  1393. Result[i] := aStrings[i];
  1394. end;
  1395. end;
  1396. { TCounter }
  1397. procedure TCounter.Init(aMaxValue : Integer);
  1398. begin
  1399. fMaxValue := aMaxValue;
  1400. fCurrentValue := 0;
  1401. end;
  1402. function TCounter.Count : Integer;
  1403. begin
  1404. Result := fCurrentValue;
  1405. end;
  1406. function TCounter.CountIs(aValue : Integer) : Boolean;
  1407. begin
  1408. Result := fCurrentValue = aValue;
  1409. end;
  1410. function TCounter.Check : Boolean;
  1411. begin
  1412. if fCurrentValue = fMaxValue then
  1413. begin
  1414. Result := True;
  1415. Reset;
  1416. end
  1417. else
  1418. begin
  1419. Result := False;
  1420. Inc(fCurrentValue);
  1421. end;
  1422. end;
  1423. procedure TCounter.Reset;
  1424. begin
  1425. fCurrentValue := fMaxValue;
  1426. end;
  1427. { TimeCounter }
  1428. procedure TTimeCounter.Init(MillisecondsToReach : Integer);
  1429. begin
  1430. fDoneEvery := MillisecondsToReach;
  1431. end;
  1432. function TTimeCounter.Check : Boolean;
  1433. begin
  1434. if MilliSecondsBetween(fCurrentTime,Now) > fDoneEvery then
  1435. begin
  1436. fCurrentTime := Now();
  1437. Result := True;
  1438. end
  1439. else Result := False;
  1440. end;
  1441. procedure TTimeCounter.Reset;
  1442. begin
  1443. fCurrentTime := Now();
  1444. end;
  1445. { TArrayOfStringHelper}
  1446. {$IFNDEF FPC}
  1447. function TArrayOfStringHelper.Any : Boolean;
  1448. begin
  1449. Result := High(Self) >= 0;
  1450. end;
  1451. function TArrayOfStringHelper.Any(const aValue : string) : Boolean;
  1452. begin
  1453. Result := Exists(aValue);
  1454. end;
  1455. function TArrayOfStringHelper.Add(const aValue : string) : Integer;
  1456. begin
  1457. SetLength(Self,Length(Self)+1);
  1458. Self[High(Self)] := aValue;
  1459. Result := High(Self);
  1460. end;
  1461. function TArrayOfStringHelper.AddIfNotExists(const aValue : string; aCaseSense : Boolean = False) : Integer;
  1462. var
  1463. i : Integer;
  1464. begin
  1465. for i := Low(Self) to High(Self) do
  1466. begin
  1467. if aCaseSense then
  1468. begin
  1469. if Self[i] = aValue then Exit(i);
  1470. end
  1471. else
  1472. begin
  1473. if CompareText(Self[i],aValue) = 0 then Exit(i)
  1474. end;
  1475. end;
  1476. //if not exists add it
  1477. Result := Self.Add(aValue);
  1478. end;
  1479. function TArrayOfStringHelper.Remove(const aValue : string) : Boolean;
  1480. var
  1481. i : Integer;
  1482. begin
  1483. for i := Low(Self) to High(Self) do
  1484. begin
  1485. if CompareText(Self[i],aValue) = 0 then
  1486. begin
  1487. System.Delete(Self,i,1);
  1488. Exit(True);
  1489. end;
  1490. end;
  1491. Result := False;
  1492. end;
  1493. function TArrayOfStringHelper.Exists(const aValue : string) : Boolean;
  1494. var
  1495. value : string;
  1496. begin
  1497. Result := False;
  1498. for value in Self do
  1499. begin
  1500. if CompareText(value,aValue) = 0 then Exit(True)
  1501. end;
  1502. end;
  1503. function TArrayOfStringHelper.Count : Integer;
  1504. begin
  1505. Result := High(Self) + 1;
  1506. end;
  1507. {$ENDIF}
  1508. { TPairItem }
  1509. constructor TPairItem.Create(const aName, aValue: string);
  1510. begin
  1511. Name := aName;
  1512. Value := aValue;
  1513. end;
  1514. { TPairList }
  1515. function TPairList.GetEnumerator : TPairEnumerator;
  1516. begin
  1517. Result := TPairEnumerator.Create(fItems);
  1518. end;
  1519. function TPairList.Add(aPair: TPairItem): Integer;
  1520. begin
  1521. SetLength(fItems,Length(fItems)+1);
  1522. fItems[High(fItems)] := aPair;
  1523. Result := High(fItems);
  1524. end;
  1525. function TPairList.Add(const aName, aValue: string): Integer;
  1526. begin
  1527. SetLength(fItems,Length(fItems)+1);
  1528. fItems[High(fItems)].Name := aName;
  1529. fItems[High(fItems)].Value := aValue;
  1530. Result := High(fItems);
  1531. end;
  1532. procedure TPairList.AddOrUpdate(const aName, aValue: string);
  1533. var
  1534. i : Integer;
  1535. begin
  1536. for i := Low(fItems) to High(fItems) do
  1537. begin
  1538. if CompareText(fItems[i].Name,aName) = 0 then
  1539. begin
  1540. fItems[i].Value := aValue;
  1541. Exit;
  1542. end;
  1543. end;
  1544. //if not exists add it
  1545. Self.Add(aName,aValue);
  1546. end;
  1547. function TPairList.Count: Integer;
  1548. begin
  1549. Result := High(fItems) + 1;
  1550. end;
  1551. function TPairList.Exists(const aName: string): Boolean;
  1552. var
  1553. i : Integer;
  1554. begin
  1555. Result := False;
  1556. for i := Low(fItems) to High(fItems) do
  1557. begin
  1558. if CompareText(fItems[i].Name,aName) = 0 then Exit(True)
  1559. end;
  1560. end;
  1561. function TPairList.GetPair(const aName: string): TPairItem;
  1562. var
  1563. i : Integer;
  1564. begin
  1565. for i := Low(fItems) to High(fItems) do
  1566. begin
  1567. if CompareText(fItems[i].Name,aName) = 0 then Exit(fItems[i]);
  1568. end;
  1569. end;
  1570. function TPairList.GetValue(const aName: string): string;
  1571. var
  1572. i : Integer;
  1573. begin
  1574. Result := '';
  1575. for i := Low(fItems) to High(fItems) do
  1576. begin
  1577. if CompareText(fItems[i].Name,aName) = 0 then Exit(fItems[i].Value);
  1578. end;
  1579. end;
  1580. function TPairList.Remove(const aName: string): Boolean;
  1581. var
  1582. i : Integer;
  1583. begin
  1584. for i := Low(fItems) to High(fItems) do
  1585. begin
  1586. if CompareText(fItems[i].Name,aName) = 0 then
  1587. begin
  1588. System.Delete(fItems,i,1);
  1589. Exit(True);
  1590. end;
  1591. end;
  1592. Result := False;
  1593. end;
  1594. function TPairList.ToArray : TArray<TPairItem>;
  1595. begin
  1596. Result := fItems;
  1597. end;
  1598. procedure TPairList.FromArray(aValue : TArray<TPairItem>);
  1599. begin
  1600. fItems := aValue;
  1601. end;
  1602. { TPairList.TPairEnumerator}
  1603. constructor TPairList.TPairEnumerator.Create(var aArray: TArray<TPairItem>);
  1604. begin
  1605. fIndex := -1;
  1606. fArray := @aArray;
  1607. end;
  1608. function TPairList.TPairEnumerator.GetCurrent : TPairItem;
  1609. begin
  1610. Result := TArray<TPairItem>(fArray^)[fIndex];
  1611. end;
  1612. function TPairList.TPairEnumerator.MoveNext: Boolean;
  1613. begin
  1614. Inc(fIndex);
  1615. Result := fIndex < High(TArray<TPairItem>(fArray^))+1;
  1616. end;
  1617. {$IFDEF MSWINDOWS}
  1618. procedure ProcessMessages;
  1619. var
  1620. Msg: TMsg;
  1621. begin
  1622. while integer(PeekMessage(Msg, 0, 0, 0, PM_REMOVE)) <> 0 do
  1623. begin
  1624. TranslateMessage(Msg);
  1625. DispatchMessage(Msg);
  1626. end;
  1627. end;
  1628. function GetLastOSError: String;
  1629. begin
  1630. Result := SysErrorMessage(Windows.GetLastError);
  1631. end;
  1632. {$ENDIF}
  1633. function RemoveLastChar(const aText : string) : string;
  1634. begin
  1635. Result := aText.Remove(aText.Length - 1);
  1636. end;
  1637. function DateTimeToSQL(aDateTime : TDateTime) : string;
  1638. begin
  1639. Result := FormatDateTime('YYYYMMDD hh:mm:ss',aDateTime);
  1640. end;
  1641. function IsInteger(const aValue : string) : Boolean;
  1642. var
  1643. i : Integer;
  1644. begin
  1645. Result := TryStrToInt(aValue,i);
  1646. end;
  1647. function ExtractStr(var vSource : string; aIndex : Integer; aCount : Integer) : string;
  1648. begin
  1649. if aIndex > vSource.Length then Exit('');
  1650. Result := Copy(vSource,aIndex,aCount);
  1651. Delete(vSource,aIndex,aCount);
  1652. end;
  1653. function GetSubString(const aSource, aFirstDelimiter, aLastDelimiter : string) : string;
  1654. var
  1655. i : Integer;
  1656. begin
  1657. i := Pos(aFirstDelimiter,aSource);
  1658. if i > -1 then Result := Copy(aSource, i + aFirstDelimiter.Length, Pos(aLastDelimiter, aSource, i + aFirstDelimiter.Length) - i - aFirstDelimiter.Length)
  1659. else Result := '';
  1660. end;
  1661. function DbQuotedStr(const str : string): string;
  1662. var
  1663. i : Integer;
  1664. begin
  1665. Result := str;
  1666. for i := Result.Length - 1 downto 0 do
  1667. begin
  1668. if Result.Chars[i] = '"' then Result := Result.Insert(i, '"');
  1669. end;
  1670. Result := '"' + Result + '"';
  1671. end;
  1672. function UnDbQuotedStr(const str: string) : string;
  1673. begin
  1674. Result := Trim(str);
  1675. if not Result.IsEmpty then
  1676. begin
  1677. if Result.StartsWith('"') then Result := Copy(Result, 2, Result.Length - 2);
  1678. end;
  1679. end;
  1680. function SpQuotedStr(const str : string): string;
  1681. begin
  1682. Result := '''' + str + '''';
  1683. end;
  1684. function UnSpQuotedStr(const str: string) : string;
  1685. begin
  1686. Result := Trim(str);
  1687. if not Result.IsEmpty then
  1688. begin
  1689. if Result.StartsWith('''') then Result := Copy(Result, 2, Result.Length - 2);
  1690. end;
  1691. end;
  1692. function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : string) : string;
  1693. begin
  1694. if aCondition then Result := aIfIsTrue else Result := aIfIsFalse;
  1695. end;
  1696. function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : Integer) : Integer;
  1697. begin
  1698. if aCondition then Result := aIfIsTrue else Result := aIfIsFalse;
  1699. end;
  1700. function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : Extended) : Extended;
  1701. begin
  1702. if aCondition then Result := aIfIsTrue else Result := aIfIsFalse;
  1703. end;
  1704. function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : TObject) : TObject;
  1705. begin
  1706. if aCondition then Result := aIfIsTrue else Result := aIfIsFalse;
  1707. end;
  1708. {$IFNDEF NEXTGEN}
  1709. initialization
  1710. try
  1711. GetEnvironmentPaths;
  1712. except
  1713. {$IFDEF SHOW_ENVIRONMENTPATH_ERRORS}
  1714. on E : Exception do
  1715. begin
  1716. if not IsService then
  1717. begin
  1718. if HasConsoleOutput then Writeln(Format('[WARN] GetEnvironmentPaths: %s',[E.Message]))
  1719. else MessageBox(0,PWideChar(Format('Get environment path error: %s',[E.Message])),'GetEnvironmentPaths',MB_ICONEXCLAMATION);
  1720. end;
  1721. end;
  1722. {$ENDIF}
  1723. end;
  1724. {$ENDIF}
  1725. end.