Quick.Commons.pas 61 KB

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