Quick.Commons.pas 48 KB

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