123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391 |
- { ***************************************************************************
- Copyright (c) 2016-2022 Kike P�rez
- Unit : Quick.Commons
- Description : Common functions
- Author : Kike P�rez
- Version : 2.0
- Created : 14/07/2017
- Modified : 19/01/2022
- 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;
- //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 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.
|