Quick.Commons.pas 51 KB

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