Quick.Commons.pas 50 KB

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