Quick.Commons.pas 46 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820
  1. { ***************************************************************************
  2. Copyright (c) 2016-2020 Kike Pérez
  3. Unit : Quick.Commons
  4. Description : Common functions
  5. Author : Kike Pérez
  6. Version : 1.9
  7. Created : 14/07/2017
  8. Modified : 16/01/2020
  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. ShlObj,
  31. {$ENDIF MSWINDOWS}
  32. {$IFDEF FPC}
  33. Quick.Files,
  34. {$IFDEF LINUX}
  35. FileInfo,
  36. {$ENDIF}
  37. {$ELSE}
  38. IOUtils,
  39. {$ENDIF}
  40. {$IFDEF ANDROID}
  41. Androidapi.JNI.Os,
  42. Androidapi.Helpers,
  43. Androidapi.JNI.JavaTypes,
  44. Androidapi.JNI.GraphicsContentViewText,
  45. {$ENDIF}
  46. {$IFDEF IOS}
  47. iOSapi.UIKit,
  48. Posix.SysSysctl,
  49. Posix.StdDef,
  50. iOSapi.Foundation,
  51. Macapi.ObjectiveC,
  52. Macapi.Helpers,
  53. {$ENDIF}
  54. {$IFDEF OSX}
  55. Macapi.Foundation,
  56. Macapi.Helpers,
  57. FMX.Helpers.Mac,
  58. Macapi.ObjectiveC,
  59. {$ENDIF}
  60. {$IFDEF POSIX}
  61. Posix.Unistd,
  62. {$ENDIF}
  63. DateUtils;
  64. type
  65. TLogEventType = (etInfo, etSuccess, etWarning, etError, etDebug, etTrace);
  66. TLogVerbose = set of TLogEventType;
  67. const
  68. LOG_ONLYERRORS = [etInfo,etError];
  69. LOG_ERRORSANDWARNINGS = [etInfo,etWarning,etError];
  70. LOG_TRACE = [etInfo,etError,etWarning,etTrace];
  71. LOG_ALL = [etInfo,etSuccess,etWarning,etError,etTrace];
  72. LOG_DEBUG = [etInfo,etSuccess,etWarning,etError,etDebug];
  73. {$IFDEF DELPHIXE7_UP}
  74. EventStr : array of string = ['INFO','SUCC','WARN','ERROR','DEBUG','TRACE'];
  75. {$ELSE}
  76. EventStr : array[0..5] of string = ('INFO','SUCC','WARN','ERROR','DEBUG','TRACE');
  77. {$ENDIF}
  78. type
  79. TPasswordComplexity = set of (pfIncludeNumbers,pfIncludeSigns);
  80. {$IFDEF MSWINDOWS}
  81. TEnvironmentPath = record
  82. EXEPATH : string;
  83. WINDOWS : string;
  84. SYSTEM : string;
  85. PROGRAMFILES : string;
  86. COMMONFILES : string;
  87. HOMEDRIVE : string;
  88. TEMP : string;
  89. USERPROFILE : string;
  90. INSTDRIVE : string;
  91. DESKTOP : string;
  92. STARTMENU : string;
  93. DESKTOP_ALLUSERS : string;
  94. STARTMENU_ALLUSERS : string;
  95. STARTUP : string;
  96. APPDATA : String;
  97. PROGRAMDATA : string;
  98. ALLUSERSPROFILE : string;
  99. end;
  100. {$ENDIF MSWINDOWS}
  101. {$IFNDEF FPC}
  102. TFileHelper = record helper for TFile
  103. {$IF DEFINED(MSWINDOWS) OR DEFINED(DELPHILINUX)}
  104. class function IsInUse(const FileName : string) : Boolean; static;
  105. {$ENDIF}
  106. class function GetSize(const FileName: String): Int64; static;
  107. end;
  108. TDirectoryHelper = record helper for TDirectory
  109. class function GetSize(const Path: String): Int64; static;
  110. end;
  111. {$ENDIF}
  112. {$IFDEF FPC}
  113. {$IFDEF LINUX}
  114. UINT = cardinal;
  115. {$ENDIF}
  116. PLASTINPUTINFO = ^LASTINPUTINFO;
  117. tagLASTINPUTINFO = record
  118. cbSize: UINT;
  119. dwTime: DWORD;
  120. end;
  121. LASTINPUTINFO = tagLASTINPUTINFO;
  122. TLastInputInfo = LASTINPUTINFO;
  123. type
  124. TCmdLineSwitchType = (clstValueNextParam, clstValueAppended);
  125. TCmdLineSwitchTypes = set of TCmdLineSwitchType;
  126. {$ENDIF}
  127. TCounter = record
  128. private
  129. fMaxValue : Integer;
  130. fCurrentValue : Integer;
  131. public
  132. property MaxValue : Integer read fMaxValue;
  133. procedure Init(aMaxValue : Integer);
  134. function Count : Integer;
  135. function CountIs(aValue : Integer) : Boolean;
  136. function Check : Boolean;
  137. procedure Reset;
  138. end;
  139. TTimeCounter = record
  140. private
  141. fCurrentTime : TDateTime;
  142. fDoneEvery : Integer;
  143. public
  144. property DoneEvery : Integer read fDoneEvery;
  145. procedure Init(MillisecondsToReach : Integer);
  146. function Check : Boolean;
  147. procedure Reset;
  148. end;
  149. {$IFNDEF FPC}
  150. TArrayOfStringHelper = record helper for TArray<string>
  151. public
  152. function Add(const aValue : string) : Integer;
  153. function AddIfNotExists(const aValue : string; aCaseSense : Boolean = False) : Integer;
  154. function Remove(const aValue : string) : Boolean;
  155. function Exists(const aValue : string) : Boolean;
  156. function Count : Integer;
  157. end;
  158. {$ENDIF}
  159. TPairItem = record
  160. Name : string;
  161. Value : string;
  162. constructor Create(const aName, aValue : string);
  163. end;
  164. TPairList = class
  165. type
  166. TPairEnumerator = class
  167. private
  168. fArray : ^TArray<TPairItem>;
  169. fIndex : Integer;
  170. function GetCurrent: TPairItem;
  171. public
  172. constructor Create(var aArray: TArray<TPairItem>);
  173. property Current : TPairItem read GetCurrent;
  174. function MoveNext: Boolean;
  175. end;
  176. private
  177. fItems : TArray<TPairItem>;
  178. public
  179. function GetEnumerator : TPairEnumerator;
  180. function GetValue(const aName : string) : string;
  181. function GetPair(const aName : string) : TPairItem;
  182. function Add(aPair : TPairItem) : Integer; overload;
  183. function Add(const aName, aValue : string) : Integer; overload;
  184. procedure AddOrUpdate(const aName, aValue : string);
  185. function Exists(const aName : string) : Boolean;
  186. function Remove(const aName : string) : Boolean;
  187. function Count : Integer;
  188. property Items[const aName : string] : string read GetValue write AddOrUpdate;
  189. function ToArray : TArray<TPairItem>;
  190. procedure FromArray(aValue : TArray<TPairItem>);
  191. end;
  192. EEnvironmentPath = class(Exception);
  193. EShellError = class(Exception);
  194. //generates a random password with complexity options
  195. function RandomPassword(const PasswordLength : Integer; Complexity : TPasswordComplexity = [pfIncludeNumbers,pfIncludeSigns]) : string;
  196. //generates a random string
  197. function RandomString(const aLength: Integer) : string;
  198. //extracts file extension from a filename
  199. function ExtractFileNameWithoutExt(const FileName: string): string;
  200. //converts a Unix path to Windows path
  201. function UnixToWindowsPath(const UnixPath: string): string;
  202. //converts a Windows path to Unix path
  203. function WindowsToUnixPath(const WindowsPath: string): string;
  204. //corrects malformed urls
  205. function CorrectURLPath(cUrl : string) : string;
  206. {$IFDEF MSWINDOWS}
  207. //get typical environment paths as temp, desktop, etc
  208. procedure GetEnvironmentPaths;
  209. function GetSpecialFolderPath(folderID : Integer) : string;
  210. //checks if running on a 64bit OS
  211. function Is64bitOS : Boolean;
  212. //checks if is a console app
  213. function IsConsole : Boolean;
  214. function HasConsoleOutput : Boolean;
  215. //checks if compiled in debug mode
  216. {$ENDIF}
  217. function IsDebug : Boolean;
  218. {$IFDEF MSWINDOWS}
  219. //checks if running as a service
  220. function IsService : Boolean;
  221. //gets number of seconds without user interaction (mouse, keyboard)
  222. function SecondsIdle: DWord;
  223. //frees process memory not needed
  224. procedure FreeUnusedMem;
  225. //changes screen resolution
  226. function SetScreenResolution(Width, Height: integer): Longint;
  227. {$ENDIF MSWINDOWS}
  228. //returns last day of current month
  229. function LastDayCurrentMonth: TDateTime;
  230. {$IFDEF FPC}
  231. function DateTimeInRange(ADateTime: TDateTime; AStartDateTime, AEndDateTime: TDateTime; aInclusive: Boolean = True): Boolean;
  232. {$ENDIF}
  233. //checks if two datetimes are in same day
  234. function IsSameDay(cBefore, cNow : TDateTime) : Boolean;
  235. //change Time of a DateTime
  236. function ChangeTimeOfADay(aDate : TDateTime; aHour, aMinute, aSecond : Word; aMilliSecond : Word = 0) : TDateTime;
  237. //change Date of a DateTime
  238. function ChangeDateOfADay(aDate : TDateTime; aYear, aMonth, aDay : Word) : TDateTime;
  239. //returns n times a char
  240. function FillStr(const C : Char; const Count : Integer) : string;
  241. //checks if string exists in array of string
  242. function StrInArray(const aValue : string; const aInArray : array of string) : Boolean;
  243. //checks if integer exists in array of integer
  244. function IntInArray(const aValue : Integer; const aInArray : array of Integer) : Boolean;
  245. //check if array is empty
  246. function IsEmptyArray(aArray : TArray<string>) : Boolean; overload;
  247. function IsEmptyArray(aArray : TArray<Integer>) : Boolean; overload;
  248. //returns a number leading zero
  249. function Zeroes(const Number, Len : Int64) : string;
  250. //converts a number to thousand delimeter string
  251. function NumberToStr(const Number : Int64) : string;
  252. //returns n spaces
  253. function Spaces(const Count : Integer) : string;
  254. //returns current date as a string
  255. function NowStr : string;
  256. //returns a new GUID as string
  257. function NewGuidStr : string;
  258. //compare a string with a wildcard pattern (? or *)
  259. function IsLike(cText, Pattern: string) : Boolean;
  260. //Upper case for first letter
  261. function Capitalize(s: string): string;
  262. function CapitalizeWords(s: string): string;
  263. //returns current logged user
  264. function GetLoggedUserName : string;
  265. //returns computer name
  266. function GetComputerName : string;
  267. //Changes incorrect delims in path
  268. function NormalizePathDelim(const cPath : string; const Delim : Char) : string;
  269. //Removes last segment of a path
  270. function RemoveLastPathSegment(cDir : string) : string;
  271. //returns path delimiter if found
  272. function GetPathDelimiter(const aPath : string) : string;
  273. //returns first segment of a path
  274. function GetFirstPathSegment(const aPath : string) : string;
  275. //returns last segment of a path
  276. function GetLastPathSegment(const aPath : string) : string;
  277. //finds swith in commandline params
  278. function ParamFindSwitch(const Switch : string) : Boolean;
  279. //gets value for a switch if exists
  280. function ParamGetSwitch(const Switch : string; var cvalue : string) : Boolean;
  281. //returns app name (filename based)
  282. function GetAppName : string;
  283. //returns app version (major & minor)
  284. function GetAppVersionStr: string;
  285. //returns app version full (major, minor, release & compiled)
  286. function GetAppVersionFullStr: string;
  287. //convert UTC DateTime to Local DateTime
  288. function UTCToLocalTime(GMTTime: TDateTime): TDateTime;
  289. //convert Local DateTime to UTC DateTime
  290. function LocalTimeToUTC(LocalTime : TDateTime): TDateTime;
  291. //convert DateTime to GTM Time string
  292. function DateTimeToGMT(aDate : TDateTime) : string;
  293. //convert GMT Time string to DateTime
  294. function GMTToDateTime(aDate : string) : TDateTime;
  295. //convert DateTime to Json Date format
  296. function DateTimeToJsonDate(aDateTime : TDateTime) : string;
  297. //convert Json Date format to DateTime
  298. function JsonDateToDateTime(const aJsonDate : string) : TDateTime;
  299. //count number of digits of a Integer
  300. function CountDigits(anInt: Cardinal): Cardinal; inline;
  301. //count times a string is present in other string
  302. function CountStr(const aFindStr, aSourceStr : string) : Integer;
  303. //save stream to file
  304. procedure SaveStreamToFile(aStream : TStream; const aFilename : string);
  305. //save stream to string
  306. function StreamToString(aStream : TStream) : string;
  307. function StreamToString2(const aStream: TStream; const aEncoding: TEncoding): string;
  308. //save string to stream
  309. procedure StringToStream(const aStr : string; aStream : TStream);
  310. procedure StringToStream2(const aStr : string; aStream : TStream);
  311. //returns a real comma separated text from stringlist
  312. function CommaText(aList : TStringList) : string; overload;
  313. //returns a real comma separated text from array of string
  314. function CommaText(aArray : TArray<string>) : string; overload;
  315. //converts TStrings to array
  316. function StringsToArray(aStrings : TStrings) : TArray<string>;
  317. {$IFDEF MSWINDOWS}
  318. //process messages on console applications
  319. procedure ProcessMessages;
  320. //get last error message
  321. function GetLastOSError : String;
  322. {$ENDIF}
  323. {$IF DEFINED(FPC) AND DEFINED(MSWINDOWS)}
  324. function GetLastInputInfo(var plii: TLastInputInfo): BOOL;stdcall; external 'user32' name 'GetLastInputInfo';
  325. {$ENDIF}
  326. function RemoveLastChar(const aText : string) : string;
  327. function DateTimeToSQL(aDateTime : TDateTime) : string;
  328. function IsInteger(const aValue : string) : Boolean;
  329. //extract a substring and deletes from source string
  330. function ExtractStr(var vSource : string; aIndex : Integer; aCount : Integer) : string;
  331. //get first string between string delimiters
  332. function GetSubString(const aSource, aFirstDelimiter, aLastDelimiter : string) : string;
  333. //get double quoted or dequoted string
  334. function DbQuotedStr(const str : string): string;
  335. function UnDbQuotedStr(const str: string) : string;
  336. {$IFDEF MSWINDOWS}
  337. var
  338. path : TEnvironmentPath;
  339. {$ENDIF}
  340. implementation
  341. {TFileHelper}
  342. {$IFNDEF FPC}
  343. {$IFDEF MSWINDOWS}
  344. class function TFileHelper.IsInUse(const FileName : string) : Boolean;
  345. var
  346. HFileRes: HFILE;
  347. begin
  348. Result := False;
  349. if not FileExists(FileName) then Exit;
  350. try
  351. HFileRes := CreateFile(PChar(FileName)
  352. ,GENERIC_READ or GENERIC_WRITE
  353. ,0
  354. ,nil
  355. ,OPEN_EXISTING
  356. ,FILE_ATTRIBUTE_NORMAL
  357. ,0);
  358. Result := (HFileRes = INVALID_HANDLE_VALUE);
  359. if not(Result) then begin
  360. CloseHandle(HFileRes);
  361. end;
  362. except
  363. Result := True;
  364. end;
  365. end;
  366. {$ENDIF}
  367. {$IFDEF DELPHILINUX}
  368. class function TFileHelper.IsInUse(const FileName : string) : Boolean;
  369. var
  370. fs : TFileStream;
  371. begin
  372. try
  373. fs := TFileStream.Create(FileName, fmOpenReadWrite, fmShareExclusive);
  374. Result := True;
  375. fs.Free;
  376. except
  377. Result := False;
  378. end;
  379. end;
  380. {$ENDIF}
  381. {$IFDEF MSWINDOWS}
  382. class function TFileHelper.GetSize(const FileName: String): Int64;
  383. var
  384. info: TWin32FileAttributeData;
  385. begin
  386. Result := -1;
  387. if not GetFileAttributesEx(PWideChar(FileName), GetFileExInfoStandard, @info) then Exit;
  388. Result := Int64(info.nFileSizeLow) or Int64(info.nFileSizeHigh shl 32);
  389. end;
  390. {$ELSE}
  391. class function TFileHelper.GetSize(const FileName: String): Int64;
  392. var
  393. sr : TSearchRec;
  394. begin
  395. if FindFirst(fileName, faAnyFile, sr ) = 0 then Result := sr.Size
  396. else Result := -1;
  397. end;
  398. {$ENDIF}
  399. {TDirectoryHelper}
  400. class function TDirectoryHelper.GetSize(const Path: String): Int64;
  401. var
  402. filename : string;
  403. begin
  404. Result := -1;
  405. for filename in TDirectory.GetFiles(Path) do
  406. begin
  407. Result := Result + TFile.GetSize(filename);
  408. end;
  409. end;
  410. {$ENDIF}
  411. {other functions}
  412. function RandomPassword(const PasswordLength : Integer; Complexity : TPasswordComplexity = [pfIncludeNumbers,pfIncludeSigns]) : string;
  413. const
  414. PassAlpha = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
  415. PassSigns = '@!&$';
  416. PassNumbers = '1234567890';
  417. var
  418. MinNumbers,
  419. MinSigns : Integer;
  420. NumNumbers,
  421. NumSigns : Integer;
  422. begin
  423. Result := '';
  424. Randomize;
  425. //fill all alfa
  426. repeat
  427. Result := Result + PassAlpha[Random(Length(PassAlpha))+1];
  428. until (Length(Result) = PasswordLength);
  429. //checks if need include numbers
  430. if pfIncludeNumbers in Complexity then
  431. begin
  432. MinNumbers := Round(PasswordLength / 10 * 2);
  433. NumNumbers := 0;
  434. if MinNumbers = 0 then MinNumbers := 1;
  435. repeat
  436. Result[Random(PasswordLength)+1] := PassNumbers[Random(Length(PassNumbers))+1];
  437. Inc(NumNumbers);
  438. until NumNumbers = MinNumbers;
  439. end;
  440. //checks if need include signs
  441. if pfIncludeNumbers in Complexity then
  442. begin
  443. MinSigns := Round(PasswordLength / 10 * 1);
  444. NumSigns := 0;
  445. if MinSigns = 0 then MinSigns := 1;
  446. repeat
  447. Result[Random(PasswordLength)+1] := PassSigns[Random(Length(PassSigns))+1];
  448. Inc(NumSigns);
  449. until NumSigns = MinSigns;
  450. end;
  451. end;
  452. function RandomString(const aLength: Integer) : string;
  453. const
  454. chars : string = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890';
  455. var
  456. i : Integer;
  457. clong : Integer;
  458. begin
  459. clong := High(chars);
  460. SetLength(Result, aLength);
  461. for i := 1 to aLength do
  462. begin
  463. Result[i] := chars[Random(clong) + 1];
  464. end;
  465. end;
  466. function ExtractFileNameWithoutExt(const FileName: string): string;
  467. begin
  468. Result := TPath.GetFileNameWithoutExtension(FileName);
  469. end;
  470. function UnixToWindowsPath(const UnixPath: string): string;
  471. begin
  472. Result := StringReplace(UnixPath, '/', '\',[rfReplaceAll, rfIgnoreCase]);
  473. end;
  474. function WindowsToUnixPath(const WindowsPath: string): string;
  475. begin
  476. Result := StringReplace(WindowsPath, '\', '/',[rfReplaceAll, rfIgnoreCase]);
  477. end;
  478. function CorrectURLPath(cUrl : string) : string;
  479. var
  480. nurl : string;
  481. begin
  482. nurl := WindowsToUnixPath(cUrl);
  483. nurl := StringReplace(nurl,'//','/',[rfReplaceAll]);
  484. Result := StringReplace(nurl,' ','%20',[rfReplaceAll]);
  485. //TNetEncoding.Url.Encode()
  486. end;
  487. {$IFDEF MSWINDOWS}
  488. procedure GetEnvironmentPaths;
  489. begin
  490. //gets path
  491. path.EXEPATH := TPath.GetDirectoryName(ParamStr(0));
  492. path.WINDOWS := SysUtils.GetEnvironmentVariable('windir');
  493. path.PROGRAMFILES := SysUtils.GetEnvironmentVariable('ProgramFiles');
  494. path.COMMONFILES := SysUtils.GetEnvironmentVariable('CommonProgramFiles(x86)');
  495. path.HOMEDRIVE := SysUtils.GetEnvironmentVariable('SystemDrive');
  496. path.USERPROFILE := SysUtils.GetEnvironmentVariable('USERPROFILE');
  497. path.PROGRAMDATA := SysUtils.GetEnvironmentVariable('ProgramData');
  498. path.ALLUSERSPROFILE := SysUtils.GetEnvironmentVariable('AllUsersProfile');
  499. path.INSTDRIVE := path.HOMEDRIVE;
  500. path.TEMP := SysUtils.GetEnvironmentVariable('TEMP');
  501. //these paths fail if user is SYSTEM
  502. try
  503. path.SYSTEM := GetSpecialFolderPath(CSIDL_SYSTEM);
  504. path.APPDATA := GetSpecialFolderPath(CSIDL_APPDATA);
  505. path.DESKTOP := GetSpecialFolderPath(CSIDL_DESKTOP);
  506. path.DESKTOP_ALLUSERS := GetSpecialFolderPath(CSIDL_COMMON_DESKTOPDIRECTORY);
  507. path.STARTMENU:=GetSpecialFolderPath(CSIDL_PROGRAMS);
  508. path.STARTMENU_ALLUSERS:=GetSpecialFolderPath(CSIDL_COMMON_PROGRAMS);
  509. path.STARTMENU_ALLUSERS := path.STARTMENU;
  510. path.STARTUP:=GetSpecialFolderPath(CSIDL_STARTUP);
  511. except
  512. //
  513. end;
  514. end;
  515. function GetSpecialFolderPath(folderID : Integer) : string;
  516. var
  517. ppidl: PItemIdList;
  518. begin
  519. SHGetSpecialFolderLocation(0, folderID, ppidl);
  520. SetLength(Result, MAX_PATH);
  521. if not SHGetPathFromIDList(ppidl,{$IFDEF FPC}PAnsiChar(Result){$ELSE}PChar(Result){$ENDIF}) then
  522. begin
  523. raise EShellError.create(Format('GetSpecialFolderPath: Invalid PIPL (%d)',[folderID]));
  524. end;
  525. SetLength(Result, lStrLen({$IFDEF FPC}PAnsiChar(Result){$ELSE}PChar(Result){$ENDIF}));
  526. end;
  527. function Is64bitOS : Boolean;
  528. begin
  529. {$IFDEF WIN64}
  530. Result := True;
  531. {$ELSE}
  532. Result := False;
  533. {$ENDIF WIN64}
  534. end;
  535. function IsConsole: Boolean;
  536. begin
  537. {$IFDEF CONSOLE}
  538. Result := True;
  539. {$ELSE}
  540. Result := False;
  541. {$ENDIF CONSOLE}
  542. end;
  543. {$ENDIF}
  544. function HasConsoleOutput : Boolean;
  545. {$IFDEF MSWINDOWS}
  546. var
  547. stout : THandle;
  548. begin
  549. stout := GetStdHandle(Std_Output_Handle);
  550. Win32Check(stout <> Invalid_Handle_Value);
  551. Result := stout <> 0;
  552. end;
  553. {$ELSE}
  554. begin
  555. Result := IsConsole;
  556. end;
  557. {$ENDIF}
  558. function IsDebug: Boolean;
  559. begin
  560. {$IFDEF DEBUG}
  561. Result := True;
  562. {$ELSE}
  563. Result := False;
  564. {$ENDIF DEBUG}
  565. end;
  566. {$IFDEF MSWINDOWS}
  567. function IsService : Boolean;
  568. begin
  569. //only working with my Quick.AppService unit
  570. try
  571. Result := (IsConsole) and (not HasConsoleOutput);
  572. except
  573. Result := False;
  574. end;
  575. end;
  576. function SecondsIdle: DWord;
  577. var
  578. liInfo: TLastInputInfo;
  579. begin
  580. liInfo.cbSize := SizeOf(TLastInputInfo) ;
  581. GetLastInputInfo(liInfo) ;
  582. Result := (GetTickCount - liInfo.dwTime) DIV 1000;
  583. end;
  584. procedure FreeUnusedMem;
  585. begin
  586. if Win32Platform = VER_PLATFORM_WIN32_NT then SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);
  587. end;
  588. function SetScreenResolution(Width, Height: integer): Longint;
  589. var
  590. DeviceMode: TDeviceMode;
  591. begin
  592. with DeviceMode do
  593. begin
  594. dmSize := SizeOf(TDeviceMode);
  595. dmPelsWidth := Width;
  596. dmPelsHeight := Height;
  597. dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
  598. end;
  599. Result := ChangeDisplaySettings(DeviceMode, CDS_UPDATEREGISTRY);
  600. end;
  601. {$ENDIF MSWINDOWS}
  602. function LastDayCurrentMonth: TDateTime;
  603. begin
  604. Result := EncodeDate(YearOf(Now),MonthOf(Now), DaysInMonth(Now));
  605. end;
  606. {$IFDEF FPC}
  607. function DateTimeInRange(ADateTime: TDateTime; AStartDateTime, AEndDateTime: TDateTime; aInclusive: Boolean = True): Boolean;
  608. begin
  609. if aInclusive then
  610. Result := (AStartDateTime <= ADateTime) and (ADateTime <= AEndDateTime)
  611. else
  612. Result := (AStartDateTime < ADateTime) and (ADateTime < AEndDateTime);
  613. end;
  614. {$ENDIF}
  615. function IsSameDay(cBefore, cNow : TDateTime) : Boolean;
  616. begin
  617. //Test: Result := MinutesBetween(cBefore,cNow) < 1;
  618. Result := DateTimeInRange(cNow,StartOfTheDay(cBefore),EndOfTheDay(cBefore),True);
  619. end;
  620. function ChangeTimeOfADay(aDate : TDateTime; aHour, aMinute, aSecond : Word; aMilliSecond : Word = 0) : TDateTime;
  621. var
  622. y, m, d : Word;
  623. begin
  624. DecodeDate(aDate,y,m,d);
  625. Result := EncodeDateTime(y,m,d,aHour,aMinute,aSecond,aMilliSecond);
  626. end;
  627. function ChangeDateOfADay(aDate : TDateTime; aYear, aMonth, aDay : Word) : TDateTime;
  628. var
  629. h, m, s, ms : Word;
  630. begin
  631. DecodeTime(aDate,h,m,s,ms);
  632. Result := EncodeDateTime(aYear,aMonth,aDay,h,m,s,0);
  633. end;
  634. function FillStr(const C : Char; const Count : Integer) : string;
  635. var
  636. i : Integer;
  637. begin
  638. Result := '';
  639. for i := 1 to Count do Result := Result + C;
  640. end;
  641. function StrInArray(const aValue : string; const aInArray : array of string) : Boolean;
  642. var
  643. s : string;
  644. begin
  645. for s in aInArray do
  646. begin
  647. if s = aValue then Exit(True);
  648. end;
  649. Result := False;
  650. end;
  651. function IntInArray(const aValue : Integer; const aInArray : array of Integer) : Boolean;
  652. var
  653. i : Integer;
  654. begin
  655. for i in aInArray do
  656. begin
  657. if i = aValue then Exit(True);
  658. end;
  659. Result := False;
  660. end;
  661. function IsEmptyArray(aArray : TArray<string>) : Boolean;
  662. begin
  663. Result := Length(aArray) = 0;
  664. end;
  665. function IsEmptyArray(aArray : TArray<Integer>) : Boolean;
  666. begin
  667. Result := Length(aArray) = 0;
  668. end;
  669. function Zeroes(const Number, Len : Int64) : string;
  670. begin
  671. if Len > Length(IntToStr(Number)) then Result := FillStr('0',Len - Length(IntToStr(Number))) + IntToStr(Number)
  672. else Result := IntToStr(Number);
  673. end;
  674. function NumberToStr(const Number : Int64) : string;
  675. begin
  676. try
  677. Result := FormatFloat('0,',Number);
  678. except
  679. Result := '#Error';
  680. end;
  681. end;
  682. function Spaces(const Count : Integer) : string;
  683. begin
  684. Result := FillStr(' ',Count);
  685. end;
  686. function NowStr : string;
  687. begin
  688. Result := DateTimeToStr(Now());
  689. end;
  690. function NewGuidStr : string;
  691. var
  692. guid : TGUID;
  693. begin
  694. guid.NewGuid;
  695. Result := guid.ToString
  696. //GUIDToString(guid);
  697. end;
  698. function IsLike(cText, Pattern: string) : Boolean;
  699. var
  700. i, n : Integer;
  701. match : Boolean;
  702. wildcard : Boolean;
  703. CurrentPattern : Char;
  704. begin
  705. Result := False;
  706. wildcard := False;
  707. cText := LowerCase(cText);
  708. Pattern := LowerCase(Pattern);
  709. match := False;
  710. if (Pattern.Length > cText.Length) or (Pattern = '') then Exit;
  711. if Pattern = '*' then
  712. begin
  713. Result := True;
  714. Exit;
  715. end;
  716. for i := 1 to cText.Length do
  717. begin
  718. CurrentPattern := Pattern[i];
  719. if CurrentPattern = '*' then wildcard := True;
  720. if wildcard then
  721. begin
  722. n := Pos(Copy(Pattern,i+1,Pattern.Length),cText);
  723. if (n > i) or (Pattern.Length = i) then
  724. begin
  725. Result := True;
  726. Exit;
  727. end;
  728. end
  729. else
  730. begin
  731. if (cText[i] = CurrentPattern) or (CurrentPattern = '?') then match := True
  732. else match := False;
  733. end;
  734. end;
  735. Result := match;
  736. end;
  737. function Capitalize(s: string): string;
  738. begin
  739. Result := '';
  740. if s.Length = 0 then Exit;
  741. s := LowerCase(s,loUserLocale);
  742. Result := UpperCase(s[1],loUserLocale) + Trim(Copy(s, 2, s.Length));
  743. end;
  744. function CapitalizeWords(s: string): string;
  745. var
  746. cword : string;
  747. begin
  748. Result := '';
  749. if s.Length = 0 then Exit;
  750. s := LowerCase(s,loUserLocale);
  751. for cword in s.Split([' ']) do
  752. begin
  753. if Result = '' then Result := Capitalize(cword)
  754. else Result := Result + ' ' + Capitalize(cword);
  755. end;
  756. end;
  757. function GetLoggedUserName : string;
  758. {$IFDEF MSWINDOWS}
  759. const
  760. cnMaxUserNameLen = 254;
  761. var
  762. sUserName : string;
  763. dwUserNameLen : DWord;
  764. begin
  765. dwUserNameLen := cnMaxUserNameLen-1;
  766. SetLength( sUserName, cnMaxUserNameLen );
  767. GetUserName(PChar( sUserName ),dwUserNameLen );
  768. SetLength( sUserName, dwUserNameLen );
  769. Result := sUserName;
  770. end;
  771. {$ELSE}
  772. {$IF DEFINED(FPC) AND DEFINED(LINUX)}
  773. begin
  774. Result := GetEnvironmentVariable('USERNAME');
  775. end;
  776. {$ELSE}
  777. var
  778. {$IFNDEF NEXTGEN}
  779. plogin : PAnsiChar;
  780. {$ELSE}
  781. plogin : MarshaledAString;
  782. {$ENDIF}
  783. begin
  784. {$IFDEF POSIX}
  785. try
  786. plogin := getlogin;
  787. Result := Copy(plogin,1,Length(Trim(plogin)));
  788. except
  789. Result := 'N/A';
  790. end;
  791. {$ELSE}
  792. Result := 'N/A';
  793. {$ENDIF}
  794. //raise ENotImplemented.Create('Not Android GetLoggedUserName implemented!');
  795. end;
  796. {$ENDIF}
  797. {$ENDIF}
  798. {$IFDEF IOS}
  799. function GetDeviceModel : String;
  800. var
  801. size : size_t;
  802. buffer : array of Byte;
  803. begin
  804. sysctlbyname('hw.machine',nil,@size,nil,0);
  805. if size > 0 then
  806. begin
  807. SetLength(buffer, size);
  808. sysctlbyname('hw.machine',@buffer[0],@size,nil,0);
  809. Result := UTF8ToString(MarshaledAString(buffer));
  810. end
  811. else Result := EmptyStr;
  812. end;
  813. {$ENDIF}
  814. function GetComputerName : string;
  815. {$IFDEF MSWINDOWS}
  816. var
  817. dwLength: dword;
  818. begin
  819. dwLength := 253;
  820. SetLength(Result, dwLength+1);
  821. if not Windows.GetComputerName(pchar(result), dwLength) then Result := 'Not detected!';
  822. Result := pchar(result);
  823. end;
  824. {$ELSE}
  825. {$IF DEFINED(FPC) AND DEFINED(LINUX)}
  826. begin
  827. Result := GetEnvironmentVariable('COMPUTERNAME');
  828. end;
  829. {$ELSE} //Android gets model name
  830. {$IFDEF NEXTGEN}
  831. begin
  832. {$IFDEF ANDROID}
  833. Result := JStringToString(TJBuild.JavaClass.MODEL);
  834. {$ELSE} //IOS
  835. Result := GetDeviceModel;
  836. {$ENDIF}
  837. end;
  838. {$ELSE}
  839. {$IFDEF DELPHILINUX}
  840. var
  841. phost : PAnsiChar;
  842. begin
  843. try
  844. if gethostname(phost,_SC_HOST_NAME_MAX) = 0 then
  845. begin
  846. {$IFDEF DEBUG}
  847. Result := Copy(Trim(phost),1,Length(Trim(phost)));
  848. {$ELSE}
  849. Result := Copy(phost,1,Length(phost));
  850. {$ENDIF}
  851. end
  852. else Result := 'N/A.';
  853. except
  854. Result := 'N/A';
  855. end;
  856. end;
  857. {$ELSE} //OSX
  858. begin
  859. Result := NSStrToStr(TNSHost.Wrap(TNSHost.OCClass.currentHost).localizedName);
  860. end;
  861. {$ENDIF}
  862. {$ENDIF}
  863. {$ENDIF}
  864. {$ENDIF}
  865. function NormalizePathDelim(const cPath : string; const Delim : Char) : string;
  866. begin
  867. if Delim = '\' then Result := StringReplace(cPath,'/',Delim,[rfReplaceAll])
  868. else Result := StringReplace(cPath,'\',Delim,[rfReplaceAll]);
  869. end;
  870. function RemoveLastPathSegment(cDir : string) : string;
  871. var
  872. posi : Integer;
  873. delim : Char;
  874. EndsWithDelim : Boolean;
  875. begin
  876. if cDir.Contains('\') then delim := '\'
  877. else if cDir.Contains('/') then delim := '/'
  878. else
  879. begin
  880. Result := '';
  881. Exit;
  882. end;
  883. NormalizePathDelim(cDir,delim);
  884. if cDir.EndsWith(delim) then
  885. begin
  886. cDir := Copy(cDir,1,cDir.Length-1);
  887. EndsWithDelim := True;
  888. end
  889. else EndsWithDelim := False;
  890. if cDir.CountChar(delim) > 1 then posi := cDir.LastDelimiter(delim)
  891. else posi := Pos(delim,cDir)-1;
  892. if posi = cDir.Length then posi := 0;
  893. Result := Copy(cDir,1,posi);
  894. if (Result <> '') and (EndsWithDelim) then Result := Result + delim;
  895. end;
  896. function GetPathDelimiter(const aPath : string) : string;
  897. begin
  898. if aPath.Contains('/') then Result := '/'
  899. else if aPath.Contains('\') then Result := '\'
  900. else Result := '';
  901. end;
  902. function GetFirstPathSegment(const aPath : string) : string;
  903. var
  904. delimiter : string;
  905. spath : string;
  906. begin
  907. delimiter := GetPathDelimiter(aPath);
  908. if delimiter.IsEmpty then Exit(aPath);
  909. if aPath.StartsWith(delimiter) then spath := Copy(aPath,2,aPath.Length)
  910. else spath := aPath;
  911. Result := Copy(spath,0,spath.IndexOf(delimiter));
  912. end;
  913. function GetLastPathSegment(const aPath : string) : string;
  914. var
  915. delimiter : string;
  916. spath : string;
  917. begin
  918. delimiter := GetPathDelimiter(aPath);
  919. if delimiter.IsEmpty then Exit(aPath);
  920. if aPath.EndsWith(delimiter) then spath := Copy(aPath,0,aPath.Length - 1)
  921. else spath := aPath;
  922. Result := spath.Substring(spath.LastDelimiter(delimiter)+1);
  923. end;
  924. function ParamFindSwitch(const Switch : string) : Boolean;
  925. begin
  926. Result := FindCmdLineSwitch(Switch,['-', '/'],True);
  927. end;
  928. {$IFDEF FPC}
  929. function FindCmdLineSwitch(const Switch: string; var Value: string; IgnoreCase: Boolean = True;
  930. const SwitchTypes: TCmdLineSwitchTypes = [clstValueNextParam, clstValueAppended]): Boolean; overload;
  931. type
  932. TCompareProc = function(const S1, S2: string): Boolean;
  933. var
  934. Param: string;
  935. I, ValueOfs,
  936. SwitchLen, ParamLen: Integer;
  937. SameSwitch: TCompareProc;
  938. begin
  939. Result := False;
  940. Value := '';
  941. if IgnoreCase then
  942. SameSwitch := SameText else
  943. SameSwitch := SameStr;
  944. SwitchLen := Switch.Length;
  945. for I := 1 to ParamCount do
  946. begin
  947. Param := ParamStr(I);
  948. if CharInSet(Param.Chars[0], SwitchChars) and SameSwitch(Param.SubString(1,SwitchLen), Switch) then
  949. begin
  950. ParamLen := Param.Length;
  951. // Look for an appended value if the param is longer than the switch
  952. if (ParamLen > SwitchLen + 1) then
  953. begin
  954. // If not looking for appended value switches then this is not a matching switch
  955. if not (clstValueAppended in SwitchTypes) then
  956. Continue;
  957. ValueOfs := SwitchLen + 1;
  958. if Param.Chars[ValueOfs] = ':' then
  959. Inc(ValueOfs);
  960. Value := Param.SubString(ValueOfs, MaxInt);
  961. end
  962. // If the next param is not a switch, then treat it as the value
  963. else if (clstValueNextParam in SwitchTypes) and (I < ParamCount) and
  964. not CharInSet(ParamStr(I+1).Chars[0], SwitchChars) then
  965. Value := ParamStr(I+1);
  966. Result := True;
  967. Break;
  968. end;
  969. end;
  970. end;
  971. {$ENDIF}
  972. function ParamGetSwitch(const Switch : string; var cvalue : string) : Boolean;
  973. begin
  974. Result := FindCmdLineSwitch(Switch,cvalue,True,[clstValueAppended]);
  975. end;
  976. function GetAppName : string;
  977. begin
  978. Result := ExtractFilenameWithoutExt(ParamStr(0));
  979. end;
  980. function GetAppVersionStr: string;
  981. {$IFDEF MSWINDOWS}
  982. var
  983. Rec: LongRec;
  984. ver : Cardinal;
  985. begin
  986. ver := GetFileVersion(ParamStr(0));
  987. if ver <> Cardinal(-1) then
  988. begin
  989. Rec := LongRec(ver);
  990. Result := Format('%d.%d', [Rec.Hi, Rec.Lo]);
  991. end
  992. else Result := '';
  993. end;
  994. {$ELSE}
  995. {$IF DEFINED(FPC) AND DEFINED(LINUX)}
  996. var
  997. version : TProgramVersion;
  998. begin
  999. if GetProgramVersion(version) then Result := Format('%d.%d', [version.Major, version.Minor])
  1000. else Result := '';
  1001. end;
  1002. {$ELSE}
  1003. {$IFDEF NEXTGEN}
  1004. {$IFDEF ANDROID}
  1005. var
  1006. PkgInfo : JPackageInfo;
  1007. begin
  1008. PkgInfo := SharedActivity.getPackageManager.getPackageInfo(SharedActivity.getPackageName,0);
  1009. Result := IntToStr(PkgInfo.VersionCode);
  1010. end;
  1011. {$ELSE} //IOS
  1012. var
  1013. AppKey: Pointer;
  1014. AppBundle: NSBundle;
  1015. BuildStr : NSString;
  1016. begin
  1017. try
  1018. AppKey := (StrToNSStr('CFBundleVersion') as ILocalObject).GetObjectID;
  1019. AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
  1020. BuildStr := TNSString.Wrap(AppBundle.infoDictionary.objectForKey(AppKey));
  1021. Result := UTF8ToString(BuildStr.UTF8String);
  1022. except
  1023. Result := '';
  1024. end;
  1025. end;
  1026. {$ENDIF}
  1027. {$ELSE} //OSX
  1028. {$IFDEF OSX}
  1029. var
  1030. AppKey: Pointer;
  1031. AppBundle: NSBundle;
  1032. BuildStr : NSString;
  1033. begin
  1034. try
  1035. AppKey := (StrToNSStr('CFBundleVersion') as ILocalObject).GetObjectID;
  1036. AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
  1037. BuildStr := TNSString.Wrap(AppBundle.infoDictionary.objectForKey(AppKey));
  1038. Result := UTF8ToString(BuildStr.UTF8String);
  1039. except
  1040. Result := '';
  1041. end;
  1042. end;
  1043. {$ELSE}
  1044. begin
  1045. Result := '';
  1046. end;
  1047. {$ENDIF}
  1048. {$ENDIF}
  1049. {$ENDIF}
  1050. {$ENDIF}
  1051. function GetAppVersionFullStr: string;
  1052. {$IFDEF MSWINDOWS}
  1053. var
  1054. Exe: string;
  1055. Size, Handle: DWORD;
  1056. Buffer: TBytes;
  1057. FixedPtr: PVSFixedFileInfo;
  1058. begin
  1059. Result := '';
  1060. Exe := ParamStr(0);
  1061. Size := GetFileVersionInfoSize(PChar(Exe), Handle);
  1062. if Size = 0 then
  1063. begin
  1064. //RaiseLastOSError;
  1065. //no version info in file
  1066. Exit;
  1067. end;
  1068. SetLength(Buffer, Size);
  1069. if not GetFileVersionInfo(PChar(Exe), Handle, Size, Buffer) then
  1070. RaiseLastOSError;
  1071. if not VerQueryValue(Buffer, '\', Pointer(FixedPtr), Size) then
  1072. RaiseLastOSError;
  1073. if (LongRec(FixedPtr.dwFileVersionLS).Hi = 0) and (LongRec(FixedPtr.dwFileVersionLS).Lo = 0) then
  1074. begin
  1075. Result := Format('%d.%d',
  1076. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  1077. LongRec(FixedPtr.dwFileVersionMS).Lo]); //minor
  1078. end
  1079. else if (LongRec(FixedPtr.dwFileVersionLS).Lo = 0) then
  1080. begin
  1081. Result := Format('%d.%d.%d',
  1082. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  1083. LongRec(FixedPtr.dwFileVersionMS).Lo, //minor
  1084. LongRec(FixedPtr.dwFileVersionLS).Hi]); //release
  1085. end
  1086. else
  1087. begin
  1088. Result := Format('%d.%d.%d.%d',
  1089. [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
  1090. LongRec(FixedPtr.dwFileVersionMS).Lo, //minor
  1091. LongRec(FixedPtr.dwFileVersionLS).Hi, //release
  1092. LongRec(FixedPtr.dwFileVersionLS).Lo]); //build
  1093. end;
  1094. end;
  1095. {$ELSE}
  1096. {$IF DEFINED(FPC) AND DEFINED(LINUX)}
  1097. var
  1098. version : TProgramVersion;
  1099. begin
  1100. if GetProgramVersion(version) then Result := Format('%d.%d.%d.%d', [version.Major, version.Minor, version.Revision, version.Build])
  1101. else Result := '';
  1102. end;
  1103. {$ELSE}
  1104. {$IFDEF NEXTGEN}
  1105. {$IFDEF ANDROID}
  1106. var
  1107. PkgInfo : JPackageInfo;
  1108. begin
  1109. PkgInfo := SharedActivity.getPackageManager.getPackageInfo(SharedActivity.getPackageName,0);
  1110. Result := JStringToString(PkgInfo.versionName);
  1111. end;
  1112. {$ELSE} //IOS
  1113. var
  1114. AppKey: Pointer;
  1115. AppBundle: NSBundle;
  1116. BuildStr : NSString;
  1117. begin
  1118. AppKey := (StrToNSStr('CFBundleVersion') as ILocalObject).GetObjectID;
  1119. AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
  1120. BuildStr := TNSString.Wrap(AppBundle.infoDictionary.objectForKey(AppKey));
  1121. Result := UTF8ToString(BuildStr.UTF8String);
  1122. end;
  1123. {$ENDIF}
  1124. {$ELSE}
  1125. {$IFDEF OSX}
  1126. var
  1127. AppKey: Pointer;
  1128. AppBundle: NSBundle;
  1129. BuildStr : NSString;
  1130. begin
  1131. AppKey := (StrToNSStr('CFBundleVersion') as ILocalObject).GetObjectID;
  1132. AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
  1133. BuildStr := TNSString.Wrap(AppBundle.infoDictionary.objectForKey(AppKey));
  1134. Result := UTF8ToString(BuildStr.UTF8String);
  1135. end;
  1136. {$ELSE}
  1137. begin
  1138. Result := '';
  1139. end;
  1140. {$ENDIF}
  1141. {$ENDIF}
  1142. {$ENDIF}
  1143. {$ENDIF}
  1144. function UTCToLocalTime(GMTTime: TDateTime): TDateTime;
  1145. begin
  1146. {$IFDEF FPC}
  1147. Result := LocalTimeToUniversal(GMTTime);
  1148. {$ELSE}
  1149. Result := TTimeZone.Local.ToLocalTime(GMTTime);
  1150. {$ENDIF}
  1151. end;
  1152. function LocalTimeToUTC(LocalTime : TDateTime): TDateTime;
  1153. begin
  1154. {$IFDEF FPC}
  1155. Result := UniversalTimeToLocal(Localtime);
  1156. {$ELSE}
  1157. Result := TTimeZone.Local.ToUniversalTime(LocalTime);
  1158. {$ENDIF}
  1159. end;
  1160. function DateTimeToGMT(aDate : TDateTime) : string;
  1161. var
  1162. FmtSettings : TFormatSettings;
  1163. begin
  1164. FmtSettings.DateSeparator := '-';
  1165. FmtSettings.TimeSeparator := ':';
  1166. FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ" GMT"';
  1167. Result := DateTimeToStr(aDate,FmtSettings).Trim;
  1168. end;
  1169. function GMTToDateTime(aDate : string) : TDateTime;
  1170. var
  1171. FmtSettings : TFormatSettings;
  1172. begin
  1173. FmtSettings.DateSeparator := '-';
  1174. FmtSettings.TimeSeparator := ':';
  1175. FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ" GMT"';
  1176. Result := StrToDateTime(aDate,FmtSettings);
  1177. end;
  1178. function DateTimeToJsonDate(aDateTime : TDateTime) : string;
  1179. {$IFNDEF DELPHIXE7_UP}
  1180. var
  1181. FmtSettings : TFormatSettings;
  1182. {$ENDIF}
  1183. begin
  1184. {$IFDEF DELPHIXE7_UP}
  1185. Result := DateToISO8601(aDateTime);
  1186. {$ELSE}
  1187. FmtSettings.DateSeparator := '-';
  1188. FmtSettings.TimeSeparator := ':';
  1189. FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ"Z"';
  1190. Result := DateTimeToStr(aDateTime,FmtSettings).Trim;
  1191. {$ENDIF}
  1192. end;
  1193. function JsonDateToDateTime(const aJsonDate : string) : TDateTime;
  1194. {$IFNDEF DELPHIXE7_UP}
  1195. var
  1196. FmtSettings : TFormatSettings;
  1197. {$ENDIF}
  1198. {$IFDEF FPC}
  1199. var
  1200. jdate : string;
  1201. {$ENDIF}
  1202. begin
  1203. {$IFDEF DELPHIXE7_UP}
  1204. Result := ISO8601ToDate(aJsonDate);
  1205. {$ELSE}
  1206. FmtSettings.DateSeparator := '-';
  1207. FmtSettings.TimeSeparator := ':';
  1208. FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ"Z"';
  1209. {$IFDEF FPC}
  1210. jdate := StringReplace(aJsondate,'T',' ',[rfIgnoreCase]);
  1211. jdate := Copy(jdate,1,Pos('.',jdate)-1);
  1212. Result := StrToDateTime(jdate,FmtSettings);
  1213. {$ELSE}
  1214. Result := StrToDateTime(aJsonDate,FmtSettings);
  1215. {$ENDIF}
  1216. {$ENDIF}
  1217. end;
  1218. function CountDigits(anInt: Cardinal): Cardinal; inline;
  1219. var
  1220. cmp: Cardinal;
  1221. begin
  1222. cmp := 10;
  1223. Result := 1;
  1224. while (Result < 10) and (cmp <= anInt) do
  1225. begin
  1226. cmp := cmp*10;
  1227. Inc(Result);
  1228. end;
  1229. end;
  1230. function CountStr(const aFindStr, aSourceStr : string) : Integer;
  1231. var
  1232. i : Integer;
  1233. found : Integer;
  1234. findstr : string;
  1235. mainstr : string;
  1236. begin
  1237. findstr := aFindStr.ToLower;
  1238. mainstr := aSourceStr.ToLower;
  1239. Result := 0;
  1240. i := 0;
  1241. while i < mainstr.Length do
  1242. begin
  1243. found := Pos(findstr,mainstr,i);
  1244. if found > 0 then
  1245. begin
  1246. i := found;
  1247. Inc(Result);
  1248. end
  1249. else Break;
  1250. end;
  1251. end;
  1252. procedure SaveStreamToFile(aStream : TStream; const aFileName : string);
  1253. var
  1254. fs : TFileStream;
  1255. begin
  1256. fs := TFileStream.Create(aFileName,fmCreate);
  1257. try
  1258. aStream.Seek(0,soBeginning);
  1259. fs.CopyFrom(aStream,aStream.Size);
  1260. finally
  1261. fs.Free;
  1262. end;
  1263. end;
  1264. function StreamToString(aStream : TStream) : string;
  1265. var
  1266. ss : TStringStream;
  1267. begin
  1268. aStream.Position := 0;
  1269. if aStream = nil then Exit;
  1270. if aStream is TMemoryStream then
  1271. begin
  1272. SetString(Result, PChar(TMemoryStream(aStream).Memory), TMemoryStream(aStream).Size div SizeOf(Char));
  1273. end
  1274. else if aStream is TStringStream then
  1275. begin
  1276. Result := TStringStream(aStream).DataString;
  1277. end
  1278. else
  1279. begin
  1280. ss := TStringStream.Create;
  1281. try
  1282. aStream.Seek(0,soBeginning);
  1283. ss.CopyFrom(aStream,aStream.Size);
  1284. Result := ss.DataString;
  1285. finally
  1286. ss.Free;
  1287. end;
  1288. end;
  1289. end;
  1290. function StreamToString2(const aStream: TStream; const aEncoding: TEncoding): string;
  1291. var
  1292. sbytes: TBytes;
  1293. begin
  1294. aStream.Position := 0;
  1295. SetLength(sbytes, aStream.Size);
  1296. aStream.ReadBuffer(sbytes,aStream.Size);
  1297. Result := aEncoding.GetString(sbytes);
  1298. end;
  1299. procedure StringToStream(const aStr : string; aStream : TStream);
  1300. begin
  1301. aStream.Seek(0,soBeginning);
  1302. aStream.WriteBuffer(Pointer(aStr)^,aStr.Length * SizeOf(Char));
  1303. end;
  1304. procedure StringToStream2(const aStr : string; aStream : TStream);
  1305. var
  1306. stream : TStringStream;
  1307. begin
  1308. stream := TStringStream.Create(aStr,TEncoding.UTF8);
  1309. try
  1310. aStream.CopyFrom(stream,stream.Size);
  1311. finally
  1312. stream.Free;
  1313. end;
  1314. end;
  1315. function CommaText(aList : TStringList) : string;
  1316. var
  1317. value : string;
  1318. sb : TStringBuilder;
  1319. begin
  1320. if aList.Text = '' then Exit;
  1321. sb := TStringBuilder.Create;
  1322. try
  1323. for value in aList do
  1324. begin
  1325. sb.Append(value);
  1326. sb.Append(',');
  1327. end;
  1328. if sb.Length > 1 then Result := sb.ToString(0, sb.Length - 1);
  1329. finally
  1330. sb.Free;
  1331. end;
  1332. end;
  1333. function CommaText(aArray : TArray<string>) : string;
  1334. var
  1335. value : string;
  1336. sb : TStringBuilder;
  1337. begin
  1338. if High(aArray) < 0 then Exit;
  1339. sb := TStringBuilder.Create;
  1340. try
  1341. for value in aArray do
  1342. begin
  1343. sb.Append(value);
  1344. sb.Append(',');
  1345. end;
  1346. if sb.Length > 1 then Result := sb.ToString(0, sb.Length - 1);
  1347. finally
  1348. sb.Free;
  1349. end;
  1350. end;
  1351. function StringsToArray(aStrings : TStrings) : TArray<string>;
  1352. var
  1353. i : Integer;
  1354. begin
  1355. if aStrings.Count = 0 then Exit;
  1356. SetLength(Result,aStrings.Count);
  1357. for i := 0 to aStrings.Count - 1 do
  1358. begin
  1359. Result[i] := aStrings[i];
  1360. end;
  1361. end;
  1362. { TCounter }
  1363. procedure TCounter.Init(aMaxValue : Integer);
  1364. begin
  1365. fMaxValue := aMaxValue;
  1366. fCurrentValue := 0;
  1367. end;
  1368. function TCounter.Count : Integer;
  1369. begin
  1370. Result := fCurrentValue;
  1371. end;
  1372. function TCounter.CountIs(aValue : Integer) : Boolean;
  1373. begin
  1374. Result := fCurrentValue = aValue;
  1375. end;
  1376. function TCounter.Check : Boolean;
  1377. begin
  1378. if fCurrentValue = fMaxValue then
  1379. begin
  1380. Result := True;
  1381. Reset;
  1382. end
  1383. else
  1384. begin
  1385. Result := False;
  1386. Inc(fCurrentValue);
  1387. end;
  1388. end;
  1389. procedure TCounter.Reset;
  1390. begin
  1391. fCurrentValue := fMaxValue;
  1392. end;
  1393. { TimeCounter }
  1394. procedure TTimeCounter.Init(MillisecondsToReach : Integer);
  1395. begin
  1396. fDoneEvery := MillisecondsToReach;
  1397. end;
  1398. function TTimeCounter.Check : Boolean;
  1399. begin
  1400. if MilliSecondsBetween(fCurrentTime,Now) > fDoneEvery then
  1401. begin
  1402. fCurrentTime := Now();
  1403. Result := True;
  1404. end
  1405. else Result := False;
  1406. end;
  1407. procedure TTimeCounter.Reset;
  1408. begin
  1409. fCurrentTime := Now();
  1410. end;
  1411. { TArrayOfStringHelper}
  1412. {$IFNDEF FPC}
  1413. function TArrayOfStringHelper.Add(const aValue : string) : Integer;
  1414. begin
  1415. SetLength(Self,Length(Self)+1);
  1416. Self[High(Self)] := aValue;
  1417. Result := High(Self);
  1418. end;
  1419. function TArrayOfStringHelper.AddIfNotExists(const aValue : string; aCaseSense : Boolean = False) : Integer;
  1420. var
  1421. i : Integer;
  1422. found : Boolean;
  1423. begin
  1424. found := False;
  1425. for i := Low(Self) to High(Self) do
  1426. begin
  1427. if aCaseSense then found := Self[i] = aValue
  1428. else
  1429. begin
  1430. found := CompareText(Self[i],aValue) = 0;
  1431. Exit(i)
  1432. end;
  1433. end;
  1434. if not found then
  1435. begin
  1436. //if not exists add it
  1437. i := Self.Add(aValue);
  1438. Exit(i);
  1439. end;
  1440. Result := -1;
  1441. end;
  1442. function TArrayOfStringHelper.Remove(const aValue : string) : Boolean;
  1443. var
  1444. i : Integer;
  1445. begin
  1446. for i := Low(Self) to High(Self) do
  1447. begin
  1448. if CompareText(Self[i],aValue) = 0 then
  1449. begin
  1450. System.Delete(Self,i,1);
  1451. Exit(True);
  1452. end;
  1453. end;
  1454. Result := False;
  1455. end;
  1456. function TArrayOfStringHelper.Exists(const aValue : string) : Boolean;
  1457. var
  1458. value : string;
  1459. begin
  1460. Result := False;
  1461. for value in Self do
  1462. begin
  1463. if CompareText(value,aValue) = 0 then Exit(True)
  1464. end;
  1465. end;
  1466. function TArrayOfStringHelper.Count : Integer;
  1467. begin
  1468. Result := High(Self) + 1;
  1469. end;
  1470. {$ENDIF}
  1471. { TPairItem }
  1472. constructor TPairItem.Create(const aName, aValue: string);
  1473. begin
  1474. Name := aName;
  1475. Value := aValue;
  1476. end;
  1477. { TPairList }
  1478. function TPairList.GetEnumerator : TPairEnumerator;
  1479. begin
  1480. Result := TPairEnumerator.Create(fItems);
  1481. end;
  1482. function TPairList.Add(aPair: TPairItem): Integer;
  1483. begin
  1484. SetLength(fItems,Length(fItems)+1);
  1485. fItems[High(fItems)] := aPair;
  1486. Result := High(fItems);
  1487. end;
  1488. function TPairList.Add(const aName, aValue: string): Integer;
  1489. begin
  1490. SetLength(fItems,Length(fItems)+1);
  1491. fItems[High(fItems)].Name := aName;
  1492. fItems[High(fItems)].Value := aValue;
  1493. Result := High(fItems);
  1494. end;
  1495. procedure TPairList.AddOrUpdate(const aName, aValue: string);
  1496. var
  1497. i : Integer;
  1498. begin
  1499. for i := Low(fItems) to High(fItems) do
  1500. begin
  1501. if CompareText(fItems[i].Name,aName) = 0 then
  1502. begin
  1503. fItems[i].Value := aValue;
  1504. Exit;
  1505. end;
  1506. end;
  1507. //if not exists add it
  1508. Self.Add(aName,aValue);
  1509. end;
  1510. function TPairList.Count: Integer;
  1511. begin
  1512. Result := High(fItems) + 1;
  1513. end;
  1514. function TPairList.Exists(const aName: string): Boolean;
  1515. var
  1516. i : Integer;
  1517. begin
  1518. Result := False;
  1519. for i := Low(fItems) to High(fItems) do
  1520. begin
  1521. if CompareText(fItems[i].Name,aName) = 0 then Exit(True)
  1522. end;
  1523. end;
  1524. function TPairList.GetPair(const aName: string): TPairItem;
  1525. var
  1526. i : Integer;
  1527. begin
  1528. for i := Low(fItems) to High(fItems) do
  1529. begin
  1530. if CompareText(fItems[i].Name,aName) = 0 then Exit(fItems[i]);
  1531. end;
  1532. end;
  1533. function TPairList.GetValue(const aName: string): string;
  1534. var
  1535. i : Integer;
  1536. begin
  1537. Result := '';
  1538. for i := Low(fItems) to High(fItems) do
  1539. begin
  1540. if CompareText(fItems[i].Name,aName) = 0 then Exit(fItems[i].Value);
  1541. end;
  1542. end;
  1543. function TPairList.Remove(const aName: string): Boolean;
  1544. var
  1545. i : Integer;
  1546. begin
  1547. for i := Low(fItems) to High(fItems) do
  1548. begin
  1549. if CompareText(fItems[i].Name,aName) = 0 then
  1550. begin
  1551. System.Delete(fItems,i,1);
  1552. Exit(True);
  1553. end;
  1554. end;
  1555. Result := False;
  1556. end;
  1557. function TPairList.ToArray : TArray<TPairItem>;
  1558. begin
  1559. Result := fItems;
  1560. end;
  1561. procedure TPairList.FromArray(aValue : TArray<TPairItem>);
  1562. begin
  1563. fItems := aValue;
  1564. end;
  1565. { TPairList.TPairEnumerator}
  1566. constructor TPairList.TPairEnumerator.Create(var aArray: TArray<TPairItem>);
  1567. begin
  1568. fIndex := -1;
  1569. fArray := @aArray;
  1570. end;
  1571. function TPairList.TPairEnumerator.GetCurrent : TPairItem;
  1572. begin
  1573. Result := TArray<TPairItem>(fArray^)[fIndex];
  1574. end;
  1575. function TPairList.TPairEnumerator.MoveNext: Boolean;
  1576. begin
  1577. Inc(fIndex);
  1578. Result := fIndex < High(TArray<TPairItem>(fArray^))+1;
  1579. end;
  1580. {$IFDEF MSWINDOWS}
  1581. procedure ProcessMessages;
  1582. var
  1583. Msg: TMsg;
  1584. begin
  1585. while integer(PeekMessage(Msg, 0, 0, 0, PM_REMOVE)) <> 0 do
  1586. begin
  1587. TranslateMessage(Msg);
  1588. DispatchMessage(Msg);
  1589. end;
  1590. end;
  1591. function GetLastOSError: String;
  1592. begin
  1593. Result := SysErrorMessage(Windows.GetLastError);
  1594. end;
  1595. {$ENDIF}
  1596. function RemoveLastChar(const aText : string) : string;
  1597. begin
  1598. Result := aText.Remove(aText.Length - 1);
  1599. end;
  1600. function DateTimeToSQL(aDateTime : TDateTime) : string;
  1601. begin
  1602. Result := FormatDateTime('YYYYMMDD hh:mm:ss',aDateTime);
  1603. end;
  1604. function IsInteger(const aValue : string) : Boolean;
  1605. var
  1606. i : Integer;
  1607. begin
  1608. Result := TryStrToInt(aValue,i);
  1609. end;
  1610. function ExtractStr(var vSource : string; aIndex : Integer; aCount : Integer) : string;
  1611. begin
  1612. if aIndex > vSource.Length then Exit('');
  1613. Result := Copy(vSource,aIndex,aCount);
  1614. Delete(vSource,aIndex,aCount);
  1615. end;
  1616. function GetSubString(const aSource, aFirstDelimiter, aLastDelimiter : string) : string;
  1617. var
  1618. i : Integer;
  1619. begin
  1620. i := Pos(aFirstDelimiter,aSource);
  1621. if i > -1 then Result := Copy(aSource, i + aFirstDelimiter.Length, Pos(aLastDelimiter, aSource, i + aFirstDelimiter.Length) - i - aFirstDelimiter.Length)
  1622. else Result := '';
  1623. end;
  1624. function DbQuotedStr(const str : string): string;
  1625. var
  1626. i : Integer;
  1627. begin
  1628. Result := str;
  1629. for i := Result.Length - 1 downto 0 do
  1630. begin
  1631. if Result.Chars[i] = '"' then Result := Result.Insert(i, '"');
  1632. end;
  1633. Result := '"' + Result + '"';
  1634. end;
  1635. function UnDbQuotedStr(const str: string) : string;
  1636. begin
  1637. Result := Trim(str);
  1638. if not Result.IsEmpty then
  1639. begin
  1640. if Result.StartsWith('"') then Result := Copy(Result, 2, Result.Length - 2);
  1641. end;
  1642. end;
  1643. {$IFDEF MSWINDOWS}
  1644. initialization
  1645. try
  1646. GetEnvironmentPaths;
  1647. except
  1648. {$IFDEF SHOW_ENVIRONMENTPATH_ERRORS}
  1649. on E : Exception do
  1650. begin
  1651. if not IsService then
  1652. begin
  1653. if HasConsoleOutput then Writeln(Format('[WARN] GetEnvironmentPaths: %s',[E.Message]))
  1654. else MessageBox(0,PWideChar(Format('Get environment path error: %s',[E.Message])),'GetEnvironmentPaths',MB_ICONEXCLAMATION);
  1655. end;
  1656. end;
  1657. {$ENDIF}
  1658. end;
  1659. {$ENDIF}
  1660. end.