Quick.Commons.pas 61 KB

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