Quick.Commons.pas 49 KB

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