{ ***************************************************************************

unit Quick.Commons;

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;

TLogEventType = (etInfo, etSuccess, etWarning, etError, etDebug, etDone, etTrace, etCritical, etException);

TLogVerbose = set of TLogEventType;

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;

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;

path : TEnvironmentPath;

//Enabled if QuickService is defined

IsQuickServiceApp : Boolean;

class function TFileHelper.IsInUse(const FileName : string) : Boolean;

HFileRes: HFILE;

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;

class function TFileHelper.IsInUse(const FileName : string) : Boolean;

fs : TFileStream;

try

fs := TFileStream.Create(FileName, fmOpenReadWrite, fmShareExclusive);

Result := True;

fs.Free;

except

Result := False;

end;

end;

class function TFileHelper.GetSize(const FileName: String): Int64;

info: TWin32FileAttributeData;

Result := -1;

if not GetFileAttributesEx(PWideChar(FileName), GetFileExInfoStandard, @info) then Exit;

Result := Int64(info.nFileSizeLow) or Int64(info.nFileSizeHigh shl 32);

end;

class function TFileHelper.GetSize(const FileName: String): Int64;

sr : TSearchRec;

if FindFirst(fileName, faAnyFile, sr ) = 0 then Result := sr.Size

else Result := -1;

end;

class function TDirectoryHelper.GetSize(const Path: String): Int64;

filename : string;

Result := -1;

for filename in TDirectory.GetFiles(Path) do

begin

Result := Result + TFile.GetSize(filename);

end;

end;

function RandomPassword(const PasswordLength : Integer; Complexity : TPasswordComplexity = [pfIncludeNumbers,pfIncludeSigns]) : string;

PassAlpha = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';

PassSigns = '@!&$';

PassNumbers = '1234567890';

MinNumbers,

MinSigns : Integer;

NumNumbers,

NumSigns : Integer;

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;

chars : string = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890';

i : Integer;

clong : Integer;

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;

Result := TPath.GetFileNameWithoutExtension(FileName);

end;

function UnixToWindowsPath(const UnixPath: string): string;

Result := StringReplace(UnixPath, '/', '\',[rfReplaceAll, rfIgnoreCase]);

end;

function WindowsToUnixPath(const WindowsPath: string): string;

Result := StringReplace(WindowsPath, '\', '/',[rfReplaceAll, rfIgnoreCase]);

end;

function CorrectURLPath(const cUrl : string) : string;

nurl : string;

nurl := WindowsToUnixPath(cUrl);

nurl := StringReplace(nurl,'//','/',[rfReplaceAll]);

Result := StringReplace(nurl,' ','%20',[rfReplaceAll]);

//TNetEncoding.Url.Encode()

end;

function UrlGetProtocol(const aUrl : string) : string;

Result := aUrl.SubString(0,aUrl.IndexOf('://'));

end;

function UrlGetHost(const aUrl : string) : string;

url : string;

len : Integer;

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;

url : string;

len : Integer;

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;

if not aUrl.Contains('?') then Exit('');

Result := aUrl.Substring(aUrl.IndexOf('?')+1);

end;

function UrlRemoveProtocol(const aUrl : string) : string;

pos : Integer;

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;

if not aUrl.Contains('?') then Exit(aUrl);

Result := aUrl.Substring(0,aUrl.IndexOf('?'));

end;

function UrlSimpleEncode(const aUrl : string) : string;

Result := StringReplace(aUrl,' ','%20',[rfReplaceAll]);

end;

procedure GetEnvironmentPaths;

//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;

function GetSpecialFolderPath(folderID : Integer) : string;

shellMalloc: IMalloc;

ppidl: PItemIdList;

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;

{$IFDEF WIN64}

Result := True;

{$ELSE}

Result := False;

{$ENDIF WIN64}

end;

function IsConsole: Boolean;

{$IFDEF CONSOLE}

Result := True;

{$ELSE}

Result := False;

{$ENDIF CONSOLE}

end;

function HasConsoleOutput : Boolean;

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;

begin

Result := IsConsole;

end;

function IsDebug: Boolean;

{$IFDEF DEBUG}

Result := True;

{$ELSE}

Result := False;

{$ENDIF DEBUG}

end;

function IsService : Boolean;

//only working with my Quick.AppService unit

try

Result := (IsConsole) and (not HasConsoleOutput);

except

Result := False;

end;

end;

function SecondsIdle: DWord;

liInfo: TLastInputInfo;

liInfo.cbSize := SizeOf(TLastInputInfo) ;

GetLastInputInfo(liInfo) ;

Result := (GetTickCount - liInfo.dwTime) DIV 1000;

end;

procedure FreeUnusedMem;

if Win32Platform = VER_PLATFORM_WIN32_NT then SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);

end;

function SetScreenResolution(Width, Height: integer): Longint;

DeviceMode: TDeviceMode;

with DeviceMode do

begin

dmSize := SizeOf(TDeviceMode);

dmPelsWidth := Width;

dmPelsHeight := Height;

dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;

end;

Result := ChangeDisplaySettings(DeviceMode, CDS_UPDATEREGISTRY);

end;

function LastDayCurrentMonth: TDateTime;

Result := EncodeDate(YearOf(Now),MonthOf(Now), DaysInMonth(Now));

end;

function DateTimeInRange(ADateTime: TDateTime; AStartDateTime, AEndDateTime: TDateTime; aInclusive: Boolean = True): Boolean;

if aInclusive then

Result := (AStartDateTime <= ADateTime) and (ADateTime <= AEndDateTime)

else

Result := (AStartDateTime < ADateTime) and (ADateTime < AEndDateTime);

end;

function IsSameDay(cBefore, cNow : TDateTime) : Boolean;

//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;

y, m, d : Word;

DecodeDate(aDate,y,m,d);

Result := EncodeDateTime(y,m,d,aHour,aMinute,aSecond,aMilliSecond);

end;

function ChangeDateOfADay(aDate : TDateTime; aYear, aMonth, aDay : Word) : TDateTime;

h, m, s, ms : Word;

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;

i : Integer;

Result := '';

for i := 1 to Count do Result := Result + C;

end;

function FillStrEx(const value : string; const Count : Integer) : string;

i : Integer;

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;

s : string;

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;

i : Integer;

for i in aInArray do

begin

if i = aValue then Exit(True);

end;

Result := False;

end;

function IsEmptyArray(aArray : TArray<string>) : Boolean;

Result := Length(aArray) = 0;

end;

function IsEmptyArray(aArray : TArray<Integer>) : Boolean;

Result := Length(aArray) = 0;

end;

function Zeroes(const Number, Len : Int64) : string;

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;

try

Result := FormatFloat('0,',Number);

except

Result := '#Error';

end;

end;

function Spaces(const Count : Integer) : string;

Result := FillStr(' ',Count);

end;

function NowStr : string;

Result := DateTimeToStr(Now());

end;

function NewGuidStr : string;

guid : TGUID;

{$IFDEF DELPHIRX10_UP}

Result := TGUID.NewGuid.ToString;

{$ELSE}

guid.NewGuid;

Result := guid.ToString

{$ENDIF}

end;

function IsLike(cText, Pattern: string) : Boolean;

i, n : Integer;

match : Boolean;

wildcard : Boolean;

CurrentPattern : Char;

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;