2
0

Quick.Commons.pas 62 KB

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