Quick.Commons.pas 48 KB

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