Quick.Commons.pas 61 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391
  1. { ***************************************************************************
  2. Copyright (c) 2016-2022 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 : 19/01/2022
  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. ActiveX,
  31. ShlObj,
  32. {$ENDIF MSWINDOWS}
  33. {$IFDEF FPC}
  34. Quick.Files,
  35. {$IFDEF LINUX}
  36. FileInfo,
  37. {$ENDIF}
  38. {$ELSE}
  39. IOUtils,
  40. {$ENDIF}
  41. {$IFDEF ANDROID}
  42. Androidapi.JNI.Os,
  43. Androidapi.Helpers,
  44. Androidapi.JNI.JavaTypes,
  45. Androidapi.JNI.GraphicsContentViewText,
  46. {$IFDEF DELPHIRX103_UP}
  47. Androidapi.JNI.App,
  48. {$ENDIF}
  49. {$ENDIF}
  50. {$IFDEF IOS}
  51. iOSapi.UIKit,
  52. Posix.SysSysctl,
  53. Posix.StdDef,
  54. iOSapi.Foundation,
  55. Macapi.ObjectiveC,
  56. Macapi.Helpers,
  57. {$ENDIF}
  58. {$IFDEF OSX}
  59. Macapi.Foundation,
  60. Macapi.Helpers,
  61. FMX.Helpers.Mac,
  62. Macapi.ObjectiveC,
  63. {$ENDIF}
  64. {$IFDEF POSIX}
  65. Posix.Unistd,
  66. {$ENDIF}
  67. DateUtils;
  68. type
  69. TLogEventType = (etInfo, etSuccess, etWarning, etError, etDebug, etDone, etTrace, etCritical, etException);
  70. TLogVerbose = set of TLogEventType;
  71. const
  72. LOG_ONLYERRORS = [etInfo,etError];
  73. LOG_ERRORSANDWARNINGS = [etInfo,etWarning,etError];
  74. LOG_TRACE = [etInfo,etError,etWarning,etTrace];
  75. LOG_ALL = [etInfo, etSuccess, etWarning, etError, etDebug, etDone, etTrace, etCritical, etException];
  76. LOG_DEBUG = [etInfo,etSuccess,etWarning,etError,etDebug];
  77. {$IFDEF DELPHIXE7_UP}
  78. EventStr : array of string = ['INFO','SUCC','WARN','ERROR','DEBUG','DONE','TRACE','CRITICAL','EXCEPTION'];
  79. {$ELSE}
  80. EventStr : array[0..8] of string = ('INFO','SUCC','WARN','ERROR','DEBUG','DONE','TRACE','CRITICAL','EXCEPTION');
  81. {$ENDIF}
  82. CRLF = #13#10;
  83. type
  84. TPasswordComplexity = set of (pfIncludeNumbers,pfIncludeSigns);
  85. TEnvironmentPath = record
  86. EXEPATH : string;
  87. {$IFDEF MSWINDOWS}
  88. WINDOWS : string;
  89. SYSTEM : string;
  90. PROGRAMFILES : string;
  91. COMMONFILES : string;
  92. HOMEDRIVE : string;
  93. TEMP : string;
  94. USERPROFILE : string;
  95. INSTDRIVE : string;
  96. DESKTOP : string;
  97. STARTMENU : string;
  98. DESKTOP_ALLUSERS : string;
  99. STARTMENU_ALLUSERS : string;
  100. STARTUP : string;
  101. APPDATA : String;
  102. PROGRAMDATA : string;
  103. ALLUSERSPROFILE : string;
  104. {$ENDIF MSWINDOWS}
  105. end;
  106. {$IFNDEF FPC}
  107. TFileHelper = record helper for TFile
  108. {$IF DEFINED(MSWINDOWS) OR DEFINED(DELPHILINUX)}
  109. class function IsInUse(const FileName : string) : Boolean; static;
  110. {$ENDIF}
  111. class function GetSize(const FileName: String): Int64; static;
  112. end;
  113. TDirectoryHelper = record helper for TDirectory
  114. class function GetSize(const Path: String): Int64; static;
  115. end;
  116. {$ENDIF}
  117. {$IFDEF FPC}
  118. {$IFDEF LINUX}
  119. UINT = cardinal;
  120. {$ENDIF}
  121. PLASTINPUTINFO = ^LASTINPUTINFO;
  122. tagLASTINPUTINFO = record
  123. cbSize: UINT;
  124. dwTime: DWORD;
  125. end;
  126. LASTINPUTINFO = tagLASTINPUTINFO;
  127. TLastInputInfo = LASTINPUTINFO;
  128. type
  129. TCmdLineSwitchType = (clstValueNextParam, clstValueAppended);
  130. TCmdLineSwitchTypes = set of TCmdLineSwitchType;
  131. {$ENDIF}
  132. TCounter = record
  133. private
  134. fMaxValue : Integer;
  135. fCurrentValue : Integer;
  136. public
  137. property MaxValue : Integer read fMaxValue;
  138. procedure Init(aMaxValue : Integer);
  139. function Count : Integer;
  140. function CountIs(aValue : Integer) : Boolean;
  141. function Check : Boolean;
  142. procedure Reset;
  143. end;
  144. TTimeCounter = record
  145. private
  146. fCurrentTime : TDateTime;
  147. fDoneEvery : Integer;
  148. public
  149. property DoneEvery : Integer read fDoneEvery;
  150. procedure Init(MillisecondsToReach : Integer);
  151. function Check : Boolean;
  152. procedure Reset;
  153. end;
  154. {$IFNDEF FPC}
  155. {$IFNDEF DELPHIXE7_UP}
  156. TArrayUtil<T> = class
  157. class procedure Delete(var aArray : TArray<T>; aIndex : Integer);
  158. end;
  159. {$ENDIF}
  160. TArrayOfStringHelper = record helper for TArray<string>
  161. public
  162. function Any : Boolean; overload;
  163. function Any(const aValue : string) : Boolean; overload;
  164. function Add(const aValue : string) : Integer;
  165. function AddIfNotExists(const aValue : string; aCaseSense : Boolean = False) : Integer;
  166. function Remove(const aValue : string) : Boolean;
  167. function Exists(const aValue : string) : Boolean;
  168. function Count : Integer;
  169. end;
  170. TDelegate<T> = reference to procedure(Value : T);
  171. {$ENDIF}
  172. TPairItem = record
  173. Name : string;
  174. Value : string;
  175. constructor Create(const aName, aValue : string);
  176. end;
  177. TPairList = class
  178. type
  179. TPairEnumerator = class
  180. private
  181. fArray : ^TArray<TPairItem>;
  182. fIndex : Integer;
  183. function GetCurrent: TPairItem;
  184. public
  185. constructor Create(var aArray: TArray<TPairItem>);
  186. property Current : TPairItem read GetCurrent;
  187. function MoveNext: Boolean;
  188. end;
  189. private
  190. fItems : TArray<TPairItem>;
  191. public
  192. function GetEnumerator : TPairEnumerator;
  193. function GetValue(const aName : string) : string;
  194. function GetPair(const aName : string) : TPairItem;
  195. function Add(aPair : TPairItem) : Integer; overload;
  196. function Add(const aName, aValue : string) : Integer; overload;
  197. procedure AddOrUpdate(const aName, aValue : string);
  198. function Exists(const aName : string) : Boolean;
  199. function Remove(const aName : string) : Boolean;
  200. function Count : Integer;
  201. property Items[const aName : string] : string read GetValue write AddOrUpdate;
  202. function ToArray : TArray<TPairItem>;
  203. procedure FromArray(aValue : TArray<TPairItem>);
  204. procedure Clear;
  205. end;
  206. {$IFDEF DELPHIXE7_UP}
  207. TDateTimeHelper = record helper for TDateTime
  208. public
  209. function ToSQLString : string;
  210. procedure FromNow;
  211. procedure FromUTC(const aUTCTime : TDateTime);
  212. function IncDay(const aValue : Cardinal = 1) : TDateTime;
  213. function DecDay(const aValue : Cardinal = 1) : TDateTime;
  214. function IncMonth(const aValue : Cardinal = 1) : TDateTime;
  215. function DecMonth(const aValue : Cardinal = 1) : TDateTime;
  216. function IncYear(const aValue : Cardinal = 1) : TDateTime;
  217. function DecYear(const aValue : Cardinal = 1) : TDateTime;
  218. function IsEqualTo(const aDateTime : TDateTime) : Boolean;
  219. function IsAfter(const aDateTime : TDateTime) : Boolean;
  220. function IsBefore(const aDateTime : TDateTime) : Boolean;
  221. function IsSameDay(const aDateTime : TDateTime) : Boolean;
  222. function IsSameTime(const aTime : TTime) : Boolean;
  223. function DayOfTheWeek : Word;
  224. function ToJsonFormat : string;
  225. function ToGMTFormat: string;
  226. function ToTimeStamp : TTimeStamp;
  227. function ToUTC : TDateTime;
  228. function ToMilliseconds : Int64;
  229. function ToString : string;
  230. function Date : TDate;
  231. function Time : TTime;
  232. function IsAM : Boolean;
  233. function IsPM : Boolean;
  234. end;
  235. TDateHelper = record helper for TDate
  236. public
  237. function ToString : string;
  238. end;
  239. TTimeHelper = record helper for TTime
  240. public
  241. function ToString : string;
  242. end;
  243. {$ENDIF}
  244. EEnvironmentPath = class(Exception);
  245. EShellError = class(Exception);
  246. //generates a random password with complexity options
  247. function RandomPassword(const PasswordLength : Integer; Complexity : TPasswordComplexity = [pfIncludeNumbers,pfIncludeSigns]) : string;
  248. //generates a random string
  249. function RandomString(const aLength: Integer) : string;
  250. //extracts file extension from a filename
  251. function ExtractFileNameWithoutExt(const FileName: string): string;
  252. //converts a Unix path to Windows path
  253. function UnixToWindowsPath(const UnixPath: string): string;
  254. //converts a Windows path to Unix path
  255. function WindowsToUnixPath(const WindowsPath: string): string;
  256. //corrects malformed urls
  257. function CorrectURLPath(const cUrl : string) : string;
  258. //get url parts
  259. function UrlGetProtocol(const aUrl : string) : string;
  260. function UrlGetHost(const aUrl : string) : string;
  261. function UrlGetPath(const aUrl : string) : string;
  262. function UrlGetQuery(const aUrl : string) : string;
  263. function UrlRemoveProtocol(const aUrl : string) : string;
  264. function UrlRemoveQuery(const aUrl : string) : string;
  265. function UrlSimpleEncode(const aUrl : string) : string;
  266. //get typical environment paths as temp, desktop, etc
  267. procedure GetEnvironmentPaths;
  268. {$IFDEF MSWINDOWS}
  269. function GetSpecialFolderPath(folderID : Integer) : string;
  270. //checks if running on a 64bit OS
  271. function Is64bitOS : Boolean;
  272. //checks if is a console app
  273. function IsConsole : Boolean;
  274. function HasConsoleOutput : Boolean;
  275. //checks if compiled in debug mode
  276. {$ENDIF}
  277. function IsDebug : Boolean;
  278. {$IFDEF MSWINDOWS}
  279. //checks if running as a service
  280. function IsService : Boolean;
  281. //gets number of seconds without user interaction (mouse, keyboard)
  282. function SecondsIdle: DWord;
  283. //frees process memory not needed
  284. procedure FreeUnusedMem;
  285. //changes screen resolution
  286. function SetScreenResolution(Width, Height: integer): Longint;
  287. {$ENDIF MSWINDOWS}
  288. //returns last day of current month
  289. function LastDayCurrentMonth: TDateTime;
  290. {$IFDEF FPC}
  291. function DateTimeInRange(ADateTime: TDateTime; AStartDateTime, AEndDateTime: TDateTime; aInclusive: Boolean = True): Boolean;
  292. {$ENDIF}
  293. //checks if two datetimes are in same day
  294. function IsSameDay(cBefore, cNow : TDateTime) : Boolean;
  295. //change Time of a DateTime
  296. function ChangeTimeOfADay(aDate : TDateTime; aHour, aMinute, aSecond : Word; aMilliSecond : Word = 0) : TDateTime;
  297. //change Date of a DateTime
  298. function ChangeDateOfADay(aDate : TDateTime; aYear, aMonth, aDay : Word) : TDateTime;
  299. //returns n times a char
  300. function FillStr(const C : Char; const Count : Integer) : string;
  301. function FillStrEx(const value : string; const Count : Integer) : string;
  302. //checks if string exists in array of string
  303. function StrInArray(const aValue : string; const aInArray : array of string; aCaseSensitive : Boolean = True) : Boolean;
  304. //checks if integer exists in array of integer
  305. function IntInArray(const aValue : Integer; const aInArray : array of Integer) : Boolean;
  306. //check if array is empty
  307. function IsEmptyArray(aArray : TArray<string>) : Boolean; overload;
  308. function IsEmptyArray(aArray : TArray<Integer>) : Boolean; overload;
  309. //returns a number leading zero
  310. function Zeroes(const Number, Len : Int64) : string;
  311. //converts a number to thousand delimeter string
  312. function NumberToStr(const Number : Int64) : string;
  313. //returns n spaces
  314. function Spaces(const Count : Integer) : string;
  315. //returns current date as a string
  316. function NowStr : string;
  317. //returns a new GUID as string
  318. function NewGuidStr : string;
  319. //compare a string with a wildcard pattern (? or *)
  320. function IsLike(cText, Pattern: string) : Boolean;
  321. //Upper case for first letter
  322. function Capitalize(s: string): string;
  323. function CapitalizeWords(s: string): string;
  324. //returns current logged user
  325. function GetLoggedUserName : string;
  326. //returns computer name
  327. function GetComputerName : string;
  328. //check if remote desktop session
  329. {$IFDEF MSWINDOWS}
  330. function IsRemoteSession : Boolean;
  331. {$ENDIF}
  332. //extract domain and user name from user login
  333. function ExtractDomainAndUser(const aUser : string; out oDomain, oUser : string) : Boolean;
  334. //Changes incorrect delims in path
  335. function NormalizePathDelim(const cPath : string; const Delim : Char) : string;
  336. //combine paths normalized with delim
  337. function CombinePaths(const aFirstPath, aSecondPath: string; aDelim : Char): string;
  338. //Removes firs segment of a path
  339. function RemoveFirstPathSegment(const cdir : string) : string;
  340. //Removes last segment of a path
  341. function RemoveLastPathSegment(const cDir : string) : string;
  342. //returns path delimiter if found
  343. function GetPathDelimiter(const aPath : string) : string;
  344. //returns first segment of a path
  345. function GetFirstPathSegment(const aPath : string) : string;
  346. //returns last segment of a path
  347. function GetLastPathSegment(const aPath : string) : string;
  348. //finds swith in commandline params
  349. function ParamFindSwitch(const Switch : string) : Boolean;
  350. //gets value for a switch if exists
  351. function ParamGetSwitch(const Switch : string; var cvalue : string) : Boolean;
  352. //returns app name (filename based)
  353. function GetAppName : string;
  354. //returns app version (major & minor)
  355. function GetAppVersionStr: string;
  356. //returns app version full (major, minor, release & compiled)
  357. function GetAppVersionFullStr: string;
  358. //convert UTC DateTime to Local DateTime
  359. function UTCToLocalTime(GMTTime: TDateTime): TDateTime;
  360. //convert Local DateTime to UTC DateTime
  361. function LocalTimeToUTC(LocalTime : TDateTime): TDateTime;
  362. //convert DateTime to GTM Time string
  363. function DateTimeToGMT(aDate : TDateTime) : string;
  364. //convert GMT Time string to DateTime
  365. function GMTToDateTime(aDate : string) : TDateTime;
  366. //convert DateTime to Json Date format
  367. function DateTimeToJsonDate(aDateTime : TDateTime) : string;
  368. //convert Json Date format to DateTime
  369. function JsonDateToDateTime(const aJsonDate : string) : TDateTime;
  370. //count number of digits of a Integer
  371. function CountDigits(anInt: Cardinal): Cardinal; inline;
  372. //count times a string is present in other string
  373. function CountStr(const aFindStr, aSourceStr : string) : Integer;
  374. //save stream to file
  375. procedure SaveStreamToFile(aStream : TStream; const aFilename : string);
  376. //save stream to string
  377. function StreamToString(const aStream: TStream; const aEncoding: TEncoding): string;
  378. function StreamToStringEx(aStream : TStream) : string;
  379. //save string to stream
  380. procedure StringToStream(const aStr : string; aStream : TStream; const aEncoding: TEncoding);
  381. procedure StringToStreamEx(const aStr : string; aStream : TStream);
  382. //returns a real comma separated text from stringlist
  383. function CommaText(aList : TStringList) : string; overload;
  384. //returns a real comma separated text from array of string
  385. function CommaText(aArray : TArray<string>) : string; overload;
  386. //returns a string CRLF separated from array of string
  387. function ArrayToString(aArray : TArray<string>) : string; overload;
  388. //returns a string with separator from array of string
  389. function ArrayToString(aArray : TArray<string>; aSeparator : string) : string; overload;
  390. //converts TStrings to array
  391. function StringsToArray(aStrings : TStrings) : TArray<string>; overload;
  392. //converts string comma or semicolon separated to array
  393. function StringsToArray(const aString : string) : TArray<string>; overload;
  394. {$IFDEF MSWINDOWS}
  395. //process messages on console applications
  396. procedure ProcessMessages;
  397. //get last error message
  398. function GetLastOSError : String;
  399. {$ENDIF}
  400. {$IF DEFINED(FPC) AND DEFINED(MSWINDOWS)}
  401. function GetLastInputInfo(var plii: TLastInputInfo): BOOL;stdcall; external 'user32' name 'GetLastInputInfo';
  402. {$ENDIF}
  403. function RemoveLastChar(const aText : string) : string;
  404. function DateTimeToSQL(aDateTime : TDateTime) : string;
  405. function IsInteger(const aValue : string) : Boolean;
  406. function IsFloat(const aValue : string) : Boolean;
  407. function IsBoolean(const aValue : string) : Boolean;
  408. //extract a substring and deletes from source string
  409. function ExtractStr(var vSource : string; aIndex : Integer; aCount : Integer) : string;
  410. //get first string between string delimiters
  411. function GetSubString(const aSource, aFirstDelimiter, aLastDelimiter : string) : string;
  412. //get double quoted or dequoted string
  413. function DbQuotedStr(const str : string): string;
  414. function UnDbQuotedStr(const str: string) : string;
  415. //get simple quoted or dequoted string
  416. function SpQuotedStr(const str : string): string;
  417. function UnSpQuotedStr(const str : string): string;
  418. function UnQuotedStr(const str : string; const aQuote : Char) : string;
  419. //ternary operator
  420. function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : string) : string; overload;
  421. function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : Integer) : Integer; overload;
  422. function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : Extended) : Extended; overload;
  423. function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : TObject) : TObject; overload;
  424. var
  425. path : TEnvironmentPath;
  426. //Enabled if QuickService is defined
  427. IsQuickServiceApp : Boolean;
  428. implementation
  429. {TFileHelper}
  430. {$IFNDEF FPC}
  431. {$IFDEF MSWINDOWS}
  432. class function TFileHelper.IsInUse(const FileName : string) : Boolean;
  433. var
  434. HFileRes: HFILE;
  435. begin
  436. Result := False;
  437. if not FileExists(FileName) then Exit;
  438. try
  439. HFileRes := CreateFile(PChar(FileName)
  440. ,GENERIC_READ or GENERIC_WRITE
  441. ,0
  442. ,nil
  443. ,OPEN_EXISTING
  444. ,FILE_ATTRIBUTE_NORMAL
  445. ,0);
  446. Result := (HFileRes = INVALID_HANDLE_VALUE);
  447. if not(Result) then begin
  448. CloseHandle(HFileRes);
  449. end;
  450. except
  451. Result := True;
  452. end;
  453. end;
  454. {$ENDIF}
  455. {$IFDEF DELPHILINUX}
  456. class function TFileHelper.IsInUse(const FileName : string) : Boolean;
  457. var
  458. fs : TFileStream;
  459. begin
  460. try
  461. fs := TFileStream.Create(FileName, fmOpenReadWrite, fmShareExclusive);
  462. Result := True;
  463. fs.Free;
  464. except
  465. Result := False;
  466. end;
  467. end;
  468. {$ENDIF}
  469. {$IFDEF MSWINDOWS}
  470. class function TFileHelper.GetSize(const FileName: String): Int64;
  471. var
  472. info: TWin32FileAttributeData;
  473. begin
  474. Result := -1;
  475. if not GetFileAttributesEx(PWideChar(FileName), GetFileExInfoStandard, @info) then Exit;
  476. Result := Int64(info.nFileSizeLow) or Int64(info.nFileSizeHigh shl 32);
  477. end;
  478. {$ELSE}
  479. class function TFileHelper.GetSize(const FileName: String): Int64;
  480. var
  481. sr : TSearchRec;
  482. begin
  483. if FindFirst(fileName, faAnyFile, sr ) = 0 then Result := sr.Size
  484. else Result := -1;
  485. end;
  486. {$ENDIF}
  487. {TDirectoryHelper}
  488. class function TDirectoryHelper.GetSize(const Path: String): Int64;
  489. var
  490. filename : string;
  491. begin
  492. Result := -1;
  493. for filename in TDirectory.GetFiles(Path) do
  494. begin
  495. Result := Result + TFile.GetSize(filename);
  496. end;
  497. end;
  498. {$ENDIF}
  499. {other functions}
  500. function RandomPassword(const PasswordLength : Integer; Complexity : TPasswordComplexity = [pfIncludeNumbers,pfIncludeSigns]) : string;
  501. const
  502. PassAlpha = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
  503. PassSigns = '@!&$';
  504. PassNumbers = '1234567890';
  505. var
  506. MinNumbers,
  507. MinSigns : Integer;
  508. NumNumbers,
  509. NumSigns : Integer;
  510. begin
  511. Result := '';
  512. Randomize;
  513. //fill all alfa
  514. repeat
  515. Result := Result + PassAlpha[Random(Length(PassAlpha))+1];
  516. until (Length(Result) = PasswordLength);
  517. //checks if need include numbers
  518. if pfIncludeNumbers in Complexity then
  519. begin
  520. MinNumbers := Round(PasswordLength / 10 * 2);
  521. NumNumbers := 0;
  522. if MinNumbers = 0 then MinNumbers := 1;
  523. repeat
  524. Result[Random(PasswordLength)+1] := PassNumbers[Random(Length(PassNumbers))+1];
  525. Inc(NumNumbers);
  526. until NumNumbers = MinNumbers;
  527. end;
  528. //checks if need include signs
  529. if pfIncludeSigns in Complexity then
  530. begin
  531. MinSigns := Round(PasswordLength / 10 * 1);
  532. NumSigns := 0;
  533. if MinSigns = 0 then MinSigns := 1;
  534. repeat
  535. Result[Random(PasswordLength)+1] := PassSigns[Random(Length(PassSigns))+1];
  536. Inc(NumSigns);
  537. until NumSigns = MinSigns;
  538. end;
  539. end;
  540. function RandomString(const aLength: Integer) : string;
  541. const
  542. chars : string = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890';
  543. var
  544. i : Integer;
  545. clong : Integer;
  546. begin
  547. clong := High(chars);
  548. SetLength(Result, aLength);
  549. for i := 1 to aLength do
  550. begin
  551. Result[i] := chars[Random(clong) + 1];
  552. end;
  553. end;
  554. function ExtractFileNameWithoutExt(const FileName: string): string;
  555. begin
  556. Result := TPath.GetFileNameWithoutExtension(FileName);
  557. end;
  558. function UnixToWindowsPath(const UnixPath: string): string;
  559. begin
  560. Result := StringReplace(UnixPath, '/', '\',[rfReplaceAll, rfIgnoreCase]);
  561. end;
  562. function WindowsToUnixPath(const WindowsPath: string): string;
  563. begin
  564. Result := StringReplace(WindowsPath, '\', '/',[rfReplaceAll, rfIgnoreCase]);
  565. end;
  566. function CorrectURLPath(const cUrl : string) : string;
  567. var
  568. nurl : string;
  569. begin
  570. nurl := WindowsToUnixPath(cUrl);
  571. nurl := StringReplace(nurl,'//','/',[rfReplaceAll]);
  572. Result := StringReplace(nurl,' ','%20',[rfReplaceAll]);
  573. //TNetEncoding.Url.Encode()
  574. end;
  575. function UrlGetProtocol(const aUrl : string) : string;
  576. begin
  577. Result := aUrl.SubString(0,aUrl.IndexOf('://'));
  578. end;
  579. function UrlGetHost(const aUrl : string) : string;
  580. var
  581. url : string;
  582. len : Integer;
  583. begin
  584. url := UrlRemoveProtocol(aUrl);
  585. if url.Contains('/') then len := url.IndexOf('/')
  586. else len := url.Length;
  587. Result := url.SubString(0,len);
  588. end;
  589. function UrlGetPath(const aUrl : string) : string;
  590. var
  591. url : string;
  592. len : Integer;
  593. begin
  594. url := UrlRemoveProtocol(aUrl);
  595. if not url.Contains('/') then Exit('');
  596. len := url.IndexOf('?');
  597. if len < 0 then len := url.Length
  598. else len := url.IndexOf('?') - url.IndexOf('/');
  599. Result := url.Substring(url.IndexOf('/'),len);
  600. end;
  601. function UrlGetQuery(const aUrl : string) : string;
  602. begin
  603. if not aUrl.Contains('?') then Exit('');
  604. Result := aUrl.Substring(aUrl.IndexOf('?')+1);
  605. end;
  606. function UrlRemoveProtocol(const aUrl : string) : string;
  607. var
  608. pos : Integer;
  609. begin
  610. pos := aUrl.IndexOf('://');
  611. if pos < 0 then pos := 0
  612. else pos := pos + 3;
  613. Result := aUrl.SubString(pos, aUrl.Length);
  614. end;
  615. function UrlRemoveQuery(const aUrl : string) : string;
  616. begin
  617. if not aUrl.Contains('?') then Exit(aUrl);
  618. Result := aUrl.Substring(0,aUrl.IndexOf('?'));
  619. end;
  620. function UrlSimpleEncode(const aUrl : string) : string;
  621. begin
  622. Result := StringReplace(aUrl,' ','%20',[rfReplaceAll]);
  623. end;
  624. procedure GetEnvironmentPaths;
  625. begin
  626. //gets path
  627. path.EXEPATH := TPath.GetDirectoryName(ParamStr(0));
  628. {$IFDEF MSWINDOWS}
  629. path.WINDOWS := SysUtils.GetEnvironmentVariable('windir');
  630. path.PROGRAMFILES := SysUtils.GetEnvironmentVariable('ProgramFiles');
  631. path.COMMONFILES := SysUtils.GetEnvironmentVariable('CommonProgramFiles(x86)');
  632. path.HOMEDRIVE := SysUtils.GetEnvironmentVariable('SystemDrive');
  633. path.USERPROFILE := SysUtils.GetEnvironmentVariable('USERPROFILE');
  634. path.PROGRAMDATA := SysUtils.GetEnvironmentVariable('ProgramData');
  635. path.ALLUSERSPROFILE := SysUtils.GetEnvironmentVariable('AllUsersProfile');
  636. path.INSTDRIVE := path.HOMEDRIVE;
  637. path.TEMP := SysUtils.GetEnvironmentVariable('TEMP');
  638. //these paths fail if user is SYSTEM
  639. try
  640. path.SYSTEM := GetSpecialFolderPath(CSIDL_SYSTEM);
  641. path.APPDATA := GetSpecialFolderPath(CSIDL_APPDATA);
  642. path.DESKTOP := GetSpecialFolderPath(CSIDL_DESKTOP);
  643. path.DESKTOP_ALLUSERS := GetSpecialFolderPath(CSIDL_COMMON_DESKTOPDIRECTORY);
  644. path.STARTMENU:=GetSpecialFolderPath(CSIDL_PROGRAMS);
  645. path.STARTMENU_ALLUSERS:=GetSpecialFolderPath(CSIDL_COMMON_PROGRAMS);
  646. path.STARTMENU_ALLUSERS := path.STARTMENU;
  647. path.STARTUP:=GetSpecialFolderPath(CSIDL_STARTUP);
  648. except
  649. //
  650. end;
  651. {$ENDIF}
  652. end;
  653. {$IFDEF MSWINDOWS}
  654. function GetSpecialFolderPath(folderID : Integer) : string;
  655. var
  656. shellMalloc: IMalloc;
  657. ppidl: PItemIdList;
  658. begin
  659. ppidl := nil;
  660. try
  661. if SHGetMalloc(shellMalloc) = NOERROR then
  662. begin
  663. SHGetSpecialFolderLocation(0, folderID, ppidl);
  664. SetLength(Result, MAX_PATH);
  665. if not SHGetPathFromIDList(ppidl,{$IFDEF FPC}PAnsiChar(Result){$ELSE}PChar(Result){$ENDIF}) then
  666. begin
  667. raise EShellError.create(Format('GetSpecialFolderPath: Invalid PIPL (%d)',[folderID]));
  668. end;
  669. SetLength(Result, lStrLen({$IFDEF FPC}PAnsiChar(Result){$ELSE}PChar(Result){$ENDIF}));
  670. end;
  671. finally
  672. if ppidl <> nil then
  673. shellMalloc.Free(ppidl);
  674. end;
  675. end;
  676. function Is64bitOS : Boolean;
  677. begin
  678. {$IFDEF WIN64}
  679. Result := True;
  680. {$ELSE}
  681. Result := False;
  682. {$ENDIF WIN64}
  683. end;
  684. function IsConsole: Boolean;
  685. begin
  686. {$IFDEF CONSOLE}
  687. Result := True;
  688. {$ELSE}
  689. Result := False;
  690. {$ENDIF CONSOLE}
  691. end;
  692. {$ENDIF}
  693. function HasConsoleOutput : Boolean;
  694. {$IFDEF MSWINDOWS}
  695. var
  696. stout : THandle;
  697. begin
  698. try
  699. stout := GetStdHandle(Std_Output_Handle);
  700. {$WARN SYMBOL_PLATFORM OFF}
  701. //Allready checked that we are on a windows platform
  702. Win32Check(stout <> Invalid_Handle_Value);
  703. {$WARN SYMBOL_PLATFORM ON}
  704. Result := stout <> 0;
  705. except
  706. Result := False;
  707. end;
  708. end;
  709. {$ELSE}
  710. begin
  711. Result := IsConsole;
  712. end;
  713. {$ENDIF}
  714. function IsDebug: Boolean;
  715. begin
  716. {$IFDEF DEBUG}
  717. Result := True;
  718. {$ELSE}
  719. Result := False;
  720. {$ENDIF DEBUG}
  721. end;
  722. {$IFDEF MSWINDOWS}
  723. function IsService : Boolean;
  724. begin
  725. //only working with my Quick.AppService unit
  726. try
  727. Result := (IsConsole) and (not HasConsoleOutput);
  728. except
  729. Result := False;
  730. end;
  731. end;
  732. function SecondsIdle: DWord;
  733. var
  734. liInfo: TLastInputInfo;
  735. begin
  736. liInfo.cbSize := SizeOf(TLastInputInfo) ;
  737. GetLastInputInfo(liInfo) ;
  738. Result := (GetTickCount - liInfo.dwTime) DIV 1000;
  739. end;
  740. procedure FreeUnusedMem;
  741. begin
  742. if Win32Platform = VER_PLATFORM_WIN32_NT then SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);
  743. end;
  744. function SetScreenResolution(Width, Height: integer): Longint;
  745. var
  746. DeviceMode: TDeviceMode;
  747. begin
  748. with DeviceMode do
  749. begin
  750. dmSize := SizeOf(TDeviceMode);
  751. dmPelsWidth := Width;
  752. dmPelsHeight := Height;
  753. dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
  754. end;
  755. Result := ChangeDisplaySettings(DeviceMode, CDS_UPDATEREGISTRY);
  756. end;
  757. {$ENDIF MSWINDOWS}
  758. function LastDayCurrentMonth: TDateTime;
  759. begin
  760. Result := EncodeDate(YearOf(Now),MonthOf(Now), DaysInMonth(Now));
  761. end;
  762. {$IFDEF FPC}
  763. function DateTimeInRange(ADateTime: TDateTime; AStartDateTime, AEndDateTime: TDateTime; aInclusive: Boolean = True): Boolean;
  764. begin
  765. if aInclusive then
  766. Result := (AStartDateTime <= ADateTime) and (ADateTime <= AEndDateTime)
  767. else
  768. Result := (AStartDateTime < ADateTime) and (ADateTime < AEndDateTime);
  769. end;
  770. {$ENDIF}
  771. function IsSameDay(cBefore, cNow : TDateTime) : Boolean;
  772. begin
  773. //Test: Result := MinutesBetween(cBefore,cNow) < 1;
  774. Result := DateTimeInRange(cNow,StartOfTheDay(cBefore),EndOfTheDay(cBefore),True);
  775. end;
  776. function ChangeTimeOfADay(aDate : TDateTime; aHour, aMinute, aSecond : Word; aMilliSecond : Word = 0) : TDateTime;
  777. var
  778. y, m, d : Word;
  779. begin
  780. DecodeDate(aDate,y,m,d);
  781. Result := EncodeDateTime(y,m,d,aHour,aMinute,aSecond,aMilliSecond);
  782. end;
  783. function ChangeDateOfADay(aDate : TDateTime; aYear, aMonth, aDay : Word) : TDateTime;
  784. var
  785. h, m, s, ms : Word;
  786. begin
  787. DecodeTime(aDate,h,m,s,ms);
  788. Result := EncodeDateTime(aYear,aMonth,aDay,h,m,s,0);
  789. end;
  790. function FillStr(const C : Char; const Count : Integer) : string;
  791. var
  792. i : Integer;
  793. begin
  794. Result := '';
  795. for i := 1 to Count do Result := Result + C;
  796. end;
  797. function FillStrEx(const value : string; const Count : Integer) : string;
  798. var
  799. i : Integer;
  800. begin
  801. Result := '';
  802. for i := 1 to Count do Result := Result + value;
  803. end;
  804. function StrInArray(const aValue : string; const aInArray : array of string; aCaseSensitive : Boolean = True) : Boolean;
  805. var
  806. s : string;
  807. begin
  808. for s in aInArray do
  809. begin
  810. if aCaseSensitive then
  811. begin
  812. if s = aValue then Exit(True);
  813. end
  814. else
  815. begin
  816. if CompareText(aValue,s) = 0 then Exit(True);
  817. end;
  818. end;
  819. Result := False;
  820. end;
  821. function IntInArray(const aValue : Integer; const aInArray : array of Integer) : Boolean;
  822. var
  823. i : Integer;
  824. begin
  825. for i in aInArray do
  826. begin
  827. if i = aValue then Exit(True);
  828. end;
  829. Result := False;
  830. end;
  831. function IsEmptyArray(aArray : TArray<string>) : Boolean;
  832. begin
  833. Result := Length(aArray) = 0;
  834. end;
  835. function IsEmptyArray(aArray : TArray<Integer>) : Boolean;
  836. begin
  837. Result := Length(aArray) = 0;
  838. end;
  839. function Zeroes(const Number, Len : Int64) : string;
  840. begin
  841. if Len > Length(IntToStr(Number)) then Result := FillStr('0',Len - Length(IntToStr(Number))) + IntToStr(Number)
  842. else Result := IntToStr(Number);
  843. end;
  844. function NumberToStr(const Number : Int64) : string;
  845. begin
  846. try
  847. Result := FormatFloat('0,',Number);
  848. except
  849. Result := '#Error';
  850. end;
  851. end;
  852. function Spaces(const Count : Integer) : string;
  853. begin
  854. Result := FillStr(' ',Count);
  855. end;
  856. function NowStr : string;
  857. begin
  858. Result := DateTimeToStr(Now());
  859. end;
  860. function NewGuidStr : string;
  861. {$IFNDEF DELPHIRX10_UP}
  862. var
  863. guid : TGUID;
  864. {$ENDIF}
  865. begin
  866. {$IFDEF DELPHIRX10_UP}
  867. Result := TGUID.NewGuid.ToString;
  868. {$ELSE}
  869. guid.NewGuid;
  870. Result := guid.ToString
  871. {$ENDIF}
  872. end;
  873. function IsLike(cText, Pattern: string) : Boolean;
  874. var
  875. i, n : Integer;
  876. match : Boolean;
  877. wildcard : Boolean;
  878. CurrentPattern : Char;
  879. begin
  880. Result := False;
  881. wildcard := False;
  882. cText := LowerCase(cText);
  883. Pattern := LowerCase(Pattern);
  884. match := False;
  885. if (Pattern.Length > cText.Length) or (Pattern = '') then Exit;
  886. if Pattern = '*' then
  887. begin
  888. Result := True;
  889. Exit;
  890. end;
  891. for i := 1 to cText.Length do
  892. begin
  893. CurrentPattern := Pattern[i];
  894. if CurrentPattern = '*' then wildcard := True;
  895. if wildcard then
  896. begin
  897. n := Pos(Copy(Pattern,i+1,Pattern.Length),cText);
  898. if (n > i) or (Pattern.Length = i) then
  899. begin
  900. Result := True;
  901. Exit;
  902. end;
  903. end
  904. else
  905. begin
  906. if (cText[i] = CurrentPattern) or (CurrentPattern = '?') then match := True
  907. else match := False;
  908. end;
  909. end;
  910. Result := match;
  911. end;
  912. function Capitalize(s: string): string;
  913. begin
  914. Result := '';
  915. if s.Length = 0 then Exit;
  916. s := LowerCase(s,loUserLocale);
  917. Result := UpperCase(s[1],loUserLocale) + Trim(Copy(s, 2, s.Length));
  918. end;
  919. function CapitalizeWords(s: string): string;
  920. var
  921. cword : string;
  922. begin
  923. Result := '';
  924. if s.Length = 0 then Exit;
  925. s := LowerCase(s,loUserLocale);
  926. for cword in s.Split([' ']) do
  927. begin
  928. if Result = '' then Result := Capitalize(cword)
  929. else Result := Result + ' ' + Capitalize(cword);
  930. end;
  931. end;
  932. function GetLoggedUserName : string;
  933. {$IFDEF MSWINDOWS}
  934. const
  935. cnMaxUserNameLen = 254;
  936. var
  937. sUserName : string;
  938. dwUserNameLen : DWord;
  939. begin
  940. dwUserNameLen := cnMaxUserNameLen-1;
  941. SetLength( sUserName, cnMaxUserNameLen );
  942. GetUserName(PChar( sUserName ),dwUserNameLen );
  943. SetLength( sUserName, dwUserNameLen );
  944. Result := sUserName;
  945. end;
  946. {$ELSE}
  947. {$IF DEFINED(FPC) AND DEFINED(LINUX)}
  948. begin
  949. Result := GetEnvironmentVariable('USERNAME');
  950. end;
  951. {$ELSE}
  952. var
  953. {$IFNDEF NEXTGEN}
  954. plogin : PAnsiChar;
  955. {$ELSE}
  956. plogin : MarshaledAString;
  957. {$ENDIF}
  958. begin
  959. {$IFDEF POSIX}
  960. try
  961. plogin := getlogin;
  962. {$IFDEF NEXTGEN}
  963. Result := string(plogin);
  964. {$ELSE}
  965. Result := Copy(plogin,1,Length(Trim(plogin)));
  966. {$ENDIF}
  967. except
  968. Result := 'N/A';
  969. end;
  970. {$ELSE}
  971. Result := 'N/A';
  972. {$ENDIF}
  973. //raise ENotImplemented.Create('Not Android GetLoggedUserName implemented!');
  974. end;
  975. {$ENDIF}
  976. {$ENDIF}
  977. {$IFDEF IOS}
  978. function GetDeviceModel : String;
  979. var
  980. size : size_t;
  981. buffer : array of Byte;
  982. begin
  983. sysctlbyname('hw.machine',nil,@size,nil,0);
  984. if size > 0 then
  985. begin
  986. SetLength(buffer, size);
  987. sysctlbyname('hw.machine',@buffer[0],@size,nil,0);
  988. Result := UTF8ToString(MarshaledAString(buffer));
  989. end
  990. else Result := EmptyStr;
  991. end;
  992. {$ENDIF}
  993. function GetComputerName : string;
  994. {$IFDEF MSWINDOWS}
  995. var
  996. dwLength: dword;
  997. begin
  998. dwLength := 253;
  999. SetLength(Result, dwLength+1);
  1000. if not Windows.GetComputerName(pchar(result), dwLength) then Result := 'Not detected!';
  1001. Result := pchar(result);
  1002. end;
  1003. {$ELSE}
  1004. {$IF DEFINED(FPC) AND DEFINED(LINUX)}
  1005. begin
  1006. Result := GetEnvironmentVariable('COMPUTERNAME');
  1007. end;
  1008. {$ELSE} //Android gets model name
  1009. {$IFDEF NEXTGEN}
  1010. begin
  1011. {$IFDEF ANDROID}
  1012. Result := JStringToString(TJBuild.JavaClass.MODEL);
  1013. {$ELSE} //IOS
  1014. Result := GetDeviceModel;
  1015. {$ENDIF}
  1016. end;
  1017. {$ELSE}
  1018. {$IFDEF DELPHILINUX}
  1019. var
  1020. phost : PAnsiChar;
  1021. begin
  1022. try
  1023. phost := AllocMem(256);
  1024. try
  1025. if gethostname(phost,_SC_HOST_NAME_MAX) = 0 then
  1026. begin
  1027. {$IFDEF DEBUG}
  1028. Result := Copy(Trim(phost),1,Length(Trim(phost)));
  1029. {$ELSE}
  1030. Result := Copy(phost,1,Length(phost));
  1031. {$ENDIF}
  1032. end
  1033. else Result := 'N/A.';
  1034. finally
  1035. FreeMem(phost);
  1036. end;
  1037. except
  1038. Result := 'N/A';
  1039. end;
  1040. end;
  1041. {$ELSE} //OSX
  1042. begin
  1043. Result := NSStrToStr(TNSHost.Wrap(TNSHost.OCClass.currentHost).localizedName);
  1044. end;
  1045. {$ENDIF}
  1046. {$ENDIF}
  1047. {$ENDIF}
  1048. {$ENDIF}
  1049. {$IFDEF MSWINDOWS}
  1050. function IsRemoteSession : Boolean;
  1051. const
  1052. SM_REMOTECONTROL = $2001;
  1053. SM_REMOTESESSION = $1000;
  1054. begin
  1055. Result := (GetSystemMetrics(SM_REMOTESESSION) <> 0) or (GetSystemMetrics(SM_REMOTECONTROL) <> 0);
  1056. end;
  1057. {$ENDIF}
  1058. function ExtractDomainAndUser(const aUser : string; out oDomain, oUser : string) : Boolean;
  1059. begin
  1060. //check if domain specified into username
  1061. if aUser.Contains('\') then
  1062. begin
  1063. oDomain := Copy(aUser,Low(aUser),Pos('\',aUser)-1);
  1064. oUser := Copy(aUser,Pos('\',aUser)+1,aUser.Length);
  1065. Exit(True);
  1066. end
  1067. else if aUser.Contains('@') then
  1068. begin
  1069. oDomain := Copy(aUser,Pos('@',aUser)+1,aUser.Length);
  1070. oUser := Copy(aUser,Low(aUser),Pos('@',aUser)-1);
  1071. Exit(True);
  1072. end;
  1073. oDomain := '';
  1074. oUser := aUser;
  1075. Result := False;
  1076. end;
  1077. function NormalizePathDelim(const cPath : string; const Delim : Char) : string;
  1078. begin
  1079. if Delim = '\' then Result := StringReplace(cPath,'/',Delim,[rfReplaceAll])
  1080. else Result := StringReplace(cPath,'\',Delim,[rfReplaceAll]);
  1081. end;
  1082. function CombinePaths(const aFirstPath, aSecondPath: string; aDelim : Char): string;
  1083. var
  1084. path1 : string;
  1085. path2 : string;
  1086. begin
  1087. path1 := NormalizePathDelim(aFirstPath,aDelim);
  1088. path2 := NormalizePathDelim(aSecondPath,aDelim);
  1089. if path1.EndsWith(aDelim) then
  1090. begin
  1091. if path2.StartsWith(aDelim) then Result := path1 + path2.Substring(1)
  1092. else Result := path1 + path2;
  1093. end
  1094. else
  1095. begin
  1096. if path2.StartsWith(aDelim) then Result := path1 + path2
  1097. else result := path1 + aDelim + path2;
  1098. end;
  1099. end;
  1100. function RemoveFirstPathSegment(const cdir : string) : string;
  1101. var
  1102. posi : Integer;
  1103. delim : Char;
  1104. dir : string;
  1105. StartsWithDelim : Boolean;
  1106. begin
  1107. if cDir.Contains('\') then delim := '\'
  1108. else if cDir.Contains('/') then delim := '/'
  1109. else
  1110. begin
  1111. Exit('');
  1112. end;
  1113. dir := NormalizePathDelim(cDir,delim);
  1114. if dir.StartsWith(delim) then
  1115. begin
  1116. dir := Copy(dir,2,dir.Length);
  1117. StartsWithDelim := True;
  1118. end
  1119. else StartsWithDelim := False;
  1120. if dir.CountChar(delim) = 0 then Exit('')
  1121. else posi := Pos(delim,dir)+1;
  1122. Result := Copy(dir,posi,dir.Length);
  1123. if (not Result.IsEmpty) and (StartsWithDelim) then Result := delim + Result;
  1124. end;
  1125. function RemoveLastPathSegment(const cDir : string) : string;
  1126. var
  1127. posi : Integer;
  1128. delim : Char;
  1129. dir : string;
  1130. EndsWithDelim : Boolean;
  1131. begin
  1132. if cDir.Contains('\') then delim := '\'
  1133. else if cDir.Contains('/') then delim := '/'
  1134. else
  1135. begin
  1136. Exit('');
  1137. end;
  1138. dir := NormalizePathDelim(cDir,delim);
  1139. if dir.EndsWith(delim) then
  1140. begin
  1141. dir := Copy(dir,1,dir.Length-1);
  1142. EndsWithDelim := True;
  1143. end
  1144. else EndsWithDelim := False;
  1145. if dir.CountChar(delim) > 1 then posi := dir.LastDelimiter(delim)
  1146. else posi := Pos(delim,dir)-1;
  1147. if posi = dir.Length then posi := 0;
  1148. Result := Copy(dir,1,posi);
  1149. if (not Result.IsEmpty) and (EndsWithDelim) then Result := Result + delim;
  1150. end;
  1151. function GetPathDelimiter(const aPath : string) : string;
  1152. begin
  1153. if aPath.Contains('/') then Result := '/'
  1154. else if aPath.Contains('\') then Result := '\'
  1155. else Result := '';
  1156. end;
  1157. function GetFirstPathSegment(const aPath : string) : string;
  1158. var
  1159. delimiter : string;
  1160. spath : string;
  1161. begin
  1162. delimiter := GetPathDelimiter(aPath);
  1163. if delimiter.IsEmpty then Exit(aPath);
  1164. if aPath.StartsWith(delimiter) then spath := Copy(aPath,2,aPath.Length)
  1165. else spath := aPath;
  1166. if spath.Contains(delimiter) then Result := Copy(spath,0,spath.IndexOf(delimiter))
  1167. else Result := spath;
  1168. end;
  1169. function GetLastPathSegment(const aPath : string) : string;
  1170. var
  1171. delimiter : string;
  1172. spath : string;
  1173. begin
  1174. delimiter := GetPathDelimiter(aPath);
  1175. if delimiter.IsEmpty then Exit(aPath);
  1176. if aPath.EndsWith(delimiter) then spath := Copy(aPath,0,aPath.Length - 1)
  1177. else spath := aPath;
  1178. Result := spath.Substring(spath.LastDelimiter(delimiter)+1);
  1179. end;
  1180. function ParamFindSwitch(const Switch : string) : Boolean;
  1181. begin
  1182. Result := FindCmdLineSwitch(Switch,['-', '/'],True);
  1183. end;
  1184. {$IFDEF FPC}
  1185. function FindCmdLineSwitch(const Switch: string; var Value: string; IgnoreCase: Boolean = True;
  1186. const SwitchTypes: TCmdLineSwitchTypes = [clstValueNextParam, clstValueAppended]): Boolean; overload;
  1187. type
  1188. TCompareProc = function(const S1, S2: string): Boolean;
  1189. var
  1190. Param: string;
  1191. I, ValueOfs,
  1192. SwitchLen, ParamLen: Integer;
  1193. SameSwitch: TCompareProc;
  1194. begin
  1195. Result := False;
  1196. Value := '';
  1197. if IgnoreCase then
  1198. SameSwitch := SameText else
  1199. SameSwitch := SameStr;
  1200. SwitchLen := Switch.Length;
  1201. for I := 1 to ParamCount do
  1202. begin
  1203. Param := ParamStr(I);
  1204. if CharInSet(Param.Chars[0], SwitchChars) and SameSwitch(Param.SubString(1,SwitchLen), Switch) then
  1205. begin
  1206. ParamLen := Param.Length;
  1207. // Look for an appended value if the param is longer than the switch
  1208. if (ParamLen > SwitchLen + 1) then
  1209. begin
  1210. // If not looking for appended value switches then this is not a matching switch
  1211. if not (clstValueAppended in SwitchTypes) then
  1212. Continue;
  1213. ValueOfs := SwitchLen + 1;
  1214. if Param.Chars[ValueOfs] = ':' then
  1215. Inc(ValueOfs);
  1216. Value := Param.SubString(ValueOfs, MaxInt);
  1217. end
  1218. // If the next param is not a switch, then treat it as the value
  1219. else if (clstValueNextParam in SwitchTypes) and (I < ParamCount) and
  1220. not CharInSet(ParamStr(I+1).Chars[0], SwitchChars) then
  1221. Value := ParamStr(I+1);
  1222. Result := True;
  1223. Break;
  1224. end;
  1225. end;
  1226. end;
  1227. {$ENDIF}
  1228. function ParamGetSwitch(const Switch : string; var cvalue : string) : Boolean;
  1229. begin
  1230. Result := FindCmdLineSwitch(Switch,cvalue,True,[clstValueAppended]);
  1231. end;
  1232. function GetAppName : string;
  1233. begin
  1234. Result := ExtractFilenameWithoutExt(ParamStr(0));
  1235. end;
  1236. function GetAppVersionStr: string;
  1237. {$IFDEF MSWINDOWS}
  1238. var
  1239. Rec: LongRec;
  1240. ver : Cardinal;
  1241. begin
  1242. ver := GetFileVersion(ParamStr(0));
  1243. if ver <> Cardinal(-1) then
  1244. begin
  1245. Rec := LongRec(ver);
  1246. Result := Format('%d.%d', [Rec.Hi, Rec.Lo]);
  1247. end
  1248. else Result := '';
  1249. end;
  1250. {$ELSE}
  1251. {$IF DEFINED(FPC) AND DEFINED(LINUX)}
  1252. var
  1253. version : TProgramVersion;
  1254. begin
  1255. if GetProgramVersion(version) then Result := Format('%d.%d', [version.Major, version.Minor])
  1256. else Result := '';
  1257. end;
  1258. {$ELSE}
  1259. {$IFDEF NEXTGEN}
  1260. {$IFDEF ANDROID}
  1261. var
  1262. PkgInfo : JPackageInfo;
  1263. begin
  1264. {$IFDEF DELPHIRX103_UP}
  1265. PkgInfo := TAndroidHelper.Activity.getPackageManager.getPackageInfo(TAndroidHelper.Activity.getPackageName,0);
  1266. {$ELSE}
  1267. PkgInfo := SharedActivity.getPackageManager.getPackageInfo(SharedActivity.getPackageName,0);
  1268. {$ENDIF}
  1269. Result := IntToStr(PkgInfo.VersionCode);
  1270. end;
  1271. {$ELSE} //IOS
  1272. var
  1273. AppKey: Pointer;
  1274. AppBundle: NSBundle;
  1275. BuildStr : NSString;
  1276. begin
  1277. try
  1278. AppKey := (StrToNSStr('CFBundleVersion') as ILocalObject).GetObjectID;
  1279. AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
  1280. BuildStr := TNSString.Wrap(AppBundle.infoDictionary.objectForKey(AppKey));
  1281. Result := UTF8ToString(BuildStr.UTF8String);
  1282. except
  1283. Result := '';
  1284. end;
  1285. end;
  1286. {$ENDIF}
  1287. {$ELSE} //OSX
  1288. {$IFDEF OSX}
  1289. var
  1290. AppKey: Pointer;
  1291. AppBundle: NSBundle;
  1292. BuildStr : NSString;
  1293. begin
  1294. try
  1295. AppKey := (StrToNSStr('CFBundleVersion') as ILocalObject).GetObjectID;
  1296. AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
  1297. BuildStr := TNSString.Wrap(AppBundle.infoDictionary.objectForKey(AppKey));
  1298. Result := UTF8ToString(BuildStr.UTF8String);
  1299. except
  1300. Result := '';
  1301. end;
  1302. end;
  1303. {$ELSE}
  1304. begin
  1305. Result := '';
  1306. end;
  1307. {$ENDIF}
  1308. {$ENDIF}
  1309. {$ENDIF}
  1310. {$ENDIF}
  1311. function GetAppVersionFullStr: string;
  1312. {$IFDEF MSWINDOWS}
  1313. var
  1314. Exe: string;
  1315. Size, Handle: DWORD;
  1316. Buffer: TBytes;
  1317. FixedPtr: PVSFixedFileInfo;
  1318. begin
  1319. Result := '';
  1320. Exe := ParamStr(0);
  1321. Size := GetFileVersionInfoSize(PChar(Exe), Handle);
  1322. if Size = 0 then
  1323. begin
  1324. //RaiseLastOSError;
  1325. //no version info in file
  1326. Exit;
  1327. end;
  1328. SetLength(Buffer, Size);
  1329. if not GetFileVersionInfo(PChar(Exe), Handle, Size, Buffer) then
  1330. RaiseLastOSError;
  1331. if not VerQueryValue(Buffer, '\', Pointer(FixedPtr), Size) then
  1332. RaiseLastOSError;
  1333. if (LongRec(FixedPtr.dwFileVersionLS).Hi = 0) and (LongRec(FixedPtr.dwFileVersionLS).Lo = 0) then
  1334. begin
  1335. Result := Format('%d.%d',
  1336. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  1337. LongRec(FixedPtr.dwFileVersionMS).Lo]); //minor
  1338. end
  1339. else if (LongRec(FixedPtr.dwFileVersionLS).Lo = 0) then
  1340. begin
  1341. Result := Format('%d.%d.%d',
  1342. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  1343. LongRec(FixedPtr.dwFileVersionMS).Lo, //minor
  1344. LongRec(FixedPtr.dwFileVersionLS).Hi]); //release
  1345. end
  1346. else
  1347. begin
  1348. Result := Format('%d.%d.%d.%d',
  1349. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  1350. LongRec(FixedPtr.dwFileVersionMS).Lo, //minor
  1351. LongRec(FixedPtr.dwFileVersionLS).Hi, //release
  1352. LongRec(FixedPtr.dwFileVersionLS).Lo]); //build
  1353. end;
  1354. end;
  1355. {$ELSE}
  1356. {$IF DEFINED(FPC) AND DEFINED(LINUX)}
  1357. var
  1358. version : TProgramVersion;
  1359. begin
  1360. if GetProgramVersion(version) then Result := Format('%d.%d.%d.%d', [version.Major, version.Minor, version.Revision, version.Build])
  1361. else Result := '';
  1362. end;
  1363. {$ELSE}
  1364. {$IFDEF NEXTGEN}
  1365. {$IFDEF ANDROID}
  1366. var
  1367. PkgInfo : JPackageInfo;
  1368. begin
  1369. {$IFDEF DELPHIRX103_UP}
  1370. PkgInfo := TAndroidHelper.Activity.getPackageManager.getPackageInfo(TAndroidHelper.Activity.getPackageName,0);
  1371. {$ELSE}
  1372. PkgInfo := SharedActivity.getPackageManager.getPackageInfo(SharedActivity.getPackageName,0);
  1373. {$ENDIF}
  1374. Result := JStringToString(PkgInfo.versionName);
  1375. end;
  1376. {$ELSE} //IOS
  1377. var
  1378. AppKey: Pointer;
  1379. AppBundle: NSBundle;
  1380. BuildStr : NSString;
  1381. begin
  1382. AppKey := (StrToNSStr('CFBundleVersion') as ILocalObject).GetObjectID;
  1383. AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
  1384. BuildStr := TNSString.Wrap(AppBundle.infoDictionary.objectForKey(AppKey));
  1385. Result := UTF8ToString(BuildStr.UTF8String);
  1386. end;
  1387. {$ENDIF}
  1388. {$ELSE}
  1389. {$IFDEF OSX}
  1390. var
  1391. AppKey: Pointer;
  1392. AppBundle: NSBundle;
  1393. BuildStr : NSString;
  1394. begin
  1395. AppKey := (StrToNSStr('CFBundleVersion') as ILocalObject).GetObjectID;
  1396. AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
  1397. BuildStr := TNSString.Wrap(AppBundle.infoDictionary.objectForKey(AppKey));
  1398. Result := UTF8ToString(BuildStr.UTF8String);
  1399. end;
  1400. {$ELSE}
  1401. begin
  1402. Result := '';
  1403. end;
  1404. {$ENDIF}
  1405. {$ENDIF}
  1406. {$ENDIF}
  1407. {$ENDIF}
  1408. function UTCToLocalTime(GMTTime: TDateTime): TDateTime;
  1409. begin
  1410. {$IFDEF FPC}
  1411. Result := LocalTimeToUniversal(GMTTime);
  1412. {$ELSE}
  1413. Result := TTimeZone.Local.ToLocalTime(GMTTime);
  1414. {$ENDIF}
  1415. end;
  1416. function LocalTimeToUTC(LocalTime : TDateTime): TDateTime;
  1417. begin
  1418. {$IFDEF FPC}
  1419. Result := UniversalTimeToLocal(Localtime);
  1420. {$ELSE}
  1421. Result := TTimeZone.Local.ToUniversalTime(LocalTime);
  1422. {$ENDIF}
  1423. end;
  1424. function DateTimeToGMT(aDate : TDateTime) : string;
  1425. var
  1426. FmtSettings : TFormatSettings;
  1427. begin
  1428. FmtSettings.DateSeparator := '-';
  1429. FmtSettings.TimeSeparator := ':';
  1430. FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ" GMT"';
  1431. Result := DateTimeToStr(aDate,FmtSettings).Trim;
  1432. end;
  1433. function GMTToDateTime(aDate : string) : TDateTime;
  1434. var
  1435. FmtSettings : TFormatSettings;
  1436. begin
  1437. FmtSettings.DateSeparator := '-';
  1438. FmtSettings.TimeSeparator := ':';
  1439. FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ" GMT"';
  1440. Result := StrToDateTime(aDate,FmtSettings);
  1441. end;
  1442. function DateTimeToJsonDate(aDateTime : TDateTime) : string;
  1443. {$IFNDEF DELPHIXE7_UP}
  1444. var
  1445. FmtSettings : TFormatSettings;
  1446. {$ENDIF}
  1447. begin
  1448. {$IFDEF DELPHIXE7_UP}
  1449. Result := DateToISO8601(aDateTime);
  1450. {$ELSE}
  1451. FmtSettings.DateSeparator := '-';
  1452. FmtSettings.TimeSeparator := ':';
  1453. FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ"Z"';
  1454. Result := DateTimeToStr(aDateTime,FmtSettings).Trim;
  1455. {$ENDIF}
  1456. end;
  1457. function JsonDateToDateTime(const aJsonDate : string) : TDateTime;
  1458. {$IFNDEF DELPHIXE7_UP}
  1459. var
  1460. FmtSettings : TFormatSettings;
  1461. {$ENDIF}
  1462. {$IFDEF FPC}
  1463. var
  1464. jdate : string;
  1465. {$ENDIF}
  1466. begin
  1467. {$IFDEF DELPHIXE7_UP}
  1468. Result := ISO8601ToDate(aJsonDate);
  1469. {$ELSE}
  1470. FmtSettings.DateSeparator := '-';
  1471. FmtSettings.TimeSeparator := ':';
  1472. FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ"Z"';
  1473. {$IFDEF FPC}
  1474. jdate := StringReplace(aJsondate,'T',' ',[rfIgnoreCase]);
  1475. jdate := Copy(jdate,1,Pos('.',jdate)-1);
  1476. Result := StrToDateTime(jdate,FmtSettings);
  1477. {$ELSE}
  1478. Result := StrToDateTime(aJsonDate,FmtSettings);
  1479. {$ENDIF}
  1480. {$ENDIF}
  1481. end;
  1482. function CountDigits(anInt: Cardinal): Cardinal; inline;
  1483. var
  1484. cmp: Cardinal;
  1485. begin
  1486. cmp := 10;
  1487. Result := 1;
  1488. while (Result < 10) and (cmp <= anInt) do
  1489. begin
  1490. cmp := cmp*10;
  1491. Inc(Result);
  1492. end;
  1493. end;
  1494. function CountStr(const aFindStr, aSourceStr : string) : Integer;
  1495. var
  1496. i : Integer;
  1497. found : Integer;
  1498. findstr : string;
  1499. mainstr : string;
  1500. begin
  1501. findstr := aFindStr.ToLower;
  1502. mainstr := aSourceStr.ToLower;
  1503. Result := 0;
  1504. i := 0;
  1505. while i < mainstr.Length do
  1506. begin
  1507. found := Pos(findstr,mainstr,i);
  1508. if found > 0 then
  1509. begin
  1510. i := found;
  1511. Inc(Result);
  1512. end
  1513. else Break;
  1514. end;
  1515. end;
  1516. procedure SaveStreamToFile(aStream : TStream; const aFileName : string);
  1517. var
  1518. fs : TFileStream;
  1519. begin
  1520. fs := TFileStream.Create(aFileName,fmCreate);
  1521. try
  1522. aStream.Seek(0,soBeginning);
  1523. fs.CopyFrom(aStream,aStream.Size);
  1524. finally
  1525. fs.Free;
  1526. end;
  1527. end;
  1528. function StreamToString(const aStream: TStream; const aEncoding: TEncoding): string;
  1529. var
  1530. sbytes: TBytes;
  1531. begin
  1532. aStream.Position := 0;
  1533. SetLength(sbytes, aStream.Size);
  1534. aStream.ReadBuffer(sbytes,aStream.Size);
  1535. Result := aEncoding.GetString(sbytes);
  1536. end;
  1537. function StreamToStringEx(aStream : TStream) : string;
  1538. var
  1539. ss : TStringStream;
  1540. begin
  1541. aStream.Position := 0;
  1542. if aStream = nil then Exit;
  1543. if aStream is TMemoryStream then
  1544. begin
  1545. SetString(Result, PChar(TMemoryStream(aStream).Memory), TMemoryStream(aStream).Size div SizeOf(Char));
  1546. end
  1547. else if aStream is TStringStream then
  1548. begin
  1549. Result := TStringStream(aStream).DataString;
  1550. end
  1551. else
  1552. begin
  1553. ss := TStringStream.Create;
  1554. try
  1555. aStream.Seek(0,soBeginning);
  1556. ss.CopyFrom(aStream,aStream.Size);
  1557. Result := ss.DataString;
  1558. finally
  1559. ss.Free;
  1560. end;
  1561. end;
  1562. end;
  1563. procedure StringToStream(const aStr : string; aStream : TStream; const aEncoding: TEncoding);
  1564. var
  1565. stream : TStringStream;
  1566. begin
  1567. stream := TStringStream.Create(aStr,aEncoding);
  1568. try
  1569. aStream.CopyFrom(stream,stream.Size);
  1570. finally
  1571. stream.Free;
  1572. end;
  1573. end;
  1574. procedure StringToStreamEx(const aStr : string; aStream : TStream);
  1575. begin
  1576. aStream.Seek(0,soBeginning);
  1577. aStream.WriteBuffer(Pointer(aStr)^,aStr.Length * SizeOf(Char));
  1578. end;
  1579. function CommaText(aList : TStringList) : string;
  1580. var
  1581. value : string;
  1582. sb : TStringBuilder;
  1583. begin
  1584. if aList.Text = '' then Exit;
  1585. sb := TStringBuilder.Create;
  1586. try
  1587. for value in aList do
  1588. begin
  1589. sb.Append(value);
  1590. sb.Append(',');
  1591. end;
  1592. if sb.Length > 1 then Result := sb.ToString(0, sb.Length - 1);
  1593. finally
  1594. sb.Free;
  1595. end;
  1596. end;
  1597. function CommaText(aArray : TArray<string>) : string;
  1598. var
  1599. value : string;
  1600. sb : TStringBuilder;
  1601. begin
  1602. if High(aArray) < 0 then Exit;
  1603. sb := TStringBuilder.Create;
  1604. try
  1605. for value in aArray do
  1606. begin
  1607. sb.Append(value);
  1608. sb.Append(',');
  1609. end;
  1610. if sb.Length > 1 then Result := sb.ToString(0, sb.Length - 1);
  1611. finally
  1612. sb.Free;
  1613. end;
  1614. end;
  1615. function ArrayToString(aArray : TArray<string>) : string;
  1616. var
  1617. value : string;
  1618. sb : TStringBuilder;
  1619. begin
  1620. Result := '';
  1621. if High(aArray) < 0 then Exit;
  1622. sb := TStringBuilder.Create;
  1623. try
  1624. for value in aArray do
  1625. begin
  1626. sb.Append(value);
  1627. sb.Append(CRLF);
  1628. end;
  1629. Result := sb.ToString;
  1630. finally
  1631. sb.Free;
  1632. end;
  1633. end;
  1634. function ArrayToString(aArray : TArray<string>; aSeparator : string) : string;
  1635. var
  1636. value : string;
  1637. sb : TStringBuilder;
  1638. isfirst : Boolean;
  1639. begin
  1640. Result := '';
  1641. if High(aArray) < 0 then Exit;
  1642. isfirst := True;
  1643. sb := TStringBuilder.Create;
  1644. try
  1645. for value in aArray do
  1646. begin
  1647. if isfirst then isfirst := False
  1648. else sb.Append(aSeparator);
  1649. sb.Append(value);
  1650. end;
  1651. Result := sb.ToString;
  1652. finally
  1653. sb.Free;
  1654. end;
  1655. end;
  1656. function StringsToArray(aStrings : TStrings) : TArray<string>;
  1657. var
  1658. i : Integer;
  1659. begin
  1660. if aStrings.Count = 0 then Exit;
  1661. SetLength(Result,aStrings.Count);
  1662. for i := 0 to aStrings.Count - 1 do
  1663. begin
  1664. Result[i] := aStrings[i];
  1665. end;
  1666. end;
  1667. function StringsToArray(const aString : string) : TArray<string>;
  1668. var
  1669. item : string;
  1670. begin
  1671. for item in aString.Split([';',',']) do Result := Result + [item.Trim];
  1672. end;
  1673. { TCounter }
  1674. procedure TCounter.Init(aMaxValue : Integer);
  1675. begin
  1676. fMaxValue := aMaxValue;
  1677. fCurrentValue := 0;
  1678. end;
  1679. function TCounter.Count : Integer;
  1680. begin
  1681. Result := fCurrentValue;
  1682. end;
  1683. function TCounter.CountIs(aValue : Integer) : Boolean;
  1684. begin
  1685. Result := fCurrentValue = aValue;
  1686. end;
  1687. function TCounter.Check : Boolean;
  1688. begin
  1689. if fCurrentValue = fMaxValue then
  1690. begin
  1691. Result := True;
  1692. Reset;
  1693. end
  1694. else
  1695. begin
  1696. Result := False;
  1697. Inc(fCurrentValue);
  1698. end;
  1699. end;
  1700. procedure TCounter.Reset;
  1701. begin
  1702. fCurrentValue := fMaxValue;
  1703. end;
  1704. { TimeCounter }
  1705. procedure TTimeCounter.Init(MillisecondsToReach : Integer);
  1706. begin
  1707. fDoneEvery := MillisecondsToReach;
  1708. end;
  1709. function TTimeCounter.Check : Boolean;
  1710. begin
  1711. if MilliSecondsBetween(fCurrentTime,Now) > fDoneEvery then
  1712. begin
  1713. fCurrentTime := Now();
  1714. Result := True;
  1715. end
  1716. else Result := False;
  1717. end;
  1718. procedure TTimeCounter.Reset;
  1719. begin
  1720. fCurrentTime := Now();
  1721. end;
  1722. { TArrayOfStringHelper}
  1723. {$IFNDEF FPC}
  1724. function TArrayOfStringHelper.Any : Boolean;
  1725. begin
  1726. Result := High(Self) >= 0;
  1727. end;
  1728. function TArrayOfStringHelper.Any(const aValue : string) : Boolean;
  1729. begin
  1730. Result := Exists(aValue);
  1731. end;
  1732. function TArrayOfStringHelper.Add(const aValue : string) : Integer;
  1733. begin
  1734. SetLength(Self,Length(Self)+1);
  1735. Self[High(Self)] := aValue;
  1736. Result := High(Self);
  1737. end;
  1738. function TArrayOfStringHelper.AddIfNotExists(const aValue : string; aCaseSense : Boolean = False) : Integer;
  1739. var
  1740. i : Integer;
  1741. begin
  1742. for i := Low(Self) to High(Self) do
  1743. begin
  1744. if aCaseSense then
  1745. begin
  1746. if Self[i] = aValue then Exit(i);
  1747. end
  1748. else
  1749. begin
  1750. if CompareText(Self[i],aValue) = 0 then Exit(i)
  1751. end;
  1752. end;
  1753. //if not exists add it
  1754. Result := Self.Add(aValue);
  1755. end;
  1756. function TArrayOfStringHelper.Remove(const aValue : string) : Boolean;
  1757. var
  1758. i : Integer;
  1759. begin
  1760. for i := Low(Self) to High(Self) do
  1761. begin
  1762. if CompareText(Self[i],aValue) = 0 then
  1763. begin
  1764. {$IFDEF DELPHIXE7_UP}
  1765. System.Delete(Self,i,1);
  1766. {$ELSE}
  1767. TArrayUtil<string>.Delete(Self,i);
  1768. {$ENDIF}
  1769. Exit(True);
  1770. end;
  1771. end;
  1772. Result := False;
  1773. end;
  1774. function TArrayOfStringHelper.Exists(const aValue : string) : Boolean;
  1775. var
  1776. value : string;
  1777. begin
  1778. Result := False;
  1779. for value in Self do
  1780. begin
  1781. if CompareText(value,aValue) = 0 then Exit(True)
  1782. end;
  1783. end;
  1784. function TArrayOfStringHelper.Count : Integer;
  1785. begin
  1786. Result := High(Self) + 1;
  1787. end;
  1788. {$ENDIF}
  1789. { TPairItem }
  1790. constructor TPairItem.Create(const aName, aValue: string);
  1791. begin
  1792. Name := aName;
  1793. Value := aValue;
  1794. end;
  1795. { TPairList }
  1796. function TPairList.GetEnumerator : TPairEnumerator;
  1797. begin
  1798. Result := TPairEnumerator.Create(fItems);
  1799. end;
  1800. function TPairList.Add(aPair: TPairItem): Integer;
  1801. begin
  1802. SetLength(fItems,Length(fItems)+1);
  1803. fItems[High(fItems)] := aPair;
  1804. Result := High(fItems);
  1805. end;
  1806. function TPairList.Add(const aName, aValue: string): Integer;
  1807. begin
  1808. SetLength(fItems,Length(fItems)+1);
  1809. fItems[High(fItems)].Name := aName;
  1810. fItems[High(fItems)].Value := aValue;
  1811. Result := High(fItems);
  1812. end;
  1813. procedure TPairList.AddOrUpdate(const aName, aValue: string);
  1814. var
  1815. i : Integer;
  1816. begin
  1817. for i := Low(fItems) to High(fItems) do
  1818. begin
  1819. if CompareText(fItems[i].Name,aName) = 0 then
  1820. begin
  1821. fItems[i].Value := aValue;
  1822. Exit;
  1823. end;
  1824. end;
  1825. //if not exists add it
  1826. Self.Add(aName,aValue);
  1827. end;
  1828. function TPairList.Count: Integer;
  1829. begin
  1830. Result := High(fItems) + 1;
  1831. end;
  1832. function TPairList.Exists(const aName: string): Boolean;
  1833. var
  1834. i : Integer;
  1835. begin
  1836. Result := False;
  1837. for i := Low(fItems) to High(fItems) do
  1838. begin
  1839. if CompareText(fItems[i].Name,aName) = 0 then Exit(True)
  1840. end;
  1841. end;
  1842. function TPairList.GetPair(const aName: string): TPairItem;
  1843. var
  1844. i : Integer;
  1845. begin
  1846. for i := Low(fItems) to High(fItems) do
  1847. begin
  1848. if CompareText(fItems[i].Name,aName) = 0 then Exit(fItems[i]);
  1849. end;
  1850. end;
  1851. function TPairList.GetValue(const aName: string): string;
  1852. var
  1853. i : Integer;
  1854. begin
  1855. Result := '';
  1856. for i := Low(fItems) to High(fItems) do
  1857. begin
  1858. if CompareText(fItems[i].Name,aName) = 0 then Exit(fItems[i].Value);
  1859. end;
  1860. end;
  1861. function TPairList.Remove(const aName: string): Boolean;
  1862. var
  1863. i : Integer;
  1864. begin
  1865. for i := Low(fItems) to High(fItems) do
  1866. begin
  1867. if CompareText(fItems[i].Name,aName) = 0 then
  1868. begin
  1869. {$IF Defined(DELPHIXE7_UP) OR Defined(FPC)}
  1870. System.Delete(fItems,i,1);
  1871. {$ELSE}
  1872. TArrayUtil<TPairItem>.Delete(fItems,i);
  1873. {$ENDIF}
  1874. Exit(True);
  1875. end;
  1876. end;
  1877. Result := False;
  1878. end;
  1879. function TPairList.ToArray : TArray<TPairItem>;
  1880. begin
  1881. Result := fItems;
  1882. end;
  1883. procedure TPairList.FromArray(aValue : TArray<TPairItem>);
  1884. begin
  1885. fItems := aValue;
  1886. end;
  1887. procedure TPairList.Clear;
  1888. begin
  1889. SetLength(fItems,0);
  1890. end;
  1891. { TPairList.TPairEnumerator}
  1892. constructor TPairList.TPairEnumerator.Create(var aArray: TArray<TPairItem>);
  1893. begin
  1894. fIndex := -1;
  1895. fArray := @aArray;
  1896. end;
  1897. function TPairList.TPairEnumerator.GetCurrent : TPairItem;
  1898. begin
  1899. Result := TArray<TPairItem>(fArray^)[fIndex];
  1900. end;
  1901. function TPairList.TPairEnumerator.MoveNext: Boolean;
  1902. begin
  1903. Inc(fIndex);
  1904. Result := fIndex < High(TArray<TPairItem>(fArray^))+1;
  1905. end;
  1906. {$IFDEF MSWINDOWS}
  1907. procedure ProcessMessages;
  1908. var
  1909. Msg: TMsg;
  1910. begin
  1911. while integer(PeekMessage(Msg, 0, 0, 0, PM_REMOVE)) <> 0 do
  1912. begin
  1913. TranslateMessage(Msg);
  1914. DispatchMessage(Msg);
  1915. end;
  1916. end;
  1917. function GetLastOSError: String;
  1918. begin
  1919. Result := SysErrorMessage(Windows.GetLastError);
  1920. end;
  1921. {$ENDIF}
  1922. function RemoveLastChar(const aText : string) : string;
  1923. begin
  1924. Result := aText.Remove(aText.Length - 1);
  1925. end;
  1926. function DateTimeToSQL(aDateTime : TDateTime) : string;
  1927. begin
  1928. Result := FormatDateTime('YYYY-MM-DD hh:mm:ss',aDateTime);
  1929. end;
  1930. function IsInteger(const aValue : string) : Boolean;
  1931. var
  1932. i : Integer;
  1933. begin
  1934. Result := TryStrToInt(aValue,i);
  1935. end;
  1936. function IsFloat(const aValue : string) : Boolean;
  1937. var
  1938. e : Extended;
  1939. begin
  1940. Result := TryStrToFloat(aValue,e);
  1941. end;
  1942. function IsBoolean(const aValue : string) : Boolean;
  1943. var
  1944. b : Boolean;
  1945. begin
  1946. Result := TryStrToBool(aValue,b);
  1947. end;
  1948. function ExtractStr(var vSource : string; aIndex : Integer; aCount : Integer) : string;
  1949. begin
  1950. if aIndex > vSource.Length then Exit('');
  1951. Result := Copy(vSource,aIndex,aCount);
  1952. Delete(vSource,aIndex,aCount);
  1953. end;
  1954. function GetSubString(const aSource, aFirstDelimiter, aLastDelimiter : string) : string;
  1955. var
  1956. i : Integer;
  1957. begin
  1958. i := Pos(aFirstDelimiter,aSource);
  1959. if i > -1 then Result := Copy(aSource, i + aFirstDelimiter.Length, Pos(aLastDelimiter, aSource, i + aFirstDelimiter.Length) - i - aFirstDelimiter.Length)
  1960. else Result := '';
  1961. end;
  1962. function DbQuotedStr(const str : string): string;
  1963. var
  1964. i : Integer;
  1965. begin
  1966. Result := str;
  1967. for i := Result.Length - 1 downto 0 do
  1968. begin
  1969. if Result.Chars[i] = '"' then Result := Result.Insert(i, '"');
  1970. end;
  1971. Result := '"' + Result + '"';
  1972. end;
  1973. function UnDbQuotedStr(const str: string) : string;
  1974. begin
  1975. Result := Trim(str);
  1976. if not Result.IsEmpty then
  1977. begin
  1978. if Result.StartsWith('"') then Result := Copy(Result, 2, Result.Length - 2);
  1979. end;
  1980. end;
  1981. function SpQuotedStr(const str : string): string;
  1982. begin
  1983. Result := '''' + str + '''';
  1984. end;
  1985. function UnSpQuotedStr(const str: string) : string;
  1986. begin
  1987. Result := Trim(str);
  1988. if not Result.IsEmpty then
  1989. begin
  1990. if Result.StartsWith('''') then Result := Copy(Result, 2, Result.Length - 2);
  1991. end;
  1992. end;
  1993. function UnQuotedStr(const str : string; const aQuote : Char) : string;
  1994. begin
  1995. if (str.Length > 0) and (str[Low(str)] = aQuote) and (str[High(str)] = aQuote) then Result := Copy(str, Low(str)+1, High(str) - 2)
  1996. else Result := str;
  1997. end;
  1998. function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : string) : string;
  1999. begin
  2000. if aCondition then Result := aIfIsTrue else Result := aIfIsFalse;
  2001. end;
  2002. function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : Integer) : Integer;
  2003. begin
  2004. if aCondition then Result := aIfIsTrue else Result := aIfIsFalse;
  2005. end;
  2006. function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : Extended) : Extended;
  2007. begin
  2008. if aCondition then Result := aIfIsTrue else Result := aIfIsFalse;
  2009. end;
  2010. function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : TObject) : TObject;
  2011. begin
  2012. if aCondition then Result := aIfIsTrue else Result := aIfIsFalse;
  2013. end;
  2014. {$IFNDEF FPC}
  2015. {$IFNDEF DELPHIXE7_UP}
  2016. class procedure TArrayUtil<T>.Delete(var aArray : TArray<T>; aIndex : Integer);
  2017. var
  2018. n : Integer;
  2019. len : Integer;
  2020. begin
  2021. len := Length(aArray);
  2022. if (len > 0) and (aIndex < len) then
  2023. begin
  2024. for n := aIndex + 1 to len - 1 do aArray[n - 1] := aArray[n];
  2025. SetLength(aArray, len - 1);
  2026. end;
  2027. end;
  2028. {$ENDIF}
  2029. {$ENDIF}
  2030. { TDateTimeHelper }
  2031. {$IFDEF DELPHIXE7_UP}
  2032. function TDateTimeHelper.ToSQLString : string;
  2033. begin
  2034. Result := DateTimeToSQL(Self);
  2035. end;
  2036. procedure TDateTimeHelper.FromNow;
  2037. begin
  2038. Self := Now;
  2039. end;
  2040. procedure TDateTimeHelper.FromUTC(const aUTCTime: TDateTime);
  2041. begin
  2042. Self := UTCToLocalTime(aUTCTime);
  2043. end;
  2044. function TDateTimeHelper.IncDay(const aValue : Cardinal = 1) : TDateTime;
  2045. begin
  2046. Result := System.DateUtils.IncDay(Self,aValue);
  2047. end;
  2048. function TDateTimeHelper.DecDay(const aValue : Cardinal = 1) : TDateTime;
  2049. begin
  2050. Result := System.DateUtils.IncDay(Self,-aValue);
  2051. end;
  2052. function TDateTimeHelper.IncMonth(const aValue : Cardinal = 1) : TDateTime;
  2053. begin
  2054. Result := SysUtils.IncMonth(Self,aValue);
  2055. end;
  2056. function TDateTimeHelper.DecMonth(const aValue : Cardinal = 1) : TDateTime;
  2057. begin
  2058. Result := SysUtils.IncMonth(Self,-aValue);
  2059. end;
  2060. function TDateTimeHelper.IncYear(const aValue : Cardinal = 1) : TDateTime;
  2061. begin
  2062. Result := System.DateUtils.IncYear(Self,aValue);
  2063. end;
  2064. function TDateTimeHelper.DecYear(const aValue : Cardinal = 1) : TDateTime;
  2065. begin
  2066. Result := System.DateUtils.IncYear(Self,-aValue);
  2067. end;
  2068. function TDateTimeHelper.IsEqualTo(const aDateTime : TDateTime) : Boolean;
  2069. begin
  2070. Result := Self = aDateTime;
  2071. end;
  2072. function TDateTimeHelper.IsAfter(const aDateTime : TDateTime) : Boolean;
  2073. begin
  2074. Result := Self > aDateTime;
  2075. end;
  2076. function TDateTimeHelper.IsBefore(const aDateTime : TDateTime) : Boolean;
  2077. begin
  2078. Result := Self < aDateTime;
  2079. end;
  2080. function TDateTimeHelper.IsSameDay(const aDateTime : TDateTime) : Boolean;
  2081. begin
  2082. Result := System.DateUtils.SameDate(Self,aDateTime);
  2083. end;
  2084. function TDateTimeHelper.IsSameTime(const aTime : TTime) : Boolean;
  2085. begin
  2086. Result := System.DateUtils.SameTime(Self,aTime);
  2087. end;
  2088. function TDateTimeHelper.DayOfTheWeek : Word;
  2089. begin
  2090. Result := System.DateUtils.NthDayOfWeek(Self);
  2091. end;
  2092. function TDateTimeHelper.ToJsonFormat : string;
  2093. begin
  2094. Result := DateTimeToJsonDate(Self);
  2095. end;
  2096. function TDateTimeHelper.ToGMTFormat : string;
  2097. begin
  2098. Result := DateTimeToGMT(Self);
  2099. end;
  2100. function TDateTimeHelper.ToTimeStamp : TTimeStamp;
  2101. begin
  2102. Result := DateTimeToTimeStamp(Self);
  2103. end;
  2104. function TDateTimeHelper.ToUTC : TDateTime;
  2105. begin
  2106. Result := LocalTimeToUTC(Self);
  2107. end;
  2108. function TDateTimeHelper.ToMilliseconds : Int64;
  2109. begin
  2110. {$IFDEF DELPHIRX104_ANDUP}
  2111. Result := System.DateUtils.DateTimeToMilliseconds(Self);
  2112. {$ELSE}
  2113. Result := System.DateUtils.MilliSecondOf(Self);
  2114. {$ENDIF}
  2115. end;
  2116. function TDateTimeHelper.ToString : string;
  2117. begin
  2118. Result := DateTimeToStr(Self);
  2119. end;
  2120. function TDateTimeHelper.Date : TDate;
  2121. begin
  2122. Result := System.DateUtils.DateOf(Self);
  2123. end;
  2124. function TDateTimeHelper.Time : TTime;
  2125. begin
  2126. Result := System.DateUtils.TimeOf(Self);
  2127. end;
  2128. function TDateTimeHelper.IsAM : Boolean;
  2129. begin
  2130. Result := System.DateUtils.IsAM(Self);
  2131. end;
  2132. function TDateTimeHelper.IsPM : Boolean;
  2133. begin
  2134. Result := System.DateUtils.IsPM(Self);
  2135. end;
  2136. { TDateHelper }
  2137. function TDateHelper.ToString : string;
  2138. begin
  2139. Result := DateToStr(Self);
  2140. end;
  2141. { TTimeHelper }
  2142. function TTimeHelper.ToString : string;
  2143. begin
  2144. Result := TimeToStr(Self);
  2145. end;
  2146. {$ENDIF}
  2147. {$IFNDEF NEXTGEN}
  2148. initialization
  2149. try
  2150. GetEnvironmentPaths;
  2151. except
  2152. {$IFDEF SHOW_ENVIRONMENTPATH_ERRORS}
  2153. on E : Exception do
  2154. begin
  2155. if not IsService then
  2156. begin
  2157. if HasConsoleOutput then Writeln(Format('[WARN] GetEnvironmentPaths: %s',[E.Message]))
  2158. else MessageBox(0,PWideChar(Format('Get environment path error: %s',[E.Message])),'GetEnvironmentPaths',MB_ICONEXCLAMATION);
  2159. end;
  2160. end;
  2161. {$ENDIF}
  2162. end;
  2163. {$ENDIF}
  2164. end.