Quick.Commons.pas 50 KB

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