Quick.Commons.pas 61 KB

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