12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438 |
- { ***************************************************************************
- Copyright (c) 2016-2024 Kike P�rez
- Unit : Quick.Commons
- Description : Common functions
- Author : Kike P�rez
- Version : 2.0
- Created : 14/07/2017
- Modified : 14/03/2024
- This file is part of QuickLib: https://github.com/exilon/QuickLib
- ***************************************************************************
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
- http://www.apache.org/licenses/LICENSE-2.0
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
- *************************************************************************** }
- unit Quick.Commons;
- {$i QuickLib.inc}
- interface
- uses
- Classes,
- SysUtils,
- Types,
- {$IFDEF MSWINDOWS}
- Windows,
- ActiveX,
- ShlObj,
- {$ENDIF MSWINDOWS}
- {$IFDEF FPC}
- Quick.Files,
- {$IFDEF LINUX}
- FileInfo,
- {$ENDIF}
- {$ELSE}
- IOUtils,
- {$ENDIF}
- {$IFDEF ANDROID}
- Androidapi.JNI.Os,
- Androidapi.Helpers,
- Androidapi.JNI.JavaTypes,
- Androidapi.JNI.GraphicsContentViewText,
- {$IFDEF DELPHIRX103_UP}
- Androidapi.JNI.App,
- {$ENDIF}
- {$ENDIF}
- {$IFDEF IOS}
- iOSapi.UIKit,
- Posix.SysSysctl,
- Posix.StdDef,
- iOSapi.Foundation,
- Macapi.ObjectiveC,
- Macapi.Helpers,
- {$ENDIF}
- {$IFDEF OSX}
- Macapi.Foundation,
- Macapi.Helpers,
- FMX.Helpers.Mac,
- Macapi.ObjectiveC,
- {$ENDIF}
- {$IFDEF POSIX}
- Posix.Unistd,
- {$ENDIF}
- DateUtils;
- type
- TLogEventType = (etInfo, etSuccess, etWarning, etError, etDebug, etDone, etTrace, etCritical, etException);
- TLogVerbose = set of TLogEventType;
- const
- LOG_ONLYERRORS = [etInfo,etError];
- LOG_ERRORSANDWARNINGS = [etInfo,etWarning,etError];
- LOG_TRACE = [etInfo,etError,etWarning,etTrace];
- LOG_ALL = [etInfo, etSuccess, etWarning, etError, etDebug, etDone, etTrace, etCritical, etException];
- LOG_DEBUG = [etInfo,etSuccess,etWarning,etError,etDebug];
- {$IFDEF DELPHIXE7_UP}
- EventStr : array of string = ['INFO','SUCC','WARN','ERROR','DEBUG','DONE','TRACE','CRITICAL','EXCEPTION'];
- {$ELSE}
- EventStr : array[0..8] of string = ('INFO','SUCC','WARN','ERROR','DEBUG','DONE','TRACE','CRITICAL','EXCEPTION');
- {$ENDIF}
- CRLF = #13#10;
- type
- TPasswordComplexity = set of (pfIncludeNumbers,pfIncludeSigns);
- TEnvironmentPath = record
- EXEPATH : string;
- {$IFDEF MSWINDOWS}
- WINDOWS : string;
- SYSTEM : string;
- PROGRAMFILES : string;
- COMMONFILES : string;
- HOMEDRIVE : string;
- TEMP : string;
- USERPROFILE : string;
- INSTDRIVE : string;
- DESKTOP : string;
- STARTMENU : string;
- DESKTOP_ALLUSERS : string;
- STARTMENU_ALLUSERS : string;
- STARTUP : string;
- APPDATA : String;
- PROGRAMDATA : string;
- ALLUSERSPROFILE : string;
- {$ENDIF MSWINDOWS}
- end;
- {$IFNDEF FPC}
- TFileHelper = record helper for TFile
- {$IF DEFINED(MSWINDOWS) OR DEFINED(DELPHILINUX)}
- class function IsInUse(const FileName : string) : Boolean; static;
- {$ENDIF}
- class function GetSize(const FileName: String): Int64; static;
- end;
- TDirectoryHelper = record helper for TDirectory
- class function GetSize(const Path: String): Int64; static;
- end;
- {$ENDIF}
- {$IFDEF FPC}
- {$IFDEF LINUX}
- UINT = cardinal;
- {$ENDIF}
- PLASTINPUTINFO = ^LASTINPUTINFO;
- tagLASTINPUTINFO = record
- cbSize: UINT;
- dwTime: DWORD;
- end;
- LASTINPUTINFO = tagLASTINPUTINFO;
- TLastInputInfo = LASTINPUTINFO;
- type
- TCmdLineSwitchType = (clstValueNextParam, clstValueAppended);
- TCmdLineSwitchTypes = set of TCmdLineSwitchType;
- {$ENDIF}
- TCounter = record
- private
- fMaxValue : Integer;
- fCurrentValue : Integer;
- public
- property MaxValue : Integer read fMaxValue;
- procedure Init(aMaxValue : Integer);
- function Count : Integer;
- function CountIs(aValue : Integer) : Boolean;
- function Check : Boolean;
- procedure Reset;
- end;
- TTimeCounter = record
- private
- fCurrentTime : TDateTime;
- fDoneEvery : Integer;
- public
- property DoneEvery : Integer read fDoneEvery;
- procedure Init(MillisecondsToReach : Integer);
- function Check : Boolean;
- procedure Reset;
- end;
- {$IFNDEF FPC}
- {$IFNDEF DELPHIXE7_UP}
- TArrayUtil<T> = class
- class procedure Delete(var aArray : TArray<T>; aIndex : Integer);
- end;
- {$ENDIF}
- TArrayOfStringHelper = record helper for TArray<string>
- public
- function Any : Boolean; overload;
- function Any(const aValue : string) : Boolean; overload;
- function Add(const aValue : string) : Integer;
- function AddIfNotExists(const aValue : string; aCaseSense : Boolean = False) : Integer;
- function Remove(const aValue : string) : Boolean;
- function Exists(const aValue : string) : Boolean;
- function Count : Integer;
- end;
- TDelegate<T> = reference to procedure(Value : T);
- {$ENDIF}
- TPairItem = record
- Name : string;
- Value : string;
- constructor Create(const aName, aValue : string);
- end;
- TPairList = class
- type
- TPairEnumerator = class
- private
- fArray : ^TArray<TPairItem>;
- fIndex : Integer;
- function GetCurrent: TPairItem;
- public
- constructor Create(var aArray: TArray<TPairItem>);
- property Current : TPairItem read GetCurrent;
- function MoveNext: Boolean;
- end;
- private
- fItems : TArray<TPairItem>;
- public
- function GetEnumerator : TPairEnumerator;
- function GetValue(const aName : string) : string;
- function GetPair(const aName : string) : TPairItem;
- function Add(aPair : TPairItem) : Integer; overload;
- function Add(const aName, aValue : string) : Integer; overload;
- procedure AddOrUpdate(const aName, aValue : string);
- function Exists(const aName : string) : Boolean;
- function Remove(const aName : string) : Boolean;
- function Count : Integer;
- property Items[const aName : string] : string read GetValue write AddOrUpdate;
- function ToArray : TArray<TPairItem>;
- procedure FromArray(aValue : TArray<TPairItem>);
- procedure Clear;
- end;
- {$IFDEF DELPHIXE7_UP}
- TDateTimeHelper = record helper for TDateTime
- public
- function ToSQLString : string;
- procedure FromNow;
- procedure FromUTC(const aUTCTime : TDateTime);
- function IncDay(const aValue : Cardinal = 1) : TDateTime;
- function DecDay(const aValue : Cardinal = 1) : TDateTime;
- function IncMonth(const aValue : Cardinal = 1) : TDateTime;
- function DecMonth(const aValue : Cardinal = 1) : TDateTime;
- function IncYear(const aValue : Cardinal = 1) : TDateTime;
- function DecYear(const aValue : Cardinal = 1) : TDateTime;
- function IsEqualTo(const aDateTime : TDateTime) : Boolean;
- function IsAfter(const aDateTime : TDateTime) : Boolean;
- function IsBefore(const aDateTime : TDateTime) : Boolean;
- function IsSameDay(const aDateTime : TDateTime) : Boolean;
- function IsSameTime(const aTime : TTime) : Boolean;
- function DayOfTheWeek : Word;
- function ToJsonFormat : string;
- function ToGMTFormat: string;
- function ToTimeStamp : TTimeStamp;
- function ToUTC : TDateTime;
- function ToMilliseconds : Int64;
- function ToString : string;
- function Date : TDate;
- function Time : TTime;
- function IsAM : Boolean;
- function IsPM : Boolean;
- end;
- TDateHelper = record helper for TDate
- public
- function ToString : string;
- end;
- TTimeHelper = record helper for TTime
- public
- function ToString : string;
- end;
- {$ENDIF}
- EEnvironmentPath = class(Exception);
- EShellError = class(Exception);
- //generates a random password with complexity options
- function RandomPassword(const PasswordLength : Integer; Complexity : TPasswordComplexity = [pfIncludeNumbers,pfIncludeSigns]) : string;
- //generates a random string
- function RandomString(const aLength: Integer) : string;
- //extracts file extension from a filename
- function ExtractFileNameWithoutExt(const FileName: string): string;
- //converts a Unix path to Windows path
- function UnixToWindowsPath(const UnixPath: string): string;
- //converts a Windows path to Unix path
- function WindowsToUnixPath(const WindowsPath: string): string;
- //corrects malformed urls
- function CorrectURLPath(const cUrl : string) : string;
- //get url parts
- function UrlGetProtocol(const aUrl : string) : string;
- function UrlGetHost(const aUrl : string) : string;
- function UrlGetPath(const aUrl : string) : string;
- function UrlGetQuery(const aUrl : string) : string;
- function UrlRemoveProtocol(const aUrl : string) : string;
- function UrlRemoveQuery(const aUrl : string) : string;
- function UrlSimpleEncode(const aUrl : string) : string;
- //get typical environment paths as temp, desktop, etc
- procedure GetEnvironmentPaths;
- {$IFDEF MSWINDOWS}
- function GetSpecialFolderPath(folderID : Integer) : string;
- //checks if running on a 64bit OS
- function Is64bitOS : Boolean;
- //checks if is a console app
- function IsConsole : Boolean;
- function HasConsoleOutput : Boolean;
- //checks if compiled in debug mode
- {$ENDIF}
- function IsDebug : Boolean;
- {$IFDEF MSWINDOWS}
- //checks if running as a service
- function IsService : Boolean;
- //gets number of seconds without user interaction (mouse, keyboard)
- function SecondsIdle: DWord;
- //frees process memory not needed
- procedure FreeUnusedMem;
- //changes screen resolution
- function SetScreenResolution(Width, Height: integer): Longint;
- {$ENDIF MSWINDOWS}
- //returns last day of current month
- function LastDayCurrentMonth: TDateTime;
- {$IFDEF FPC}
- function DateTimeInRange(ADateTime: TDateTime; AStartDateTime, AEndDateTime: TDateTime; aInclusive: Boolean = True): Boolean;
- {$ENDIF}
- //checks if two datetimes are in same day
- function IsSameDay(cBefore, cNow : TDateTime) : Boolean;
- //change Time of a DateTime
- function ChangeTimeOfADay(aDate : TDateTime; aHour, aMinute, aSecond : Word; aMilliSecond : Word = 0) : TDateTime;
- //change Date of a DateTime
- function ChangeDateOfADay(aDate : TDateTime; aYear, aMonth, aDay : Word) : TDateTime;
- //returns n times a char
- function FillStr(const C : Char; const Count : Integer) : string;
- function FillStrEx(const value : string; const Count : Integer) : string;
- //checks if string exists in array of string
- function StrInArray(const aValue : string; const aInArray : array of string; aCaseSensitive : Boolean = True) : Boolean;
- //checks if integer exists in array of integer
- function IntInArray(const aValue : Integer; const aInArray : array of Integer) : Boolean;
- //check if array is empty
- function IsEmptyArray(aArray : TArray<string>) : Boolean; overload;
- function IsEmptyArray(aArray : TArray<Integer>) : Boolean; overload;
- //returns a number leading zero
- function Zeroes(const Number, Len : Int64) : string;
- //converts a number to thousand delimeter string
- function NumberToStr(const Number : Int64) : string;
- //returns n spaces
- function Spaces(const Count : Integer) : string;
- //returns current date as a string
- function NowStr : string;
- //returns a new GUID as string
- function NewGuidStr : string;
- //compare a string with a wildcard pattern (? or *)
- function IsLike(cText, Pattern: string) : Boolean;
- //Upper case for first letter
- function Capitalize(s: string): string;
- function CapitalizeWords(s: string): string;
- //returns current logged user
- function GetLoggedUserName : string;
- //returns computer name
- function GetComputerName : string;
- //check if remote desktop session
- {$IFDEF MSWINDOWS}
- function IsRemoteSession : Boolean;
- {$ENDIF}
- //extract domain and user name from user login
- function ExtractDomainAndUser(const aUser : string; out oDomain, oUser : string) : Boolean;
- //Changes incorrect delims in path
- function NormalizePathDelim(const cPath : string; const Delim : Char) : string;
- //combine paths normalized with delim
- function CombinePaths(const aFirstPath, aSecondPath: string; aDelim : Char): string;
- //Removes firs segment of a path
- function RemoveFirstPathSegment(const cdir : string) : string;
- //Removes last segment of a path
- function RemoveLastPathSegment(const cDir : string) : string;
- //returns path delimiter if found
- function GetPathDelimiter(const aPath : string) : string;
- //returns first segment of a path
- function GetFirstPathSegment(const aPath : string) : string;
- //returns last segment of a path
- function GetLastPathSegment(const aPath : string) : string;
- //finds swith in commandline params
- function ParamFindSwitch(const Switch : string) : Boolean;
- //gets value for a switch if exists
- function ParamGetSwitch(const Switch : string; var cvalue : string) : Boolean;
- //returns app name (filename based)
- function GetAppName : string;
- //returns app version (major & minor)
- function GetAppVersionStr: string;
- //returns app version full (major, minor, release & compiled)
- function GetAppVersionFullStr: string;
- //convert UTC DateTime to Local DateTime
- function UTCToLocalTime(GMTTime: TDateTime): TDateTime;
- //convert Local DateTime to UTC DateTime
- function LocalTimeToUTC(LocalTime : TDateTime): TDateTime;
- //convert DateTime to GTM Time string
- function DateTimeToGMT(aDate : TDateTime) : string;
- //convert GMT Time string to DateTime
- function GMTToDateTime(aDate : string) : TDateTime;
- //convert DateTime to Json Date format
- function DateTimeToJsonDate(aDateTime : TDateTime) : string;
- //convert Json Date format to DateTime
- function JsonDateToDateTime(const aJsonDate : string) : TDateTime;
- //count number of digits of a Integer
- function CountDigits(anInt: Cardinal): Cardinal; inline;
- //count times a string is present in other string
- function CountStr(const aFindStr, aSourceStr : string) : Integer;
- //save stream to file
- procedure SaveStreamToFile(aStream : TStream; const aFilename : string);
- //save stream to string
- function StreamToString(const aStream: TStream; const aEncoding: TEncoding): string;
- function StreamToStringEx(aStream : TStream) : string;
- //save string to stream
- procedure StringToStream(const aStr : string; aStream : TStream; const aEncoding: TEncoding);
- procedure StringToStreamEx(const aStr : string; aStream : TStream);
- //returns a real comma separated text from stringlist
- function CommaText(aList : TStringList) : string; overload;
- //returns a real comma separated text from array of string
- function CommaText(aArray : TArray<string>) : string; overload;
- //returns a string CRLF separated from array of string
- function ArrayToString(aArray : TArray<string>) : string; overload;
- //returns a string with separator from array of string
- function ArrayToString(aArray : TArray<string>; aSeparator : string) : string; overload;
- //returns a string CRLF separated from array of Integer
- function ArrayToString(aArray : TArray<Integer>) : string; overload;
- //returns a string with separator from array of Integer
- function ArrayToString(aArray : TArray<Integer>; aSeparator : string) : string; overload;
- //converts TStrings to array
- function StringsToArray(aStrings : TStrings) : TArray<string>; overload;
- //converts string comma or semicolon separated to array
- function StringsToArray(const aString : string) : TArray<string>; overload;
- {$IFDEF MSWINDOWS}
- //process messages on console applications
- procedure ProcessMessages;
- //get last error message
- function GetLastOSError : String;
- {$ENDIF}
- {$IF DEFINED(FPC) AND DEFINED(MSWINDOWS)}
- function GetLastInputInfo(var plii: TLastInputInfo): BOOL;stdcall; external 'user32' name 'GetLastInputInfo';
- {$ENDIF}
- function RemoveLastChar(const aText : string) : string;
- function DateTimeToSQL(aDateTime : TDateTime) : string;
- function IsInteger(const aValue : string) : Boolean;
- function IsFloat(const aValue : string) : Boolean;
- function IsBoolean(const aValue : string) : Boolean;
- //extract a substring and deletes from source string
- function ExtractStr(var vSource : string; aIndex : Integer; aCount : Integer) : string;
- //get first string between string delimiters
- function GetSubString(const aSource, aFirstDelimiter, aLastDelimiter : string) : string;
- //get double quoted or dequoted string
- function DbQuotedStr(const str : string): string;
- function UnDbQuotedStr(const str: string) : string;
- //get simple quoted or dequoted string
- function SpQuotedStr(const str : string): string;
- function UnSpQuotedStr(const str : string): string;
- function UnQuotedStr(const str : string; const aQuote : Char) : string;
- //ternary operator
- function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : string) : string; overload;
- function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : Integer) : Integer; overload;
- function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : Extended) : Extended; overload;
- function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : TObject) : TObject; overload;
- var
- path : TEnvironmentPath;
- //Enabled if QuickService is defined
- IsQuickServiceApp : Boolean;
- implementation
- {TFileHelper}
- {$IFNDEF FPC}
- {$IFDEF MSWINDOWS}
- class function TFileHelper.IsInUse(const FileName : string) : Boolean;
- var
- HFileRes: HFILE;
- begin
- Result := False;
- if not FileExists(FileName) then Exit;
- try
- HFileRes := CreateFile(PChar(FileName)
- ,GENERIC_READ or GENERIC_WRITE
- ,0
- ,nil
- ,OPEN_EXISTING
- ,FILE_ATTRIBUTE_NORMAL
- ,0);
- Result := (HFileRes = INVALID_HANDLE_VALUE);
- if not(Result) then begin
- CloseHandle(HFileRes);
- end;
- except
- Result := True;
- end;
- end;
- {$ENDIF}
- {$IFDEF DELPHILINUX}
- class function TFileHelper.IsInUse(const FileName : string) : Boolean;
- var
- fs : TFileStream;
- begin
- try
- fs := TFileStream.Create(FileName, fmOpenReadWrite, fmShareExclusive);
- Result := True;
- fs.Free;
- except
- Result := False;
- end;
- end;
- {$ENDIF}
- {$IFDEF MSWINDOWS}
- class function TFileHelper.GetSize(const FileName: String): Int64;
- var
- info: TWin32FileAttributeData;
- begin
- Result := -1;
- if not GetFileAttributesEx(PWideChar(FileName), GetFileExInfoStandard, @info) then Exit;
- Result := Int64(info.nFileSizeLow) or Int64(info.nFileSizeHigh shl 32);
- end;
- {$ELSE}
- class function TFileHelper.GetSize(const FileName: String): Int64;
- var
- sr : TSearchRec;
- begin
- if FindFirst(fileName, faAnyFile, sr ) = 0 then Result := sr.Size
- else Result := -1;
- end;
- {$ENDIF}
- {TDirectoryHelper}
- class function TDirectoryHelper.GetSize(const Path: String): Int64;
- var
- filename : string;
- begin
- Result := -1;
- for filename in TDirectory.GetFiles(Path) do
- begin
- Result := Result + TFile.GetSize(filename);
- end;
- end;
- {$ENDIF}
- {other functions}
- function RandomPassword(const PasswordLength : Integer; Complexity : TPasswordComplexity = [pfIncludeNumbers,pfIncludeSigns]) : string;
- const
- PassAlpha = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
- PassSigns = '@!&$';
- PassNumbers = '1234567890';
- var
- MinNumbers,
- MinSigns : Integer;
- NumNumbers,
- NumSigns : Integer;
- begin
- Result := '';
- Randomize;
- //fill all alfa
- repeat
- Result := Result + PassAlpha[Random(Length(PassAlpha))+1];
- until (Length(Result) = PasswordLength);
- //checks if need include numbers
- if pfIncludeNumbers in Complexity then
- begin
- MinNumbers := Round(PasswordLength / 10 * 2);
- NumNumbers := 0;
- if MinNumbers = 0 then MinNumbers := 1;
- repeat
- Result[Random(PasswordLength)+1] := PassNumbers[Random(Length(PassNumbers))+1];
- Inc(NumNumbers);
- until NumNumbers = MinNumbers;
- end;
- //checks if need include signs
- if pfIncludeSigns in Complexity then
- begin
- MinSigns := Round(PasswordLength / 10 * 1);
- NumSigns := 0;
- if MinSigns = 0 then MinSigns := 1;
- repeat
- Result[Random(PasswordLength)+1] := PassSigns[Random(Length(PassSigns))+1];
- Inc(NumSigns);
- until NumSigns = MinSigns;
- end;
- end;
- function RandomString(const aLength: Integer) : string;
- const
- chars : string = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890';
- var
- i : Integer;
- clong : Integer;
- begin
- clong := High(chars);
- SetLength(Result, aLength);
- for i := 1 to aLength do
- begin
- Result[i] := chars[Random(clong) + 1];
- end;
- end;
- function ExtractFileNameWithoutExt(const FileName: string): string;
- begin
- Result := TPath.GetFileNameWithoutExtension(FileName);
- end;
- function UnixToWindowsPath(const UnixPath: string): string;
- begin
- Result := StringReplace(UnixPath, '/', '\',[rfReplaceAll, rfIgnoreCase]);
- end;
- function WindowsToUnixPath(const WindowsPath: string): string;
- begin
- Result := StringReplace(WindowsPath, '\', '/',[rfReplaceAll, rfIgnoreCase]);
- end;
- function CorrectURLPath(const cUrl : string) : string;
- var
- nurl : string;
- begin
- nurl := WindowsToUnixPath(cUrl);
- nurl := StringReplace(nurl,'//','/',[rfReplaceAll]);
- Result := StringReplace(nurl,' ','%20',[rfReplaceAll]);
- //TNetEncoding.Url.Encode()
- end;
- function UrlGetProtocol(const aUrl : string) : string;
- begin
- Result := aUrl.SubString(0,aUrl.IndexOf('://'));
- end;
- function UrlGetHost(const aUrl : string) : string;
- var
- url : string;
- len : Integer;
- begin
- url := UrlRemoveProtocol(aUrl);
- if url.Contains('/') then len := url.IndexOf('/')
- else len := url.Length;
- Result := url.SubString(0,len);
- end;
- function UrlGetPath(const aUrl : string) : string;
- var
- url : string;
- len : Integer;
- begin
- url := UrlRemoveProtocol(aUrl);
- if not url.Contains('/') then Exit('');
- len := url.IndexOf('?');
- if len < 0 then len := url.Length
- else len := url.IndexOf('?') - url.IndexOf('/');
- Result := url.Substring(url.IndexOf('/'),len);
- end;
- function UrlGetQuery(const aUrl : string) : string;
- begin
- if not aUrl.Contains('?') then Exit('');
- Result := aUrl.Substring(aUrl.IndexOf('?')+1);
- end;
- function UrlRemoveProtocol(const aUrl : string) : string;
- var
- pos : Integer;
- begin
- pos := aUrl.IndexOf('://');
- if pos < 0 then pos := 0
- else pos := pos + 3;
- Result := aUrl.SubString(pos, aUrl.Length);
- end;
- function UrlRemoveQuery(const aUrl : string) : string;
- begin
- if not aUrl.Contains('?') then Exit(aUrl);
- Result := aUrl.Substring(0,aUrl.IndexOf('?'));
- end;
- function UrlSimpleEncode(const aUrl : string) : string;
- begin
- Result := StringReplace(aUrl,' ','%20',[rfReplaceAll]);
- end;
- procedure GetEnvironmentPaths;
- begin
- //gets path
- path.EXEPATH := TPath.GetDirectoryName(ParamStr(0));
- {$IFDEF MSWINDOWS}
- path.WINDOWS := SysUtils.GetEnvironmentVariable('windir');
- path.PROGRAMFILES := SysUtils.GetEnvironmentVariable('ProgramFiles');
- path.COMMONFILES := SysUtils.GetEnvironmentVariable('CommonProgramFiles(x86)');
- path.HOMEDRIVE := SysUtils.GetEnvironmentVariable('SystemDrive');
- path.USERPROFILE := SysUtils.GetEnvironmentVariable('USERPROFILE');
- path.PROGRAMDATA := SysUtils.GetEnvironmentVariable('ProgramData');
- path.ALLUSERSPROFILE := SysUtils.GetEnvironmentVariable('AllUsersProfile');
- path.INSTDRIVE := path.HOMEDRIVE;
- path.TEMP := SysUtils.GetEnvironmentVariable('TEMP');
- //these paths fail if user is SYSTEM
- try
- path.SYSTEM := GetSpecialFolderPath(CSIDL_SYSTEM);
- path.APPDATA := GetSpecialFolderPath(CSIDL_APPDATA);
- path.DESKTOP := GetSpecialFolderPath(CSIDL_DESKTOP);
- path.DESKTOP_ALLUSERS := GetSpecialFolderPath(CSIDL_COMMON_DESKTOPDIRECTORY);
- path.STARTMENU:=GetSpecialFolderPath(CSIDL_PROGRAMS);
- path.STARTMENU_ALLUSERS:=GetSpecialFolderPath(CSIDL_COMMON_PROGRAMS);
- path.STARTMENU_ALLUSERS := path.STARTMENU;
- path.STARTUP:=GetSpecialFolderPath(CSIDL_STARTUP);
- except
- //
- end;
- {$ENDIF}
- end;
- {$IFDEF MSWINDOWS}
- function GetSpecialFolderPath(folderID : Integer) : string;
- var
- shellMalloc: IMalloc;
- ppidl: PItemIdList;
- begin
- ppidl := nil;
- try
- if SHGetMalloc(shellMalloc) = NOERROR then
- begin
- SHGetSpecialFolderLocation(0, folderID, ppidl);
- SetLength(Result, MAX_PATH);
- if not SHGetPathFromIDList(ppidl,{$IFDEF FPC}PAnsiChar(Result){$ELSE}PChar(Result){$ENDIF}) then
- begin
- raise EShellError.create(Format('GetSpecialFolderPath: Invalid PIPL (%d)',[folderID]));
- end;
- SetLength(Result, lStrLen({$IFDEF FPC}PAnsiChar(Result){$ELSE}PChar(Result){$ENDIF}));
- end;
- finally
- if ppidl <> nil then
- shellMalloc.Free(ppidl);
- end;
- end;
- function Is64bitOS : Boolean;
- begin
- {$IFDEF WIN64}
- Result := True;
- {$ELSE}
- Result := False;
- {$ENDIF WIN64}
- end;
- function IsConsole: Boolean;
- begin
- {$IFDEF CONSOLE}
- Result := True;
- {$ELSE}
- Result := False;
- {$ENDIF CONSOLE}
- end;
- {$ENDIF}
- function HasConsoleOutput : Boolean;
- {$IFDEF MSWINDOWS}
- var
- stout : THandle;
- begin
- try
- stout := GetStdHandle(Std_Output_Handle);
- {$WARN SYMBOL_PLATFORM OFF}
- //Allready checked that we are on a windows platform
- Win32Check(stout <> Invalid_Handle_Value);
- {$WARN SYMBOL_PLATFORM ON}
- Result := stout <> 0;
- except
- Result := False;
- end;
- end;
- {$ELSE}
- begin
- Result := IsConsole;
- end;
- {$ENDIF}
- function IsDebug: Boolean;
- begin
- {$IFDEF DEBUG}
- Result := True;
- {$ELSE}
- Result := False;
- {$ENDIF DEBUG}
- end;
- {$IFDEF MSWINDOWS}
- function IsService : Boolean;
- begin
- //only working with my Quick.AppService unit
- try
- Result := (IsConsole) and (not HasConsoleOutput);
- except
- Result := False;
- end;
- end;
- function SecondsIdle: DWord;
- var
- liInfo: TLastInputInfo;
- begin
- liInfo.cbSize := SizeOf(TLastInputInfo) ;
- GetLastInputInfo(liInfo) ;
- Result := (GetTickCount - liInfo.dwTime) DIV 1000;
- end;
- procedure FreeUnusedMem;
- begin
- if Win32Platform = VER_PLATFORM_WIN32_NT then SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);
- end;
- function SetScreenResolution(Width, Height: integer): Longint;
- var
- DeviceMode: TDeviceMode;
- begin
- with DeviceMode do
- begin
- dmSize := SizeOf(TDeviceMode);
- dmPelsWidth := Width;
- dmPelsHeight := Height;
- dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
- end;
- Result := ChangeDisplaySettings(DeviceMode, CDS_UPDATEREGISTRY);
- end;
- {$ENDIF MSWINDOWS}
- function LastDayCurrentMonth: TDateTime;
- begin
- Result := EncodeDate(YearOf(Now),MonthOf(Now), DaysInMonth(Now));
- end;
- {$IFDEF FPC}
- function DateTimeInRange(ADateTime: TDateTime; AStartDateTime, AEndDateTime: TDateTime; aInclusive: Boolean = True): Boolean;
- begin
- if aInclusive then
- Result := (AStartDateTime <= ADateTime) and (ADateTime <= AEndDateTime)
- else
- Result := (AStartDateTime < ADateTime) and (ADateTime < AEndDateTime);
- end;
- {$ENDIF}
- function IsSameDay(cBefore, cNow : TDateTime) : Boolean;
- begin
- //Test: Result := MinutesBetween(cBefore,cNow) < 1;
- Result := DateTimeInRange(cNow,StartOfTheDay(cBefore),EndOfTheDay(cBefore),True);
- end;
- function ChangeTimeOfADay(aDate : TDateTime; aHour, aMinute, aSecond : Word; aMilliSecond : Word = 0) : TDateTime;
- var
- y, m, d : Word;
- begin
- DecodeDate(aDate,y,m,d);
- Result := EncodeDateTime(y,m,d,aHour,aMinute,aSecond,aMilliSecond);
- end;
- function ChangeDateOfADay(aDate : TDateTime; aYear, aMonth, aDay : Word) : TDateTime;
- var
- h, m, s, ms : Word;
- begin
- DecodeTime(aDate,h,m,s,ms);
- Result := EncodeDateTime(aYear,aMonth,aDay,h,m,s,0);
- end;
- function FillStr(const C : Char; const Count : Integer) : string;
- var
- i : Integer;
- begin
- Result := '';
- for i := 1 to Count do Result := Result + C;
- end;
- function FillStrEx(const value : string; const Count : Integer) : string;
- var
- i : Integer;
- begin
- Result := '';
- for i := 1 to Count do Result := Result + value;
- end;
- function StrInArray(const aValue : string; const aInArray : array of string; aCaseSensitive : Boolean = True) : Boolean;
- var
- s : string;
- begin
- for s in aInArray do
- begin
- if aCaseSensitive then
- begin
- if s = aValue then Exit(True);
- end
- else
- begin
- if CompareText(aValue,s) = 0 then Exit(True);
- end;
- end;
- Result := False;
- end;
- function IntInArray(const aValue : Integer; const aInArray : array of Integer) : Boolean;
- var
- i : Integer;
- begin
- for i in aInArray do
- begin
- if i = aValue then Exit(True);
- end;
- Result := False;
- end;
- function IsEmptyArray(aArray : TArray<string>) : Boolean;
- begin
- Result := Length(aArray) = 0;
- end;
- function IsEmptyArray(aArray : TArray<Integer>) : Boolean;
- begin
- Result := Length(aArray) = 0;
- end;
- function Zeroes(const Number, Len : Int64) : string;
- begin
- if Len > Length(IntToStr(Number)) then Result := FillStr('0',Len - Length(IntToStr(Number))) + IntToStr(Number)
- else Result := IntToStr(Number);
- end;
- function NumberToStr(const Number : Int64) : string;
- begin
- try
- Result := FormatFloat('0,',Number);
- except
- Result := '#Error';
- end;
- end;
- function Spaces(const Count : Integer) : string;
- begin
- Result := FillStr(' ',Count);
- end;
- function NowStr : string;
- begin
- Result := DateTimeToStr(Now());
- end;
- function NewGuidStr : string;
- {$IFNDEF DELPHIRX10_UP}
- var
- guid : TGUID;
- {$ENDIF}
- begin
- {$IFDEF DELPHIRX10_UP}
- Result := TGUID.NewGuid.ToString;
- {$ELSE}
- guid.NewGuid;
- Result := guid.ToString
- {$ENDIF}
- end;
- function IsLike(cText, Pattern: string) : Boolean;
- var
- i, n : Integer;
- match : Boolean;
- wildcard : Boolean;
- CurrentPattern : Char;
- begin
- Result := False;
- wildcard := False;
- cText := LowerCase(cText);
- Pattern := LowerCase(Pattern);
- match := False;
- if (Pattern.Length > cText.Length) or (Pattern = '') then Exit;
- if Pattern = '*' then
- begin
- Result := True;
- Exit;
- end;
- for i := 1 to cText.Length do
- begin
- CurrentPattern := Pattern[i];
- if CurrentPattern = '*' then wildcard := True;
- if wildcard then
- begin
- n := Pos(Copy(Pattern,i+1,Pattern.Length),cText);
- if (n > i) or (Pattern.Length = i) then
- begin
- Result := True;
- Exit;
- end;
- end
- else
- begin
- if (cText[i] = CurrentPattern) or (CurrentPattern = '?') then match := True
- else match := False;
- end;
- end;
- Result := match;
- end;
- function Capitalize(s: string): string;
- begin
- Result := '';
- if s.Length = 0 then Exit;
- s := LowerCase(s,loUserLocale);
- Result := UpperCase(s[1],loUserLocale) + Trim(Copy(s, 2, s.Length));
- end;
- function CapitalizeWords(s: string): string;
- var
- cword : string;
- begin
- Result := '';
- if s.Length = 0 then Exit;
- s := LowerCase(s,loUserLocale);
- for cword in s.Split([' ']) do
- begin
- if Result = '' then Result := Capitalize(cword)
- else Result := Result + ' ' + Capitalize(cword);
- end;
- end;
- function GetLoggedUserName : string;
- {$IFDEF MSWINDOWS}
- const
- cnMaxUserNameLen = 254;
- var
- sUserName : string;
- dwUserNameLen : DWord;
- begin
- dwUserNameLen := cnMaxUserNameLen-1;
- SetLength( sUserName, cnMaxUserNameLen );
- GetUserName(PChar( sUserName ),dwUserNameLen );
- SetLength( sUserName, dwUserNameLen );
- Result := sUserName;
- end;
- {$ELSE}
- {$IF DEFINED(FPC) AND DEFINED(LINUX)}
- begin
- Result := GetEnvironmentVariable('USERNAME');
- end;
- {$ELSE}
- var
- {$IFNDEF NEXTGEN}
- plogin : PAnsiChar;
- {$ELSE}
- plogin : MarshaledAString;
- {$ENDIF}
- begin
- {$IFDEF POSIX}
- try
- plogin := getlogin;
- {$IFDEF NEXTGEN}
- Result := string(plogin);
- {$ELSE}
- Result := Copy(plogin,1,Length(Trim(plogin)));
- {$ENDIF}
- except
- Result := 'N/A';
- end;
- {$ELSE}
- Result := 'N/A';
- {$ENDIF}
- //raise ENotImplemented.Create('Not Android GetLoggedUserName implemented!');
- end;
- {$ENDIF}
- {$ENDIF}
- {$IFDEF IOS}
- function GetDeviceModel : String;
- var
- size : size_t;
- buffer : array of Byte;
- begin
- sysctlbyname('hw.machine',nil,@size,nil,0);
- if size > 0 then
- begin
- SetLength(buffer, size);
- sysctlbyname('hw.machine',@buffer[0],@size,nil,0);
- Result := UTF8ToString(MarshaledAString(buffer));
- end
- else Result := EmptyStr;
- end;
- {$ENDIF}
- function GetComputerName : string;
- {$IFDEF MSWINDOWS}
- var
- dwLength: dword;
- begin
- dwLength := 253;
- SetLength(Result, dwLength+1);
- if not Windows.GetComputerName(pchar(result), dwLength) then Result := 'Not detected!';
- Result := pchar(result);
- end;
- {$ELSE}
- {$IF DEFINED(FPC) AND DEFINED(LINUX)}
- begin
- Result := GetEnvironmentVariable('COMPUTERNAME');
- end;
- {$ELSE} //Android gets model name
- {$IFDEF NEXTGEN}
- begin
- {$IFDEF ANDROID}
- Result := JStringToString(TJBuild.JavaClass.MODEL);
- {$ELSE} //IOS
- Result := GetDeviceModel;
- {$ENDIF}
- end;
- {$ELSE}
- {$IFDEF DELPHILINUX}
- var
- phost : PAnsiChar;
- begin
- try
- phost := AllocMem(256);
- try
- if gethostname(phost,_SC_HOST_NAME_MAX) = 0 then
- begin
- {$IFDEF DEBUG}
- Result := Copy(Trim(phost),1,Length(Trim(phost)));
- {$ELSE}
- Result := Copy(phost,1,Length(phost));
- {$ENDIF}
- end
- else Result := 'N/A.';
- finally
- FreeMem(phost);
- end;
- except
- Result := 'N/A';
- end;
- end;
- {$ELSE} //OSX
- begin
- Result := NSStrToStr(TNSHost.Wrap(TNSHost.OCClass.currentHost).localizedName);
- end;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF MSWINDOWS}
- function IsRemoteSession : Boolean;
- const
- SM_REMOTECONTROL = $2001;
- SM_REMOTESESSION = $1000;
- begin
- Result := (GetSystemMetrics(SM_REMOTESESSION) <> 0) or (GetSystemMetrics(SM_REMOTECONTROL) <> 0);
- end;
- {$ENDIF}
- function ExtractDomainAndUser(const aUser : string; out oDomain, oUser : string) : Boolean;
- begin
- //check if domain specified into username
- if aUser.Contains('\') then
- begin
- oDomain := Copy(aUser,Low(aUser),Pos('\',aUser)-1);
- oUser := Copy(aUser,Pos('\',aUser)+1,aUser.Length);
- Exit(True);
- end
- else if aUser.Contains('@') then
- begin
- oDomain := Copy(aUser,Pos('@',aUser)+1,aUser.Length);
- oUser := Copy(aUser,Low(aUser),Pos('@',aUser)-1);
- Exit(True);
- end;
- oDomain := '';
- oUser := aUser;
- Result := False;
- end;
- function NormalizePathDelim(const cPath : string; const Delim : Char) : string;
- begin
- if Delim = '\' then Result := StringReplace(cPath,'/',Delim,[rfReplaceAll])
- else Result := StringReplace(cPath,'\',Delim,[rfReplaceAll]);
- end;
- function CombinePaths(const aFirstPath, aSecondPath: string; aDelim : Char): string;
- var
- path1 : string;
- path2 : string;
- begin
- path1 := NormalizePathDelim(aFirstPath,aDelim);
- path2 := NormalizePathDelim(aSecondPath,aDelim);
- if path1.EndsWith(aDelim) then
- begin
- if path2.StartsWith(aDelim) then Result := path1 + path2.Substring(1)
- else Result := path1 + path2;
- end
- else
- begin
- if path2.StartsWith(aDelim) then Result := path1 + path2
- else result := path1 + aDelim + path2;
- end;
- end;
- function RemoveFirstPathSegment(const cdir : string) : string;
- var
- posi : Integer;
- delim : Char;
- dir : string;
- StartsWithDelim : Boolean;
- begin
- if cDir.Contains('\') then delim := '\'
- else if cDir.Contains('/') then delim := '/'
- else
- begin
- Exit('');
- end;
- dir := NormalizePathDelim(cDir,delim);
- if dir.StartsWith(delim) then
- begin
- dir := Copy(dir,2,dir.Length);
- StartsWithDelim := True;
- end
- else StartsWithDelim := False;
- if dir.CountChar(delim) = 0 then Exit('')
- else posi := Pos(delim,dir)+1;
- Result := Copy(dir,posi,dir.Length);
- if (not Result.IsEmpty) and (StartsWithDelim) then Result := delim + Result;
- end;
- function RemoveLastPathSegment(const cDir : string) : string;
- var
- posi : Integer;
- delim : Char;
- dir : string;
- EndsWithDelim : Boolean;
- begin
- if cDir.Contains('\') then delim := '\'
- else if cDir.Contains('/') then delim := '/'
- else
- begin
- Exit('');
- end;
- dir := NormalizePathDelim(cDir,delim);
- if dir.EndsWith(delim) then
- begin
- dir := Copy(dir,1,dir.Length-1);
- EndsWithDelim := True;
- end
- else EndsWithDelim := False;
- if dir.CountChar(delim) > 1 then posi := dir.LastDelimiter(delim)
- else posi := Pos(delim,dir)-1;
- if posi = dir.Length then posi := 0;
- Result := Copy(dir,1,posi);
- if (not Result.IsEmpty) and (EndsWithDelim) then Result := Result + delim;
- end;
- function GetPathDelimiter(const aPath : string) : string;
- begin
- if aPath.Contains('/') then Result := '/'
- else if aPath.Contains('\') then Result := '\'
- else Result := '';
- end;
- function GetFirstPathSegment(const aPath : string) : string;
- var
- delimiter : string;
- spath : string;
- begin
- delimiter := GetPathDelimiter(aPath);
- if delimiter.IsEmpty then Exit(aPath);
- if aPath.StartsWith(delimiter) then spath := Copy(aPath,2,aPath.Length)
- else spath := aPath;
- if spath.Contains(delimiter) then Result := Copy(spath,0,spath.IndexOf(delimiter))
- else Result := spath;
- end;
- function GetLastPathSegment(const aPath : string) : string;
- var
- delimiter : string;
- spath : string;
- begin
- delimiter := GetPathDelimiter(aPath);
- if delimiter.IsEmpty then Exit(aPath);
- if aPath.EndsWith(delimiter) then spath := Copy(aPath,0,aPath.Length - 1)
- else spath := aPath;
- Result := spath.Substring(spath.LastDelimiter(delimiter)+1);
- end;
- function ParamFindSwitch(const Switch : string) : Boolean;
- begin
- Result := FindCmdLineSwitch(Switch,['-', '/'],True);
- end;
- {$IFDEF FPC}
- function FindCmdLineSwitch(const Switch: string; var Value: string; IgnoreCase: Boolean = True;
- const SwitchTypes: TCmdLineSwitchTypes = [clstValueNextParam, clstValueAppended]): Boolean; overload;
- type
- TCompareProc = function(const S1, S2: string): Boolean;
- var
- Param: string;
- I, ValueOfs,
- SwitchLen, ParamLen: Integer;
- SameSwitch: TCompareProc;
- begin
- Result := False;
- Value := '';
- if IgnoreCase then
- SameSwitch := SameText else
- SameSwitch := SameStr;
- SwitchLen := Switch.Length;
- for I := 1 to ParamCount do
- begin
- Param := ParamStr(I);
- if CharInSet(Param.Chars[0], SwitchChars) and SameSwitch(Param.SubString(1,SwitchLen), Switch) then
- begin
- ParamLen := Param.Length;
- // Look for an appended value if the param is longer than the switch
- if (ParamLen > SwitchLen + 1) then
- begin
- // If not looking for appended value switches then this is not a matching switch
- if not (clstValueAppended in SwitchTypes) then
- Continue;
- ValueOfs := SwitchLen + 1;
- if Param.Chars[ValueOfs] = ':' then
- Inc(ValueOfs);
- Value := Param.SubString(ValueOfs, MaxInt);
- end
- // If the next param is not a switch, then treat it as the value
- else if (clstValueNextParam in SwitchTypes) and (I < ParamCount) and
- not CharInSet(ParamStr(I+1).Chars[0], SwitchChars) then
- Value := ParamStr(I+1);
- Result := True;
- Break;
- end;
- end;
- end;
- {$ENDIF}
- function ParamGetSwitch(const Switch : string; var cvalue : string) : Boolean;
- begin
- Result := FindCmdLineSwitch(Switch,cvalue,True,[clstValueAppended]);
- end;
- function GetAppName : string;
- begin
- Result := ExtractFilenameWithoutExt(ParamStr(0));
- end;
- function GetAppVersionStr: string;
- {$IFDEF MSWINDOWS}
- var
- Rec: LongRec;
- ver : Cardinal;
- begin
- ver := GetFileVersion(ParamStr(0));
- if ver <> Cardinal(-1) then
- begin
- Rec := LongRec(ver);
- Result := Format('%d.%d', [Rec.Hi, Rec.Lo]);
- end
- else Result := '';
- end;
- {$ELSE}
- {$IF DEFINED(FPC) AND DEFINED(LINUX)}
- var
- version : TProgramVersion;
- begin
- if GetProgramVersion(version) then Result := Format('%d.%d', [version.Major, version.Minor])
- else Result := '';
- end;
- {$ELSE}
- {$IFDEF NEXTGEN}
- {$IFDEF ANDROID}
- var
- PkgInfo : JPackageInfo;
- begin
- {$IFDEF DELPHIRX103_UP}
- PkgInfo := TAndroidHelper.Activity.getPackageManager.getPackageInfo(TAndroidHelper.Activity.getPackageName,0);
- {$ELSE}
- PkgInfo := SharedActivity.getPackageManager.getPackageInfo(SharedActivity.getPackageName,0);
- {$ENDIF}
- Result := IntToStr(PkgInfo.VersionCode);
- end;
- {$ELSE} //IOS
- var
- AppKey: Pointer;
- AppBundle: NSBundle;
- BuildStr : NSString;
- begin
- try
- AppKey := (StrToNSStr('CFBundleVersion') as ILocalObject).GetObjectID;
- AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
- BuildStr := TNSString.Wrap(AppBundle.infoDictionary.objectForKey(AppKey));
- Result := UTF8ToString(BuildStr.UTF8String);
- except
- Result := '';
- end;
- end;
- {$ENDIF}
- {$ELSE} //OSX
- {$IFDEF OSX}
- var
- AppKey: Pointer;
- AppBundle: NSBundle;
- BuildStr : NSString;
- begin
- try
- AppKey := (StrToNSStr('CFBundleVersion') as ILocalObject).GetObjectID;
- AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
- BuildStr := TNSString.Wrap(AppBundle.infoDictionary.objectForKey(AppKey));
- Result := UTF8ToString(BuildStr.UTF8String);
- except
- Result := '';
- end;
- end;
- {$ELSE}
- begin
- Result := '';
- end;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- function GetAppVersionFullStr: string;
- {$IFDEF MSWINDOWS}
- var
- Exe: string;
- Size, Handle: DWORD;
- Buffer: TBytes;
- FixedPtr: PVSFixedFileInfo;
- begin
- Result := '';
- Exe := ParamStr(0);
- Size := GetFileVersionInfoSize(PChar(Exe), Handle);
- if Size = 0 then
- begin
- //RaiseLastOSError;
- //no version info in file
- Exit;
- end;
- SetLength(Buffer, Size);
- if not GetFileVersionInfo(PChar(Exe), Handle, Size, Buffer) then
- RaiseLastOSError;
- if not VerQueryValue(Buffer, '\', Pointer(FixedPtr), Size) then
- RaiseLastOSError;
- if (LongRec(FixedPtr.dwFileVersionLS).Hi = 0) and (LongRec(FixedPtr.dwFileVersionLS).Lo = 0) then
- begin
- Result := Format('%d.%d',
- [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
- LongRec(FixedPtr.dwFileVersionMS).Lo]); //minor
- end
- else if (LongRec(FixedPtr.dwFileVersionLS).Lo = 0) then
- begin
- Result := Format('%d.%d.%d',
- [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
- LongRec(FixedPtr.dwFileVersionMS).Lo, //minor
- LongRec(FixedPtr.dwFileVersionLS).Hi]); //release
- end
- else
- begin
- Result := Format('%d.%d.%d.%d',
- [LongRec(FixedPtr.dwFileVersionMS).Hi, //major
- LongRec(FixedPtr.dwFileVersionMS).Lo, //minor
- LongRec(FixedPtr.dwFileVersionLS).Hi, //release
- LongRec(FixedPtr.dwFileVersionLS).Lo]); //build
- end;
- end;
- {$ELSE}
- {$IF DEFINED(FPC) AND DEFINED(LINUX)}
- var
- version : TProgramVersion;
- begin
- if GetProgramVersion(version) then Result := Format('%d.%d.%d.%d', [version.Major, version.Minor, version.Revision, version.Build])
- else Result := '';
- end;
- {$ELSE}
- {$IFDEF NEXTGEN}
- {$IFDEF ANDROID}
- var
- PkgInfo : JPackageInfo;
- begin
- {$IFDEF DELPHIRX103_UP}
- PkgInfo := TAndroidHelper.Activity.getPackageManager.getPackageInfo(TAndroidHelper.Activity.getPackageName,0);
- {$ELSE}
- PkgInfo := SharedActivity.getPackageManager.getPackageInfo(SharedActivity.getPackageName,0);
- {$ENDIF}
- Result := JStringToString(PkgInfo.versionName);
- end;
- {$ELSE} //IOS
- var
- AppKey: Pointer;
- AppBundle: NSBundle;
- BuildStr : NSString;
- begin
- AppKey := (StrToNSStr('CFBundleVersion') as ILocalObject).GetObjectID;
- AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
- BuildStr := TNSString.Wrap(AppBundle.infoDictionary.objectForKey(AppKey));
- Result := UTF8ToString(BuildStr.UTF8String);
- end;
- {$ENDIF}
- {$ELSE}
- {$IFDEF OSX}
- var
- AppKey: Pointer;
- AppBundle: NSBundle;
- BuildStr : NSString;
- begin
- AppKey := (StrToNSStr('CFBundleVersion') as ILocalObject).GetObjectID;
- AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
- BuildStr := TNSString.Wrap(AppBundle.infoDictionary.objectForKey(AppKey));
- Result := UTF8ToString(BuildStr.UTF8String);
- end;
- {$ELSE}
- begin
- Result := '';
- end;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- function UTCToLocalTime(GMTTime: TDateTime): TDateTime;
- begin
- {$IFDEF FPC}
- Result := LocalTimeToUniversal(GMTTime);
- {$ELSE}
- Result := TTimeZone.Local.ToLocalTime(GMTTime);
- {$ENDIF}
- end;
- function LocalTimeToUTC(LocalTime : TDateTime): TDateTime;
- begin
- {$IFDEF FPC}
- Result := UniversalTimeToLocal(Localtime);
- {$ELSE}
- Result := TTimeZone.Local.ToUniversalTime(LocalTime);
- {$ENDIF}
- end;
- function DateTimeToGMT(aDate : TDateTime) : string;
- var
- FmtSettings : TFormatSettings;
- begin
- FmtSettings.DateSeparator := '-';
- FmtSettings.TimeSeparator := ':';
- FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ" GMT"';
- Result := DateTimeToStr(aDate,FmtSettings).Trim;
- end;
- function GMTToDateTime(aDate : string) : TDateTime;
- var
- FmtSettings : TFormatSettings;
- begin
- FmtSettings.DateSeparator := '-';
- FmtSettings.TimeSeparator := ':';
- FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ" GMT"';
- Result := StrToDateTime(aDate,FmtSettings);
- end;
- function DateTimeToJsonDate(aDateTime : TDateTime) : string;
- {$IFNDEF DELPHIXE7_UP}
- var
- FmtSettings : TFormatSettings;
- {$ENDIF}
- begin
- {$IFDEF DELPHIXE7_UP}
- Result := DateToISO8601(aDateTime);
- {$ELSE}
- FmtSettings.DateSeparator := '-';
- FmtSettings.TimeSeparator := ':';
- FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ"Z"';
- Result := DateTimeToStr(aDateTime,FmtSettings).Trim;
- {$ENDIF}
- end;
- function JsonDateToDateTime(const aJsonDate : string) : TDateTime;
- {$IFNDEF DELPHIXE7_UP}
- var
- FmtSettings : TFormatSettings;
- {$ENDIF}
- {$IFDEF FPC}
- var
- jdate : string;
- {$ENDIF}
- begin
- {$IFDEF DELPHIXE7_UP}
- Result := ISO8601ToDate(aJsonDate);
- {$ELSE}
- FmtSettings.DateSeparator := '-';
- FmtSettings.TimeSeparator := ':';
- FmtSettings.ShortDateFormat := 'YYYY-MM-DD"T"HH:NN:SS.ZZZ"Z"';
- {$IFDEF FPC}
- jdate := StringReplace(aJsondate,'T',' ',[rfIgnoreCase]);
- jdate := Copy(jdate,1,Pos('.',jdate)-1);
- Result := StrToDateTime(jdate,FmtSettings);
- {$ELSE}
- Result := StrToDateTime(aJsonDate,FmtSettings);
- {$ENDIF}
- {$ENDIF}
- end;
- function CountDigits(anInt: Cardinal): Cardinal; inline;
- var
- cmp: Cardinal;
- begin
- cmp := 10;
- Result := 1;
- while (Result < 10) and (cmp <= anInt) do
- begin
- cmp := cmp*10;
- Inc(Result);
- end;
- end;
- function CountStr(const aFindStr, aSourceStr : string) : Integer;
- var
- i : Integer;
- found : Integer;
- findstr : string;
- mainstr : string;
- begin
- findstr := aFindStr.ToLower;
- mainstr := aSourceStr.ToLower;
- Result := 0;
- i := 0;
- while i < mainstr.Length do
- begin
- found := Pos(findstr,mainstr,i);
- if found > 0 then
- begin
- i := found;
- Inc(Result);
- end
- else Break;
- end;
- end;
- procedure SaveStreamToFile(aStream : TStream; const aFileName : string);
- var
- fs : TFileStream;
- begin
- fs := TFileStream.Create(aFileName,fmCreate);
- try
- aStream.Seek(0,soBeginning);
- fs.CopyFrom(aStream,aStream.Size);
- finally
- fs.Free;
- end;
- end;
- function StreamToString(const aStream: TStream; const aEncoding: TEncoding): string;
- var
- sbytes: TBytes;
- begin
- aStream.Position := 0;
- SetLength(sbytes, aStream.Size);
- aStream.ReadBuffer(sbytes,aStream.Size);
- Result := aEncoding.GetString(sbytes);
- end;
- function StreamToStringEx(aStream : TStream) : string;
- var
- ss : TStringStream;
- begin
- aStream.Position := 0;
- if aStream = nil then Exit;
- if aStream is TMemoryStream then
- begin
- SetString(Result, PChar(TMemoryStream(aStream).Memory), TMemoryStream(aStream).Size div SizeOf(Char));
- end
- else if aStream is TStringStream then
- begin
- Result := TStringStream(aStream).DataString;
- end
- else
- begin
- ss := TStringStream.Create;
- try
- aStream.Seek(0,soBeginning);
- ss.CopyFrom(aStream,aStream.Size);
- Result := ss.DataString;
- finally
- ss.Free;
- end;
- end;
- end;
- procedure StringToStream(const aStr : string; aStream : TStream; const aEncoding: TEncoding);
- var
- stream : TStringStream;
- begin
- stream := TStringStream.Create(aStr,aEncoding);
- try
- aStream.CopyFrom(stream,stream.Size);
- finally
- stream.Free;
- end;
- end;
- procedure StringToStreamEx(const aStr : string; aStream : TStream);
- begin
- aStream.Seek(0,soBeginning);
- aStream.WriteBuffer(Pointer(aStr)^,aStr.Length * SizeOf(Char));
- end;
- function CommaText(aList : TStringList) : string;
- var
- value : string;
- sb : TStringBuilder;
- begin
- if aList.Text = '' then Exit;
- sb := TStringBuilder.Create;
- try
- for value in aList do
- begin
- sb.Append(value);
- sb.Append(',');
- end;
- if sb.Length > 1 then Result := sb.ToString(0, sb.Length - 1);
- finally
- sb.Free;
- end;
- end;
- function CommaText(aArray : TArray<string>) : string;
- var
- value : string;
- sb : TStringBuilder;
- begin
- if High(aArray) < 0 then Exit;
- sb := TStringBuilder.Create;
- try
- for value in aArray do
- begin
- sb.Append(value);
- sb.Append(',');
- end;
- if sb.Length > 1 then Result := sb.ToString(0, sb.Length - 1);
- finally
- sb.Free;
- end;
- end;
- function ArrayToString(aArray : TArray<string>) : string;
- var
- value : string;
- sb : TStringBuilder;
- begin
- Result := '';
- if High(aArray) < 0 then Exit;
- sb := TStringBuilder.Create;
- try
- for value in aArray do
- begin
- sb.Append(value);
- sb.Append(CRLF);
- end;
- Result := sb.ToString;
- finally
- sb.Free;
- end;
- end;
- function ArrayToString(aArray : TArray<string>; aSeparator : string) : string;
- var
- value : string;
- sb : TStringBuilder;
- isfirst : Boolean;
- begin
- Result := '';
- if High(aArray) < 0 then Exit;
- isfirst := True;
- sb := TStringBuilder.Create;
- try
- for value in aArray do
- begin
- if isfirst then isfirst := False
- else sb.Append(aSeparator);
- sb.Append(value);
- end;
- Result := sb.ToString;
- finally
- sb.Free;
- end;
- end;
- function ArrayToString(aArray : TArray<Integer>) : string;
- var
- value : Integer;
- sb : TStringBuilder;
- begin
- Result := '';
- if High(aArray) < 0 then Exit;
- sb := TStringBuilder.Create;
- try
- for value in aArray do
- begin
- sb.Append(value);
- sb.Append(CRLF);
- end;
- Result := sb.ToString;
- finally
- sb.Free;
- end;
- end;
- function ArrayToString(aArray : TArray<Integer>; aSeparator : string) : string;
- var
- value : Integer;
- sb : TStringBuilder;
- isfirst : Boolean;
- begin
- Result := '';
- if High(aArray) < 0 then Exit;
- isfirst := True;
- sb := TStringBuilder.Create;
- try
- for value in aArray do
- begin
- if isfirst then isfirst := False
- else sb.Append(aSeparator);
- sb.Append(value);
- end;
- Result := sb.ToString;
- finally
- sb.Free;
- end;
- end;
- function StringsToArray(aStrings : TStrings) : TArray<string>;
- var
- i : Integer;
- begin
- if aStrings.Count = 0 then Exit;
- SetLength(Result,aStrings.Count);
- for i := 0 to aStrings.Count - 1 do
- begin
- Result[i] := aStrings[i];
- end;
- end;
- function StringsToArray(const aString : string) : TArray<string>;
- var
- item : string;
- begin
- for item in aString.Split([';',',']) do Result := Result + [item.Trim];
- end;
- { TCounter }
- procedure TCounter.Init(aMaxValue : Integer);
- begin
- fMaxValue := aMaxValue;
- fCurrentValue := 0;
- end;
- function TCounter.Count : Integer;
- begin
- Result := fCurrentValue;
- end;
- function TCounter.CountIs(aValue : Integer) : Boolean;
- begin
- Result := fCurrentValue = aValue;
- end;
- function TCounter.Check : Boolean;
- begin
- if fCurrentValue = fMaxValue then
- begin
- Result := True;
- Reset;
- end
- else
- begin
- Result := False;
- Inc(fCurrentValue);
- end;
- end;
- procedure TCounter.Reset;
- begin
- fCurrentValue := fMaxValue;
- end;
- { TimeCounter }
- procedure TTimeCounter.Init(MillisecondsToReach : Integer);
- begin
- fDoneEvery := MillisecondsToReach;
- end;
- function TTimeCounter.Check : Boolean;
- begin
- if MilliSecondsBetween(fCurrentTime,Now) > fDoneEvery then
- begin
- fCurrentTime := Now();
- Result := True;
- end
- else Result := False;
- end;
- procedure TTimeCounter.Reset;
- begin
- fCurrentTime := Now();
- end;
- { TArrayOfStringHelper}
- {$IFNDEF FPC}
- function TArrayOfStringHelper.Any : Boolean;
- begin
- Result := High(Self) >= 0;
- end;
- function TArrayOfStringHelper.Any(const aValue : string) : Boolean;
- begin
- Result := Exists(aValue);
- end;
- function TArrayOfStringHelper.Add(const aValue : string) : Integer;
- begin
- SetLength(Self,Length(Self)+1);
- Self[High(Self)] := aValue;
- Result := High(Self);
- end;
- function TArrayOfStringHelper.AddIfNotExists(const aValue : string; aCaseSense : Boolean = False) : Integer;
- var
- i : Integer;
- begin
- for i := Low(Self) to High(Self) do
- begin
- if aCaseSense then
- begin
- if Self[i] = aValue then Exit(i);
- end
- else
- begin
- if CompareText(Self[i],aValue) = 0 then Exit(i)
- end;
- end;
- //if not exists add it
- Result := Self.Add(aValue);
- end;
- function TArrayOfStringHelper.Remove(const aValue : string) : Boolean;
- var
- i : Integer;
- begin
- for i := Low(Self) to High(Self) do
- begin
- if CompareText(Self[i],aValue) = 0 then
- begin
- {$IFDEF DELPHIXE7_UP}
- System.Delete(Self,i,1);
- {$ELSE}
- TArrayUtil<string>.Delete(Self,i);
- {$ENDIF}
- Exit(True);
- end;
- end;
- Result := False;
- end;
- function TArrayOfStringHelper.Exists(const aValue : string) : Boolean;
- var
- value : string;
- begin
- Result := False;
- for value in Self do
- begin
- if CompareText(value,aValue) = 0 then Exit(True)
- end;
- end;
- function TArrayOfStringHelper.Count : Integer;
- begin
- Result := High(Self) + 1;
- end;
- {$ENDIF}
- { TPairItem }
- constructor TPairItem.Create(const aName, aValue: string);
- begin
- Name := aName;
- Value := aValue;
- end;
- { TPairList }
- function TPairList.GetEnumerator : TPairEnumerator;
- begin
- Result := TPairEnumerator.Create(fItems);
- end;
- function TPairList.Add(aPair: TPairItem): Integer;
- begin
- SetLength(fItems,Length(fItems)+1);
- fItems[High(fItems)] := aPair;
- Result := High(fItems);
- end;
- function TPairList.Add(const aName, aValue: string): Integer;
- begin
- SetLength(fItems,Length(fItems)+1);
- fItems[High(fItems)].Name := aName;
- fItems[High(fItems)].Value := aValue;
- Result := High(fItems);
- end;
- procedure TPairList.AddOrUpdate(const aName, aValue: string);
- var
- i : Integer;
- begin
- for i := Low(fItems) to High(fItems) do
- begin
- if CompareText(fItems[i].Name,aName) = 0 then
- begin
- fItems[i].Value := aValue;
- Exit;
- end;
- end;
- //if not exists add it
- Self.Add(aName,aValue);
- end;
- function TPairList.Count: Integer;
- begin
- Result := High(fItems) + 1;
- end;
- function TPairList.Exists(const aName: string): Boolean;
- var
- i : Integer;
- begin
- Result := False;
- for i := Low(fItems) to High(fItems) do
- begin
- if CompareText(fItems[i].Name,aName) = 0 then Exit(True)
- end;
- end;
- function TPairList.GetPair(const aName: string): TPairItem;
- var
- i : Integer;
- begin
- for i := Low(fItems) to High(fItems) do
- begin
- if CompareText(fItems[i].Name,aName) = 0 then Exit(fItems[i]);
- end;
- end;
- function TPairList.GetValue(const aName: string): string;
- var
- i : Integer;
- begin
- Result := '';
- for i := Low(fItems) to High(fItems) do
- begin
- if CompareText(fItems[i].Name,aName) = 0 then Exit(fItems[i].Value);
- end;
- end;
- function TPairList.Remove(const aName: string): Boolean;
- var
- i : Integer;
- begin
- for i := Low(fItems) to High(fItems) do
- begin
- if CompareText(fItems[i].Name,aName) = 0 then
- begin
- {$IF Defined(DELPHIXE7_UP) OR Defined(FPC)}
- System.Delete(fItems,i,1);
- {$ELSE}
- TArrayUtil<TPairItem>.Delete(fItems,i);
- {$ENDIF}
- Exit(True);
- end;
- end;
- Result := False;
- end;
- function TPairList.ToArray : TArray<TPairItem>;
- begin
- Result := fItems;
- end;
- procedure TPairList.FromArray(aValue : TArray<TPairItem>);
- begin
- fItems := aValue;
- end;
- procedure TPairList.Clear;
- begin
- SetLength(fItems,0);
- end;
- { TPairList.TPairEnumerator}
- constructor TPairList.TPairEnumerator.Create(var aArray: TArray<TPairItem>);
- begin
- fIndex := -1;
- fArray := @aArray;
- end;
- function TPairList.TPairEnumerator.GetCurrent : TPairItem;
- begin
- Result := TArray<TPairItem>(fArray^)[fIndex];
- end;
- function TPairList.TPairEnumerator.MoveNext: Boolean;
- begin
- Inc(fIndex);
- Result := fIndex < High(TArray<TPairItem>(fArray^))+1;
- end;
- {$IFDEF MSWINDOWS}
- procedure ProcessMessages;
- var
- Msg: TMsg;
- begin
- while integer(PeekMessage(Msg, 0, 0, 0, PM_REMOVE)) <> 0 do
- begin
- TranslateMessage(Msg);
- DispatchMessage(Msg);
- end;
- end;
- function GetLastOSError: String;
- begin
- Result := SysErrorMessage(Windows.GetLastError);
- end;
- {$ENDIF}
- function RemoveLastChar(const aText : string) : string;
- begin
- Result := aText.Remove(aText.Length - 1);
- end;
- function DateTimeToSQL(aDateTime : TDateTime) : string;
- begin
- Result := FormatDateTime('YYYY-MM-DD hh:mm:ss',aDateTime);
- end;
- function IsInteger(const aValue : string) : Boolean;
- var
- i : Integer;
- begin
- Result := TryStrToInt(aValue,i);
- end;
- function IsFloat(const aValue : string) : Boolean;
- var
- e : Extended;
- begin
- Result := TryStrToFloat(aValue,e);
- end;
- function IsBoolean(const aValue : string) : Boolean;
- var
- b : Boolean;
- begin
- Result := TryStrToBool(aValue,b);
- end;
- function ExtractStr(var vSource : string; aIndex : Integer; aCount : Integer) : string;
- begin
- if aIndex > vSource.Length then Exit('');
- Result := Copy(vSource,aIndex,aCount);
- Delete(vSource,aIndex,aCount);
- end;
- function GetSubString(const aSource, aFirstDelimiter, aLastDelimiter : string) : string;
- var
- i : Integer;
- begin
- i := Pos(aFirstDelimiter,aSource);
- if i > -1 then Result := Copy(aSource, i + aFirstDelimiter.Length, Pos(aLastDelimiter, aSource, i + aFirstDelimiter.Length) - i - aFirstDelimiter.Length)
- else Result := '';
- end;
- function DbQuotedStr(const str : string): string;
- var
- i : Integer;
- begin
- Result := str;
- for i := Result.Length - 1 downto 0 do
- begin
- if Result.Chars[i] = '"' then Result := Result.Insert(i, '"');
- end;
- Result := '"' + Result + '"';
- end;
- function UnDbQuotedStr(const str: string) : string;
- begin
- Result := Trim(str);
- if not Result.IsEmpty then
- begin
- if Result.StartsWith('"') then Result := Copy(Result, 2, Result.Length - 2);
- end;
- end;
- function SpQuotedStr(const str : string): string;
- begin
- Result := '''' + str + '''';
- end;
- function UnSpQuotedStr(const str: string) : string;
- begin
- Result := Trim(str);
- if not Result.IsEmpty then
- begin
- if Result.StartsWith('''') then Result := Copy(Result, 2, Result.Length - 2);
- end;
- end;
- function UnQuotedStr(const str : string; const aQuote : Char) : string;
- begin
- if (str.Length > 0) and (str[Low(str)] = aQuote) and (str[High(str)] = aQuote) then Result := Copy(str, Low(str)+1, High(str) - 2)
- else Result := str;
- end;
- function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : string) : string;
- begin
- if aCondition then Result := aIfIsTrue else Result := aIfIsFalse;
- end;
- function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : Integer) : Integer;
- begin
- if aCondition then Result := aIfIsTrue else Result := aIfIsFalse;
- end;
- function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : Extended) : Extended;
- begin
- if aCondition then Result := aIfIsTrue else Result := aIfIsFalse;
- end;
- function Ifx(aCondition : Boolean; const aIfIsTrue, aIfIsFalse : TObject) : TObject;
- begin
- if aCondition then Result := aIfIsTrue else Result := aIfIsFalse;
- end;
- {$IFNDEF FPC}
- {$IFNDEF DELPHIXE7_UP}
- class procedure TArrayUtil<T>.Delete(var aArray : TArray<T>; aIndex : Integer);
- var
- n : Integer;
- len : Integer;
- begin
- len := Length(aArray);
- if (len > 0) and (aIndex < len) then
- begin
- for n := aIndex + 1 to len - 1 do aArray[n - 1] := aArray[n];
- SetLength(aArray, len - 1);
- end;
- end;
- {$ENDIF}
- {$ENDIF}
- { TDateTimeHelper }
- {$IFDEF DELPHIXE7_UP}
- function TDateTimeHelper.ToSQLString : string;
- begin
- Result := DateTimeToSQL(Self);
- end;
- procedure TDateTimeHelper.FromNow;
- begin
- Self := Now;
- end;
- procedure TDateTimeHelper.FromUTC(const aUTCTime: TDateTime);
- begin
- Self := UTCToLocalTime(aUTCTime);
- end;
- function TDateTimeHelper.IncDay(const aValue : Cardinal = 1) : TDateTime;
- begin
- Result := System.DateUtils.IncDay(Self,aValue);
- end;
- function TDateTimeHelper.DecDay(const aValue : Cardinal = 1) : TDateTime;
- begin
- Result := System.DateUtils.IncDay(Self,-aValue);
- end;
- function TDateTimeHelper.IncMonth(const aValue : Cardinal = 1) : TDateTime;
- begin
- Result := SysUtils.IncMonth(Self,aValue);
- end;
- function TDateTimeHelper.DecMonth(const aValue : Cardinal = 1) : TDateTime;
- begin
- Result := SysUtils.IncMonth(Self,-aValue);
- end;
- function TDateTimeHelper.IncYear(const aValue : Cardinal = 1) : TDateTime;
- begin
- Result := System.DateUtils.IncYear(Self,aValue);
- end;
- function TDateTimeHelper.DecYear(const aValue : Cardinal = 1) : TDateTime;
- begin
- Result := System.DateUtils.IncYear(Self,-aValue);
- end;
- function TDateTimeHelper.IsEqualTo(const aDateTime : TDateTime) : Boolean;
- begin
- Result := Self = aDateTime;
- end;
- function TDateTimeHelper.IsAfter(const aDateTime : TDateTime) : Boolean;
- begin
- Result := Self > aDateTime;
- end;
- function TDateTimeHelper.IsBefore(const aDateTime : TDateTime) : Boolean;
- begin
- Result := Self < aDateTime;
- end;
- function TDateTimeHelper.IsSameDay(const aDateTime : TDateTime) : Boolean;
- begin
- Result := System.DateUtils.SameDate(Self,aDateTime);
- end;
- function TDateTimeHelper.IsSameTime(const aTime : TTime) : Boolean;
- begin
- Result := System.DateUtils.SameTime(Self,aTime);
- end;
- function TDateTimeHelper.DayOfTheWeek : Word;
- begin
- Result := System.DateUtils.NthDayOfWeek(Self);
- end;
- function TDateTimeHelper.ToJsonFormat : string;
- begin
- Result := DateTimeToJsonDate(Self);
- end;
- function TDateTimeHelper.ToGMTFormat : string;
- begin
- Result := DateTimeToGMT(Self);
- end;
- function TDateTimeHelper.ToTimeStamp : TTimeStamp;
- begin
- Result := DateTimeToTimeStamp(Self);
- end;
- function TDateTimeHelper.ToUTC : TDateTime;
- begin
- Result := LocalTimeToUTC(Self);
- end;
- function TDateTimeHelper.ToMilliseconds : Int64;
- begin
- {$IFDEF DELPHIRX104_ANDUP}
- Result := System.DateUtils.DateTimeToMilliseconds(Self);
- {$ELSE}
- Result := System.DateUtils.MilliSecondOf(Self);
- {$ENDIF}
- end;
- function TDateTimeHelper.ToString : string;
- begin
- Result := DateTimeToStr(Self);
- end;
- function TDateTimeHelper.Date : TDate;
- begin
- Result := System.DateUtils.DateOf(Self);
- end;
- function TDateTimeHelper.Time : TTime;
- begin
- Result := System.DateUtils.TimeOf(Self);
- end;
- function TDateTimeHelper.IsAM : Boolean;
- begin
- Result := System.DateUtils.IsAM(Self);
- end;
- function TDateTimeHelper.IsPM : Boolean;
- begin
- Result := System.DateUtils.IsPM(Self);
- end;
- { TDateHelper }
- function TDateHelper.ToString : string;
- begin
- Result := DateToStr(Self);
- end;
- { TTimeHelper }
- function TTimeHelper.ToString : string;
- begin
- Result := TimeToStr(Self);
- end;
- {$ENDIF}
- {$IFNDEF NEXTGEN}
- initialization
- try
- GetEnvironmentPaths;
- except
- {$IFDEF SHOW_ENVIRONMENTPATH_ERRORS}
- on E : Exception do
- begin
- if not IsService then
- begin
- if HasConsoleOutput then Writeln(Format('[WARN] GetEnvironmentPaths: %s',[E.Message]))
- else MessageBox(0,PWideChar(Format('Get environment path error: %s',[E.Message])),'GetEnvironmentPaths',MB_ICONEXCLAMATION);
- end;
- end;
- {$ENDIF}
- end;
- {$ENDIF}
- end.
|