{ This file is part of the Pas2JS run time library. Copyright (c) 2017 by Mattias Gaertner See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} unit SysUtils; {$mode objfpc} {$modeswitch typehelpers} {$modeswitch advancedrecords} interface uses RTLConsts, js; procedure FreeAndNil(var Obj); type TProcedure = procedure; {***************************************************************************** Various types *****************************************************************************} Const FloatRecDigits = 19; type { TFloatRec } TFloatRec = Record Exponent: Integer; Negative: Boolean; Digits: Array[0..FloatRecDigits-1] of Char; End; TEndian = (Little,Big); TFileName = String; TByteArray = array [0..32767] of Byte; TWordArray = array [0..16383] of Word; TBytes = Array of byte; TStringArray = array of string; TMonthNameArray = array [1..12] of string; TDayTable = array [1..12] of Word; TWeekNameArray = array [1..7] of string; TMonthNames = TMonthNameArray; TDayNames = array[0..6] of string; {***************************************************************************** Exception handling *****************************************************************************} { Exception } Exception = class(TObject) private fMessage: String; fHelpContext: Integer; {$ifdef NodeJS} FNodeJSError: TJSError; {$endif} public class var LogMessageOnCreate : Boolean; Public constructor Create(const Msg: String); reintroduce; constructor CreateFmt(const Msg: string; const Args: array of jsvalue); constructor CreateHelp(const Msg: String; AHelpContext: Integer); constructor CreateFmtHelp(const Msg: string; const Args: array of jsvalue; AHelpContext: Integer); function ToString: String; override; property HelpContext: Integer read fHelpContext write fHelpContext; property Message: String read fMessage write fMessage; {$ifdef NodeJS} property NodeJSError: TJSError read FNodeJSError write FNodeJSError; {$endif} end; ExceptClass = class of Exception; EExternal = class(Exception); { General math errors } EMathError = class(EExternal); EInvalidOp = class(EMathError); EZeroDivide = class(EMathError); EOverflow = class(EMathError); EUnderflow = class(EMathError); EAbort = class(Exception); EInvalidCast = class(Exception); EAssertionFailed = class(Exception); EObjectCheck = class(Exception); { String conversion errors } EConvertError = class(Exception); EFormatError = class(Exception); { integer math exceptions } EIntError = Class(EExternal); EDivByZero = Class(EIntError); ERangeError = Class(EIntError); EIntOverflow = Class(EIntError); { General math errors } { Run-time and I/O Errors } EInOutError = class(Exception) public ErrorCode : Integer; end; EHeapMemoryError = class(Exception); EHeapException = EHeapMemoryError; EExternalException = class(EExternal); EInvalidPointer = Class(EHeapMemoryError); EOutOfMemory = Class(EHeapMemoryError); { EVariantError } EVariantError = Class(Exception) ErrCode : longint; Constructor CreateCode(Code : Longint); end; EAccessViolation = Class(EExternal); EBusError = Class(EAccessViolation); EPrivilege = class(EExternal); EStackOverflow = class(EExternal); EControlC = class(EExternal); { String conversion errors } { Other errors } EAbstractError = Class(Exception); EPropReadOnly = class(Exception); EPropWriteOnly = class(Exception); EIntfCastError = class(Exception); EInvalidContainer = class(Exception); EInvalidInsert = class(Exception); EPackageError = class(Exception); EOSError = class(Exception) public ErrorCode: Longint; end; ESafecallException = class(Exception); ENoThreadSupport = Class(Exception); ENoWideStringSupport = Class(Exception); ENotImplemented = class(Exception); EArgumentException = class(Exception); EArgumentOutOfRangeException = class(EArgumentException); EArgumentNilException = class(EArgumentException); EPathTooLongException = class(Exception); ENotSupportedException = class(Exception); EDirectoryNotFoundException = class(Exception); EFileNotFoundException = class(Exception); EPathNotFoundException = class(Exception); ENoConstructException = class(Exception); //function GetTickCount: Integer; {***************************************************************************** String function *****************************************************************************} Const EmptyStr = ''; EmptyWideStr = ''; // No difference here. HexDisplayPrefix: string = '$'; LeadBytes = [] unimplemented; Function CharInSet(Ch: Char;Const CSet : array of char) : Boolean; overload; function LeftStr(const S: string; Count: Integer): String; assembler; function RightStr(const S: string; Count: Integer): String; assembler; function Trim(const S: String): String; assembler; function TrimLeft(const S: String): String; assembler; function TrimRight(const S: String): String; assembler; function UpperCase(const s: String): String; assembler; overload; function LowerCase(const s: String): String; assembler; overload; function CompareStr(const s1, s2: String): Integer; assembler; function SameStr(const s1, s2: String): Boolean; assembler; function CompareText(const s1, s2: String): Integer; assembler; function SameText(const s1, s2: String): Boolean; assembler; function AnsiCompareText(const s1, s2: String): Integer; assembler; function AnsiSameText(const s1, s2: String): Boolean; assembler; function AnsiCompareStr(const s1, s2: String): Integer; procedure AppendStr(var Dest: String; const S: string); function Format(const Fmt: String; const Args: array of JSValue): String; function BytesOf(const AVal: string): TBytes; function StringOf(const ABytes: TBytes): string; // JavaScript built-in functions function LocaleCompare(const s1, s2, locales: String): Boolean; assembler; overload; function NormalizeStr(const S: String; const Norm: String = 'NFC'): String; assembler; overload; // not in IE function IsValidIdent(const Ident: string; AllowDots: Boolean = False; StrictDots: Boolean = False): Boolean; Type TStringReplaceFlag = (rfReplaceAll, rfIgnoreCase); TReplaceFlag = TStringReplaceFlag; TStringReplaceFlags = set of TStringReplaceFlag; TReplaceFlags = TStringReplaceFlags; function StringReplace(aOriginal, aSearch, aReplace: string; Flags: TStringReplaceFlags): String; function QuoteString(aOriginal: String; AQuote: Char): String; function QuotedStr(const s: string; QuoteChar: Char = ''''): string; function DeQuoteString(aQuoted: String; AQuote: Char): String; Function LastDelimiter(const Delimiters, S: string): SizeInt; function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean; function AdjustLineBreaks(const S: string): string; function AdjustLineBreaks(const S: string; Style: TTextLineBreakStyle): string; function WrapText(const Line, BreakStr: string; const BreakChars: Array of char; MaxCol: Integer): string; function WrapText(const Line: string; MaxCol: Integer): string; { ***************************************************************************** Integer conversions *****************************************************************************} function IntToStr(const Value: Integer): string; Function TryStrToInt(const S : String; Out res : Integer) : Boolean; Function TryStrToInt(const S : String; Out res : NativeInt) : Boolean; Function StrToIntDef(const S : String; Const aDef : Integer) : Integer; Function StrToIntDef(const S : String; Const aDef : NativeInt) : NativeInt; Function StrToInt(const S : String) : Integer; Function StrToNativeInt(const S : String) : NativeInt; // For compatibility Function StrToInt64(const S : String) : NativeLargeInt; Function StrToInt64Def(const S : String; ADefault : NativeLargeInt) : NativeLargeInt; Function TryStrToInt64(const S : String; Out res : NativeLargeInt) : Boolean; Function StrToQWord(const S : String) : NativeLargeUInt; Function StrToQWordDef(const S : String; ADefault : NativeLargeUInt) : NativeLargeUInt; Function TryStrToQWord(const S : String; Out res : NativeLargeUInt) : Boolean; Function StrToUInt64(const S : String) : NativeLargeUInt; Function StrToUInt64Def(const S : String; ADefault : NativeLargeUInt) : NativeLargeUInt; Function TryStrToUInt64(const S : String; Out res : NativeLargeUInt) : Boolean; Function StrToDWord(const S : String) : DWord; Function StrToDWordDef(const S : String; ADefault : DWord) : DWord; Function TryStrToDWord(const S : String; Out res : DWord) : Boolean; function IntToHex(Value: NativeInt; Digits: Integer): string; overload; { ***************************************************************************** Float conversions *****************************************************************************} const // Note: Currency is internally a double, multiplied by 10000 and truncated. // The below values are the safe limits, within every step exists. // Since currency is a double it can take much larger values, but the result // may differ from Delphi/FPC MaxCurrency: Currency = 900719925474.0991; // fpc: 922337203685477.5807; MinCurrency: Currency = -900719925474.0991; // fpc: -922337203685477.5808; Type TFloatFormat = (ffFixed,ffGeneral,ffExponent,ffNumber,ffCurrency); Function FloatToDecimal(Value : double; Precision, Decimals : integer) : TFloatRec; Function FloatToStr(Value: Double): String; Function FloatToStrF(const Value : double; format: TFloatFormat; Precision, Digits: Integer): String; Function TryStrToFloat(const S : String; Out res : Extended) : Boolean; overload; Function TryStrToFloat(const S : String; Out res : Double) : Boolean; overload; Function StrToFloatDef(const S : String; Const aDef : Double) : Double; Function StrToFloat(const S : String) : Double; Function FormatFloat (Fmt : String; aValue : Double) : String; Function SwapEndian(W : Word) : Word; Function SwapEndian(C : Cardinal) : Cardinal; { ***************************************************************************** Boolean conversions *****************************************************************************} Var TrueBoolStrs, FalseBoolStrs : Array of String; function StrToBool(const S: String): Boolean; function BoolToStr(B: Boolean; UseBoolStrs:Boolean=False): string; function BoolToStr(B: Boolean; const TrueS, FalseS: String): string; function StrToBoolDef(const S: String; Default: Boolean): Boolean; function TryStrToBool(const S: String; out Value: Boolean): Boolean; {***************************************************************************** OS/Environment *****************************************************************************} Const ConfigExtension : String = '.cfg'; SysConfigDir : String = ''; type TOnGetEnvironmentVariable = function(Const EnvVar: String): String; TOnGetEnvironmentString = function(Index: Integer): String; TOnGetEnvironmentVariableCount = function: Integer; TShowExceptionHandler = Procedure (Const Msg : String); TUncaughtPascalExceptionHandler = reference to Procedure(aObject : TObject); TUncaughtJSExceptionHandler = reference to Procedure(aObject : TJSObject); var OnGetEnvironmentVariable: TOnGetEnvironmentVariable; OnGetEnvironmentString: TOnGetEnvironmentString; OnGetEnvironmentVariableCount: TOnGetEnvironmentVariableCount; // Handler to show an exception (used when showexception is called) OnShowException : TShowExceptionHandler = nil; // Set handlers for uncaught exceptions. These will call HookUncaughtExceptions // They return the old exception handler, if there was any. Function SetOnUnCaughtExceptionHandler(aValue : TUncaughtPascalExceptionHandler) : TUncaughtPascalExceptionHandler; Function SetOnUnCaughtExceptionHandler(aValue : TUncaughtJSExceptionHandler) : TUncaughtJSExceptionHandler; // Hook the rtl handler for uncaught exceptions. If any exception handlers were set, they will be called. // If none were set, the exceptions will be displayed using ShowException. Procedure HookUncaughtExceptions; function GetEnvironmentVariable(Const EnvVar: String): String; function GetEnvironmentVariableCount: Integer; function GetEnvironmentString(Index: Integer): String; procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer = Nil); Procedure Abort; {***************************************************************************** Events *****************************************************************************} Type TEventType = (etCustom,etInfo,etWarning,etError,etDebug); TEventTypes = Set of TEventType; {***************************************************************************** Date and time *****************************************************************************} Type TSystemTime = record Year, Month, Day, DayOfWeek: word; Hour, Minute, Second, MilliSecond: word; end ; TTimeStamp = record Time: longint; { Number of milliseconds since midnight } Date: longint; { One plus number of days since 1/1/0001 } end ; Var TimeSeparator : char = ':'; DateSeparator : char = '-'; ShortDateFormat : string = 'yyyy-mm-dd'; LongDateFormat : string = 'ddd, yyyy-mm-dd'; ShortTimeFormat : string = 'hh:nn'; LongTimeFormat : string = 'hh:nn:ss'; DecimalSeparator : string = '.'; ThousandSeparator : string; TimeAMString : string = 'AM'; TimePMString : string = 'PM'; const HoursPerDay = 24; MinsPerHour = 60; SecsPerMin = 60; MSecsPerSec = 1000; MinsPerDay = HoursPerDay * MinsPerHour; SecsPerDay = MinsPerDay * SecsPerMin; MSecsPerDay = SecsPerDay * MSecsPerSec; MaxDateTime: TDateTime = 2958465.99999999; MinDateTime: TDateTime = -693593.99999999; JulianEpoch = TDateTime(-2415018.5); UnixEpoch = JulianEpoch + TDateTime(2440587.5); DateDelta = 693594; // Days between 1/1/0001 and 12/31/1899 UnixDateDelta = 25569; { True=Leapyear } Var MonthDays : array [Boolean] of TDayTable = ((31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31), (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)); ShortMonthNames : TMonthNames = ( 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); LongMonthNames : TMonthNames = ( 'January', 'February', 'March', 'April', 'May', 'June', 'July', 'August', 'September', 'October', 'November', 'December'); ShortDayNames : TDayNames = ( 'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'); LongDayNames : TDayNames = ( 'Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday'); type // Stub, for easier porting of FPC/Delphi code. // Reading/Writing the properties will actually set the global variables { TFormatSettings } TFormatSettings = class(TObject) private function GetCurrencyDecimals: Byte; function GetCurrencyFormat: Byte; function GetCurrencyString: String; function GetDateSeparator: char; function GetDecimalSeparator: string; function GetLongDateFormat: string; function GetLongDayNames: TDayNames; function GetLongMonthNames: TMonthNames; function GetLongTimeFormat: string; function GetNegCurrFormat: Byte; function GetShortDateFormat: string; function GetShortDayNames: TDayNames; function GetShortMonthNames: TMonthNames; function GetShortTimeFormat: string; function GetThousandSeparator: string; function GetTimeAMString: string; function GetTimePMString: string; function GetTimeSeparator: char; procedure SetCurrencyFormat(AValue: Byte); procedure SetCurrencyString(AValue: String); procedure SetDateSeparator(const Value: char); procedure SetDecimalSeparator(const Value: string); procedure SetLongDateFormat(const Value: string); procedure SetLongDayNames(AValue: TDayNames); procedure SetLongMonthNames(AValue: TMonthNames); procedure SetLongTimeFormat(const Value: string); procedure SetNegCurrFormat(AValue: Byte); procedure SetShortDateFormat(const Value: string); procedure SetShortDayNames(AValue: TDayNames); procedure SetShortMonthNames(AValue: TMonthNames); procedure SetShortTimeFormat(const Value: string); procedure SetCurrencyDecimals(AValue: Byte); procedure SetThousandSeparator(const Value: string); procedure SetTimeAMString(const Value: string); procedure SetTimePMString(const Value: string); procedure SetTimeSeparator(const Value: char); public class constructor Init; Property ShortMonthNames : TMonthNames Read GetShortMonthNames Write SetShortMonthNames; Property LongMonthNames : TMonthNames Read GetLongMonthNames Write SetLongMonthNames; Property ShortDayNames : TDayNames Read GetShortDayNames Write SetShortDayNames; Property LongDayNames : TDayNames Read GetLongDayNames Write SetLongDayNames; property TimeSeparator : char read GetTimeSeparator write SetTimeSeparator; property DateSeparator : char read GetDateSeparator write SetDateSeparator; property ShortDateFormat : string read GetShortDateFormat write SetShortDateFormat; property LongDateFormat : string read GetLongDateFormat write SetLongDateFormat; property ShortTimeFormat : string read GetShortTimeFormat write SetShortTimeFormat; property LongTimeFormat : string read GetLongTimeFormat write SetLongTimeFormat; property DecimalSeparator : string read GetDecimalSeparator write SetDecimalSeparator; property ThousandSeparator : string read GetThousandSeparator write SetThousandSeparator; property TimeAMString : string read GetTimeAMString write SetTimeAMString; property TimePMString : string read GetTimePMString write SetTimePMString; Property CurrencyFormat : Byte read GetCurrencyFormat Write SetCurrencyFormat; Property NegCurrFormat : Byte read GetNegCurrFormat Write SetNegCurrFormat; Property CurrencyDecimals : Byte Read GetCurrencyDecimals Write SetCurrencyDecimals; Property CurrencyString : String Read GetCurrencyString Write SetCurrencyString; end; Var FormatSettings: TFormatSettings; TwoDigitYearCenturyWindow : word = 50; { Threshold to be subtracted from year before age-detection.} function DateTimeToJSDate(aDateTime : TDateTime) : TJSDate; function JSDateToDateTime(aDate : TJSDate) : TDateTime; function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp; function TimeStampToDateTime(const TimeStamp: TTimeStamp): TDateTime; function MSecsToTimeStamp(MSecs: NativeInt): TTimeStamp; function TimeStampToMSecs(const TimeStamp: TTimeStamp): NativeInt; function TryEncodeDate(Year, Month, Day: Word; out Date: TDateTime): Boolean; function TryEncodeTime(Hour, Min, Sec, MSec: Word; out Time: TDateTime): Boolean; function EncodeDate(Year, Month, Day :word): TDateTime; function EncodeTime(Hour, Minute, Second, MilliSecond:word): TDateTime; function ComposeDateTime(Date,Time : TDateTime) : TDateTime; procedure DecodeDate(Date: TDateTime; out Year, Month, Day: word); function DecodeDateFully(const DateTime: TDateTime; out Year, Month, Day, DOW: Word): Boolean; procedure DecodeTime(Time: TDateTime; out Hour, Minute, Second, MilliSecond: word); procedure DateTimeToSystemTime(DateTime: TDateTime; out SystemTime: TSystemTime); function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime; function DayOfWeek(DateTime: TDateTime): integer; function Date: TDateTime; function Time: TDateTime; function Now: TDateTime; function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer = 1 ): TDateTime; procedure IncAMonth(var Year, Month, Day: Word; NumberOfMonths: Integer = 1); function IsLeapYear(Year: Word): boolean; function DateToStr(Date: TDateTime): string; // function DateToStr(Date: TDateTime; const FormatSettings: TFormatSettings): string; function TimeToStr(Time: TDateTime): string; // function TimeToStr(Time: TDateTime; const FormatSettings: TFormatSettings): string; function DateTimeToStr(DateTime: TDateTime; ForceTimeIfZero : Boolean = False): string; // function DateTimeToStr(DateTime: TDateTime; const FormatSettings: TFormatSettings; ForceTimeIfZero : Boolean = False): string; function StrToDate(const S: String): TDateTime; function StrToDate(const S: String; separator : char): TDateTime; function StrToDate(const S: String; const useformat : string; separator : char): TDateTime; //function StrToDate(const S: string; FormatSettings : TFormatSettings): TDateTime; function StrToTime(const S: String): TDateTime; function StrToTime(const S: String; separator : char): TDateTime; // function StrToTime(const S: string; FormatSettings : TFormatSettings): TDateTime; function StrToDateTime(const S: String): TDateTime; //function StrToDateTime(const s: ShortString; const FormatSettings : TFormatSettings): TDateTime; function FormatDateTime(const FormatStr: string; const DateTime: TDateTime): string; // function FormatDateTime(const FormatStr: string; DateTime: TDateTime; const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []): string; function TryStrToDate(const S: String; out Value: TDateTime): Boolean; function TryStrToDate(const S: String; out Value: TDateTime; separator : char): Boolean; function TryStrToDate(const S: String; out Value: TDateTime; const useformat : string; separator : char): Boolean; // function TryStrToDate(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean; function TryStrToTime(const S: String; out Value: TDateTime): Boolean; function TryStrToTime(const S: String; out Value: TDateTime; separator : char): Boolean; function TryStrToDateTime(const S: String; out Value: TDateTime): Boolean; // function TryStrToTime(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean; // function TryStrToDateTime(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean; function StrToDateDef(const S: String; const Defvalue : TDateTime): TDateTime; function StrToDateDef(const S: String; const Defvalue : TDateTime; separator : char): TDateTime; function StrToTimeDef(const S: String; const Defvalue : TDateTime): TDateTime; function StrToTimeDef(const S: String; const Defvalue : TDateTime; separator : char): TDateTime; function StrToDateTimeDef(const S: String; const Defvalue : TDateTime): TDateTime; function CurrentYear:Word; procedure ReplaceTime(var dati: TDateTime; NewTime : TDateTime); procedure ReplaceDate(var DateTime: TDateTime; const NewDate: TDateTime); Function FloatToDateTime (Const Value : Extended) : TDateTime; { ***************************************************************************** Currency support *****************************************************************************} Var CurrencyFormat : Byte = 0; NegCurrFormat : Byte = 0; CurrencyDecimals : Byte = 2; CurrencyString : String = '$'; Function FloattoCurr (Const Value : Extended) : Currency; function TryFloatToCurr(const Value: Extended; var AResult: Currency): Boolean; Function CurrToStr(Value: Currency): string; //Function CurrToStr(Value: Currency; Const FormatSettings: TFormatSettings): string; function StrToCurr(const S: string): Currency; //function StrToCurr(const S: string; Const FormatSettings: TFormatSettings): Currency; function TryStrToCurr(const S: string;Out Value : Currency): Boolean; //function TryStrToCurr(const S: string;Out Value : Currency; Const FormatSettings: TFormatSettings): Boolean; function StrToCurrDef(const S: string; Default : Currency): Currency; //function StrToCurrDef(const S: string; Default : Currency; Const FormatSettings: TFormatSettings): Currency; {***************************************************************************** File Paths *****************************************************************************} type PathStr = String; TPathStrArray = Array of PathStr; function ChangeFileExt(const FileName, Extension: PathStr): PathStr; function ExtractFilePath(const FileName: PathStr): PathStr; function ExtractFileDrive(const FileName: PathStr): PathStr; function ExtractFileName(const FileName: PathStr): PathStr; function ExtractFileExt(const FileName: PathStr): PathStr; function ExtractFileDir(Const FileName : PathStr): PathStr; function ExtractRelativepath (Const BaseName,DestName : PathStr): PathStr; function IncludeTrailingPathDelimiter(Const Path : PathStr) : PathStr; function ExcludeTrailingPathDelimiter(Const Path: PathStr): PathStr; function IncludeLeadingPathDelimiter(Const Path : PathStr) : PathStr; function ExcludeLeadingPathDelimiter(Const Path: PathStr): PathStr; function IsPathDelimiter(Const Path: PathStr; Index: Integer): Boolean; Function SetDirSeparators (Const FileName : PathStr) : PathStr; Function GetDirs (DirName : PathStr) : TPathStrArray; function ConcatPaths(const Paths: array of PathStr): PathStr; {***************************************************************************** Interfaces *****************************************************************************} const GUID_NULL: TGuid = '{00000000-0000-0000-0000-000000000000}'; function Supports(const Instance: IInterface; const AClass: TClass; out Obj): Boolean; overload; function Supports(const Instance: IInterface; const IID: TGuid; out Intf): Boolean; overload; function Supports(const Instance: TObject; const IID: TGuid; out Intf): Boolean; overload; function Supports(const Instance: TObject; const IID: TGuidString; out Intf): Boolean; overload; function Supports(const Instance: IInterface; const AClass: TClass): Boolean; overload; function Supports(const Instance: IInterface; const IID: TGuid): Boolean; overload; function Supports(const Instance: TObject; const IID: TGuid): Boolean; overload; function Supports(const Instance: TObject; const IID: TGuidString): Boolean; overload; function Supports(const AClass: TClass; const IID: TGuid): Boolean; overload; function Supports(const AClass: TClass; const IID: TGuidString): Boolean; overload; function TryStringToGUID(const s: string; out Guid: TGuid): Boolean; function StringToGUID(const S: string): TGuid; function GUIDToString(const guid: TGuid): string; function IsEqualGUID(const guid1, guid2: TGuid): Boolean; function GuidCase(const guid: TGuid; const List: array of TGuid): Integer; Function CreateGUID(out GUID : TGUID) : Integer; Function EncodeHTMLEntities (S : String) : String; { --------------------------------------------------------------------- Type Helpers ---------------------------------------------------------------------} Type generic TArray = array of T; TCharArray = Array of char; TByteBitIndex = 0..7; TShortIntBitIndex = 0..7; TWordBitIndex = 0..15; TSmallIntBitIndex = 0..15; TCardinalBitIndex = 0..31; TIntegerBitIndex = 0..31; TLongIntBitIndex = TIntegerBitIndex; TQwordBitIndex = 0..52; TInt64BitIndex = 0..52; TNativeIntBitIndex = 0..52; TNativeUIntBitIndex = 0..52; Const CPUEndian = {$IFNDEF FPC_LITTLE_ENDIAN}TEndian.Big{$ELSE}TEndian.Little{$ENDIF}; Type { TGuidHelper } TGuidHelper = record helper for TGUID class function Create(Src : TGUID; BigEndian: Boolean): TGUID; overload; static; class function Create(const Buf : TJSArrayBuffer; AStartIndex: Cardinal; BigEndian: Boolean): TGUID; overload; static; class function Create(const Data: array of Byte; AStartIndex: Cardinal; BigEndian: Boolean): TGUID; overload; static; Class Function Create(const B: TBytes; DataEndian: TEndian = CPUEndian): TGUID; overload; static; inline; Class Function Create(const B: TBytes; AStartIndex: Cardinal; DataEndian: TEndian = CPUEndian): TGUID; overload; static; Class Function Create(const S: string): TGUID; overload; static; Class Function Create(A: Integer; B: SmallInt; C: SmallInt; const D: TBytes): TGUID; overload; static; // Class Function Create(A: Integer; B: SmallInt; C: SmallInt; D, E, F, G, H, I, J, K: Byte): TGUID; overload; static; Class Function Create(A: Cardinal; B: Word; C: Word; D, E, F, G, H, I, J, K: Byte): TGUID; overload; static; Class Function NewGuid: TGUID; static; Function ToByteArray(DataEndian: TEndian = CPUEndian): TBytes; Function ToString(SkipBrackets: Boolean = False): string; end; {$SCOPEDENUMS ON} TStringSplitOptions = (None, ExcludeEmpty); {$SCOPEDENUMS OFF} { TStringHelper } TStringHelper = Type Helper for String Private Function GetChar(AIndex : SizeInt) : Char; Function GetLength : SizeInt; public const Empty = ''; // Methods Class Function Compare(const A: string; const B: string): Integer; overload; static; //inline; Class Function Compare(const A: string; const B: string; IgnoreCase: Boolean): Integer; overload; static; //inline; //deprecated 'Use same with TCompareOptions'; Class Function Compare(const A: string; const B: string; Options: TCompareOptions): Integer; overload; static; // inline; Class Function Compare(const A: string; IndexA: SizeInt; const B: string; IndexB: SizeInt; ALen: SizeInt): Integer; overload; static; // inline; Class Function Compare(const A: string; IndexA: SizeInt; const B: string; IndexB: SizeInt; ALen: SizeInt; IgnoreCase: Boolean): Integer; overload; static; // inline; //deprecated 'Use same with TCompareOptions'; Class Function Compare(const A: string; IndexA: SizeInt; const B: string; IndexB: SizeInt; ALen: SizeInt; Options: TCompareOptions): Integer; overload; static;// inline; Class Function CompareOrdinal(const A: string; const B: string): Integer; overload; static; Class Function CompareOrdinal(const A: string; IndexA: SizeInt; const B: string; IndexB: SizeInt; ALen: SizeInt): Integer; overload; static; Class Function CompareText(const A: string; const B: string): Integer; static; inline; Class Function Copy(const Str: string): string; inline; static; Class Function Create(AChar: Char; ACount: SizeInt): string; overload; inline; static; Class Function Create(const AValue: array of Char): string; overload; static; Class Function Create(const AValue: array of Char; StartIndex: SizeInt; ALen: SizeInt): string; overload; static; Class Function EndsText(const ASubText, AText: string): Boolean; static; Class Function Equals(const a: string; const b: string): Boolean; overload; static; Class Function Format(const AFormat: string; const args: array of JSValue): string; overload; static; Class Function IsNullOrEmpty(const AValue: string): Boolean; static; Class Function IsNullOrWhiteSpace(const AValue: string): Boolean; static; Class Function Join(const Separator: string; const Values: array of JSValue): string; overload; static; Class Function Join(const Separator: string; const Values: array of string): string; overload; static; Class Function Join(const Separator: string; const Values: array of string; StartIndex: SizeInt; ACount: SizeInt): string; overload; static; Class Function LowerCase(const S: string): string; overload; static; inline; Class Function Parse(const AValue: Boolean): string; overload; static; inline; Class Function Parse(const AValue: Extended): string; overload; static;inline; Class Function Parse(const AValue: NativeInt): string; overload; static; inline; Class Function Parse(const AValue: Integer): string; overload; static; inline; Class Function ToBoolean(const S: string): Boolean; overload; static; inline; Class Function ToDouble(const S: string): Double; overload; static; inline; Class Function ToExtended(const S: string): Extended; overload; static; inline; Class Function ToNativeInt(const S: string): NativeInt; overload; static; inline; Class Function ToInteger(const S: string): Integer; overload; static; inline; Class Function UpperCase(const S: string): string; overload; static; inline; Class Function ToCharArray(const S : String) : TCharArray; static; Function CompareTo(const B: string): Integer; Function Contains(const AValue: string): Boolean; Function CountChar(const C: Char): SizeInt; Function DeQuotedString: string; overload; Function DeQuotedString(const AQuoteChar: Char): string; overload; Function EndsWith(const AValue: string): Boolean; overload; inline; Function EndsWith(const AValue: string; IgnoreCase: Boolean): Boolean; overload; Function Equals(const AValue: string): Boolean; overload; Function Format(const args: array of jsValue): string; overload; Function GetHashCode: Integer; Function IndexOf(AValue: Char): SizeInt; overload; inline; Function IndexOf(const AValue: string): SizeInt; overload; inline; Function IndexOf(AValue: Char; StartIndex: SizeInt): SizeInt; overload; Function IndexOf(const AValue: string; StartIndex: SizeInt): SizeInt; overload; Function IndexOf(AValue: Char; StartIndex: SizeInt; ACount: SizeInt): SizeInt; overload; Function IndexOf(const AValue: string; StartIndex: SizeInt; ACount: SizeInt): SizeInt; overload; Function IndexOfUnQuoted(const AValue: string; StartQuote, EndQuote: Char; StartIndex: SizeInt = 0): SizeInt; overload; Function IndexOfAny(const AnyOf: string): SizeInt; overload; Function IndexOfAny(const AnyOf: array of Char): SizeInt; overload; Function IndexOfAny(const AnyOf: String; StartIndex: SizeInt): SizeInt; overload; Function IndexOfAny(const AnyOf: array of Char; StartIndex: SizeInt): SizeInt; overload; Function IndexOfAny(const AnyOf: String; StartIndex: SizeInt; ACount: SizeInt): SizeInt; overload; Function IndexOfAny(const AnyOf: array of Char; StartIndex: SizeInt; ACount: SizeInt): SizeInt; overload; Function IndexOfAny(const AnyOf: array of String): SizeInt; overload; Function IndexOfAny(const AnyOf: array of String; StartIndex: SizeInt): SizeInt; overload; Function IndexOfAny(const AnyOf: array of String; StartIndex: SizeInt; ACount: SizeInt): SizeInt; overload; Function IndexOfAny(const AnyOf: array of String; StartIndex: SizeInt; ACount: SizeInt; Out AMatch : SizeInt): SizeInt; overload; Function IndexOfAnyUnquoted(const AnyOf: array of Char; StartQuote, EndQuote: Char): SizeInt; overload; Function IndexOfAnyUnquoted(const AnyOf: array of Char; StartQuote, EndQuote: Char; StartIndex: SizeInt): SizeInt; overload; Function IndexOfAnyUnquoted(const AnyOf: array of Char; StartQuote, EndQuote: Char; StartIndex: SizeInt; ACount: SizeInt): SizeInt; overload; function IndexOfAnyUnquoted(const AnyOf: array of string; StartQuote, EndQuote: Char; StartIndex: SizeInt; Out Matched: SizeInt): SizeInt; overload; Function Insert(StartIndex: SizeInt; const AValue: string): string; Function IsDelimiter(const Delimiters: string; Index: SizeInt): Boolean; Function IsEmpty: Boolean; Function LastDelimiter(const Delims: string): SizeInt; Function LastIndexOf(AValue: Char): SizeInt; overload; Function LastIndexOf(const AValue: string): SizeInt; overload; Function LastIndexOf(AValue: Char; AStartIndex: SizeInt): SizeInt; overload; Function LastIndexOf(const AValue: string; AStartIndex: SizeInt): SizeInt; overload; Function LastIndexOf(AValue: Char; AStartIndex: SizeInt; ACount: SizeInt): SizeInt; overload; Function LastIndexOf(const AValue: string; AStartIndex: SizeInt; ACount: SizeInt): SizeInt; overload; Function LastIndexOfAny(const AnyOf: array of Char): SizeInt; overload; Function LastIndexOfAny(const AnyOf: array of Char; AStartIndex: SizeInt): SizeInt; overload; Function LastIndexOfAny(const AnyOf: array of Char; AStartIndex: SizeInt; ACount: SizeInt): SizeInt; overload; Function PadLeft(ATotalWidth: SizeInt): string; overload; inline; Function PadLeft(ATotalWidth: SizeInt; PaddingChar: Char): string; overload; inline; Function PadRight(ATotalWidth: SizeInt): string; overload; inline; Function PadRight(ATotalWidth: SizeInt; PaddingChar: Char): string; overload; inline; Function QuotedString: string; overload; Function QuotedString(const AQuoteChar: Char): string; overload; Function Remove(StartIndex: SizeInt): string; overload; inline; Function Remove(StartIndex: SizeInt; ACount: SizeInt): string; overload; inline; Function Replace(OldChar: Char; NewChar: Char): string; overload; Function Replace(OldChar: Char; NewChar: Char; ReplaceFlags: TReplaceFlags): string; overload; Function Replace(const OldValue: string; const NewValue: string): string; overload; Function Replace(const OldValue: string; const NewValue: string; ReplaceFlags: TReplaceFlags): string; overload; Function Split(const Separators: String): TStringArray; overload; Function Split(const Separators: array of Char): TStringArray; overload; Function Split(const Separators: string; ACount: SizeInt): TStringArray; overload; Function Split(const Separators: array of Char; ACount: SizeInt): TStringArray; overload; Function Split(const Separators: string; Options: TStringSplitOptions): TStringArray; overload; Function Split(const Separators: array of Char; Options: TStringSplitOptions): TStringArray; overload; Function Split(const Separators: string; ACount: SizeInt; Options: TStringSplitOptions): TStringArray; overload; Function Split(const Separators: array of Char; ACount: SizeInt; Options: TStringSplitOptions): TStringArray; overload; Function Split(const Separators: array of string): TStringArray; overload; Function Split(const Separators: array of string; ACount: SizeInt): TStringArray; overload; Function Split(const Separators: array of string; Options: TStringSplitOptions): TStringArray; overload; Function Split(const Separators: array of string; ACount: SizeInt; Options: TStringSplitOptions): TStringArray; overload; Function Split(const Separators: String; AQuote: Char): TStringArray; overload; Function Split(const Separators: array of Char; AQuote: Char): TStringArray; overload; Function Split(const Separators: String; AQuoteStart, AQuoteEnd: Char): TStringArray; overload; Function Split(const Separators: array of Char; AQuoteStart, AQuoteEnd: Char): TStringArray; overload; Function Split(const Separators: string; AQuoteStart, AQuoteEnd: Char; Options: TStringSplitOptions): TStringArray; overload; Function Split(const Separators: array of Char; AQuoteStart, AQuoteEnd: Char; Options: TStringSplitOptions): TStringArray; overload; Function Split(const Separators: string; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt): TStringArray; overload; Function Split(const Separators: array of Char; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt): TStringArray; overload; Function Split(const Separators: string; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt; Options: TStringSplitOptions): TStringArray; overload; Function Split(const Separators: array of Char; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt; Options: TStringSplitOptions): TStringArray; overload; Function Split(const Separators: array of string; AQuote: Char): TStringArray; overload; Function Split(const Separators: array of string; AQuoteStart, AQuoteEnd: Char): TStringArray; overload; Function Split(const Separators: array of string; AQuoteStart, AQuoteEnd: Char; Options: TStringSplitOptions): TStringArray; overload; Function Split(const Separators: array of string; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt): TStringArray; overload; Function Split(const Separators: array of string; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt; Options: TStringSplitOptions): TStringArray; overload; Function StartsWith(const AValue: string): Boolean; overload; inline; Function StartsWith(const AValue: string; IgnoreCase: Boolean): Boolean; overload; Function Substring(AStartIndex: SizeInt): string; overload; Function Substring(AStartIndex: SizeInt; ALen: SizeInt): string; overload; Function ToBoolean: Boolean; overload; inline; Function ToInteger: Integer; overload; inline; Function ToNativeInt: NativeInt; overload; inline; Function ToDouble: Double; overload; inline; Function ToExtended: Extended; overload; inline; Function ToCharArray: TCharArray; overload; Function ToCharArray(AStartIndex: SizeInt; ALen: SizeInt): TCharArray; overload; Function ToLower: string; overload; inline; Function ToLowerInvariant: string; Function ToUpper: string; overload; inline; Function ToUpperInvariant: string; inline; Function Trim: string; overload; Function TrimLeft: string; overload; Function TrimRight: string; overload; Function Trim(const ATrimChars: array of Char): string; overload; Function TrimLeft(const ATrimChars: array of Char): string; overload; Function TrimRight(const ATrimChars: array of Char): string; overload; Function TrimEnd(const ATrimChars: array of Char): string; deprecated 'Use TrimRight'; Function TrimStart(const ATrimChars: array of Char): string; deprecated 'Use TrimLeft'; property Chars[AIndex: SizeInt]: Char read GetChar; property Length: SizeInt read GetLength; end; TDoubleHelper = Type Helper for Double private Function GetB(AIndex: Cardinal): Byte; Function GetW(AIndex: Cardinal): Word; Function GetE: NativeUInt; inline; Function GetF: NativeUInt; inline; Function GetS: Boolean; inline; Procedure SetS(aValue : Boolean); inline; procedure SetB(AIndex: Cardinal; const AValue: Byte); procedure SetW(AIndex: Cardinal; const AValue: Word); public const {$push} {$R-} {$Q-} Epsilon : Double = 4.9406564584124654418e-324; MaxValue : Double = 1.7976931348623157081e+308; MinValue : Double = -1.7976931348623157081e+308; // PositiveInfinity : Double = 1.0/0.0; // NegativeInfinity : Double = -1.0/0.0; // NaN : Double = 0.0/0.0; {$POP} Class Function IsInfinity(const AValue: Double): Boolean; overload; inline; static; Class Function IsNan(const AValue: Double): Boolean; overload; inline; static; Class Function IsNegativeInfinity(const AValue: Double): Boolean; overload; inline; static; Class Function IsPositiveInfinity(const AValue: Double): Boolean; overload; inline; static; Class Function Parse(const AString: string): Double; overload; inline; static; Class Function ToString(const AValue: Double): string; overload; inline; static; Class Function ToString(const AValue: Double; const AFormat: TFloatFormat; const APrecision, ADigits: Integer): string; overload; inline; static; Class Function TryParse(const AString: string; out AValue: Double): Boolean; overload; inline; static; Procedure BuildUp(const ASignFlag: Boolean; const AMantissa: NativeUInt; const AExponent: Integer); Function Exponent: Integer; Function Fraction: Extended; Function IsInfinity: Boolean; overload; inline; Function IsNan: Boolean; overload; inline; Function IsNegativeInfinity: Boolean; overload; inline; Function IsPositiveInfinity: Boolean; overload; inline; Function Mantissa: NativeUInt; Function ToString(const AFormat: TFloatFormat; const APrecision, ADigits: Integer): string; overload; inline; Function ToString: string; overload; inline; property Bytes[AIndex: Cardinal]: Byte read GetB write SetB; // 0..7 property Words[AIndex: Cardinal]: Word read GetW write SetW; // 0..3 property Sign: Boolean read GetS Write SetS; property Exp: NativeUInt read GetE; property Frac: NativeUInt read GetF; end; TByteHelper = Type Helper for Byte public const MaxValue = 255; MinValue = 0; public Class Function Parse(const AString: string): Byte; inline; static; Class Function Size: Integer; inline; static; Class Function ToString(const AValue: Byte): string; overload; inline; static; Class Function TryParse(const AString: string; out AValue: Byte): Boolean; inline; static; Public Function ToBoolean: Boolean; inline; Function ToDouble: Double; inline; Function ToExtended: Extended; inline; Function ToBinString:string; inline; Function ToHexString(const AMinDigits: Integer): string; overload; inline; Function ToHexString: string; overload; inline; Function ToString: string; overload; inline; Function SetBit(const Index: TByteBitIndex) : Byte; inline; Function ClearBit(const Index: TByteBitIndex) : Byte; inline; Function ToggleBit(const Index: TByteBitIndex) : Byte; inline; Function TestBit(const Index:TByteBitIndex):Boolean; inline; end; TShortIntHelper = Type Helper for ShortInt public const MaxValue = 127; MinValue = -128; public Class Function Parse(const AString: string): ShortInt; inline; static; Class Function Size: Integer; inline; static; Class Function ToString(const AValue: ShortInt): string; overload; inline; static; Class Function TryParse(const AString: string; out AValue: ShortInt): Boolean; inline; static; public Function ToBoolean: Boolean; inline; Function ToDouble: Double; inline; Function ToExtended: Extended; inline; Function ToBinString:string; inline; Function ToHexString(const AMinDigits: Integer): string; overload; inline; Function ToHexString: string; overload; inline; Function ToString: string; overload; inline; Function SetBit(const Index: TShortIntBitIndex): Shortint; inline; Function ClearBit(const Index: TShortIntBitIndex): Shortint; inline; Function ToggleBit(const Index: TShortIntBitIndex): Shortint; inline; Function TestBit(const Index:TShortIntBitIndex):Boolean; inline; end; TSmallIntHelper = Type Helper for SmallInt public const MaxValue = 32767; MinValue = -32768; public Class Function Parse(const AString: string): SmallInt; inline; static; Class Function Size: Integer; inline; static; Class Function ToString(const AValue: SmallInt): string; overload; inline; static; Class Function TryParse(const AString: string; out AValue: SmallInt): Boolean; inline; static; public Function ToString: string; overload; inline; Function ToBoolean: Boolean; inline; Function ToBinString:string; inline; Function ToHexString: string; overload; inline; Function ToHexString(const AMinDigits: Integer): string; overload; inline; Function ToDouble: Double; inline; Function ToExtended: Extended; inline; Function SetBit(const Index: TSmallIntBitIndex) : Smallint; inline; Function ClearBit(const Index: TSmallIntBitIndex) : Smallint; inline; Function ToggleBit(const Index: TSmallIntBitIndex) : Smallint; inline; Function TestBit(const Index:TSmallIntBitIndex):Boolean; inline; end; TWordHelper = Type Helper for Word public const MaxValue = 65535; MinValue = 0; Public Class Function Parse(const AString: string): Word; inline; static; Class Function Size: Integer; inline; static; Class Function ToString(const AValue: Word): string; overload; inline; static; Class Function TryParse(const AString: string; out AValue: Word): Boolean; inline; static; Public Function ToBoolean: Boolean; inline; Function ToDouble: Double; inline; Function ToExtended: Extended; inline; Function ToBinString:string; inline; Function ToHexString(const AMinDigits: Integer): string; overload; inline; Function ToHexString: string; overload; inline; Function ToString: string; overload; inline; Function SetBit(const Index: TWordBitIndex) : Word; inline; Function ClearBit(const Index: TWordBitIndex) : Word; inline; Function ToggleBit(const Index: TWordBitIndex) : Word; inline; Function TestBit(const Index:TWordBitIndex):Boolean; inline; end; TCardinalHelper = Type Helper for Cardinal { for LongWord Type too } public const MaxValue = 4294967295; MinValue = 0; Public Class Function Parse(const AString: string): Cardinal; inline; static; Class Function Size: Integer; inline; static; Class Function ToString(const AValue: Cardinal): string; overload; inline; static; Class Function TryParse(const AString: string; out AValue: Cardinal): Boolean; inline; static; Public Function ToBoolean: Boolean; inline; Function ToDouble: Double; inline; Function ToExtended: Extended; inline; Function ToBinString:string; inline; Function ToHexString(const AMinDigits: Integer): string; overload; inline; Function ToHexString: string; overload; inline; Function ToString: string; overload; inline; Function SetBit(const Index: TCardinalBitIndex) : Cardinal; inline; Function ClearBit(const Index: TCardinalBitIndex) : Cardinal; inline; Function ToggleBit(const Index: TCardinalBitIndex) : Cardinal; inline; Function TestBit(const Index:TCardinalBitIndex):Boolean; inline; end; TIntegerHelper = Type Helper for Integer { for LongInt Type too } public const MaxValue = 2147483647; MinValue = -2147483648; Public Class Function Size: Integer; inline; static; Class Function ToString(const AValue: Integer): string; overload; inline; static; Class Function Parse(const AString: string): Integer; inline; static; Class Function TryParse(const AString: string; out AValue: Integer): Boolean; inline; static; Public Function ToBoolean: Boolean; inline; Function ToDouble: Double; inline; Function ToExtended: Extended; inline; Function ToBinString:string; inline; Function ToHexString(const AMinDigits: Integer): string; overload; inline; Function ToHexString: string; overload; inline; Function ToString: string; overload; inline; Function SetBit(const Index: TIntegerBitIndex) : Integer; inline; Function ClearBit(const Index: TIntegerBitIndex) : Integer; inline; Function ToggleBit(const Index: TIntegerBitIndex) : Integer; inline; Function TestBit(const Index:TIntegerBitIndex):Boolean; inline; end; TNativeIntHelper = Type Helper for NativeInt public const MaxValue = High(NativeInt); MinValue = Low(NativeInt); Public Class Function Parse(const AString: string): NativeInt; inline; static; Class Function Size: Integer; inline; static; Class Function ToString(const AValue: NativeInt): string; overload; inline; static; Class Function TryParse(const AString: string; out AValue: NativeInt): Boolean; inline; static; Public Function ToBoolean: Boolean; inline; Function ToDouble: Double; inline; Function ToExtended: Extended; inline; Function ToBinString:string; inline; Function ToHexString(const AMinDigits: Integer): string; overload; inline; Function ToHexString: string; overload; inline; Function ToString: string; overload; inline; Function SetBit(const Index: TNativeIntBitIndex) : NativeInt; inline; Function ClearBit(const Index: TNativeIntBitIndex) : NativeInt; inline; Function ToggleBit(const Index: TNativeIntBitIndex) : NativeInt; inline; Function TestBit(const Index:TNativeIntBitIndex):Boolean; inline; end; TNativeUIntHelper = Type Helper for NativeUInt public const MaxValue = High(NativeUInt); MinValue = 0; Public Class Function Parse(const AString: string): NativeUInt; inline; static; Class Function Size: Integer; inline; static; Class Function ToString(const AValue: NativeUInt): string; overload; inline; static; Class Function TryParse(const AString: string; out AValue: NativeUInt): Boolean; inline; static; Public Function ToBoolean: Boolean; inline; Function ToDouble: Double; inline; Function ToExtended: Extended; inline; Function ToBinString:string; inline; Function ToHexString(const AMinDigits: Integer): string; overload; inline; Function ToHexString: string; overload; inline; Function ToSingle: Single; inline; Function ToString: string; overload; inline; Function SetBit(const Index: TNativeUIntBitIndex) : NativeUint; inline; Function ClearBit(const Index: TNativeUIntBitIndex): NativeUint; inline; Function ToggleBit(const Index: TNativeUIntBitIndex) : NativeUint; inline; Function TestBit(const Index:TNativeUIntBitIndex) :Boolean; inline; end; TBooleanHelper = Type Helper for Boolean public Class Function Parse(const S: string): Boolean; inline; static; Class Function Size: Integer; inline; static; Class Function ToString(const AValue: Boolean; UseBoolStrs: Boolean = false): string; overload; inline; static; Class Function TryToParse(const S: string; out AValue: Boolean): Boolean; inline; static; Public Function ToInteger: Integer; inline; Function ToString(UseBoolStrs: Boolean = False): string; overload; inline; end; TByteBoolHelper = Type Helper for ByteBool public Class Function Parse(const S: string): Boolean; inline; static; Class Function Size: Integer; inline; static; Class Function ToString(const AValue: Boolean; UseBoolStrs : Boolean = False): string; overload; inline; static; Class Function TryToParse(const S: string; out AValue: Boolean): Boolean; inline; static; Public Function ToInteger: Integer; inline; Function ToString(UseBoolStrs: Boolean = False): string; overload; inline; end; TWordBoolHelper = Type Helper for WordBool public Class Function Parse(const S: string): Boolean; inline; static; Class Function Size: Integer; inline; static; Class Function ToString(const AValue: Boolean; UseBoolStrs: Boolean = False): string; overload; inline; static; Class Function TryToParse(const S: string; out AValue: Boolean): Boolean; inline; static; Public Function ToInteger: Integer; inline; Function ToString(UseBoolStrs: boolean = False): string; overload; inline; end; TLongBoolHelper = Type Helper for LongBool public Class Function Parse(const S: string): Boolean; inline; static; Class Function Size: Integer; inline; static; Class Function ToString(const AValue: Boolean; UseBoolStrs: Boolean= False): string; overload; inline; static; Class Function TryToParse(const S: string; out AValue: Boolean): Boolean; inline; static; public Function ToInteger: Integer; inline; Function ToString(UseBoolStrs: Boolean = False): string; overload; inline; end; implementation { --------------------------------------------------------------------- Exception handling ---------------------------------------------------------------------} Resourcestring SAbortError = 'Operation aborted'; SApplicationException = 'Application raised an exception: '; SErrUnknownExceptionType = 'Caught unknown exception type : '; procedure DoShowException(S : String); begin if Assigned(OnShowException) then OnShowException(S) else begin {$IFDEF BROWSER} asm window.alert(S); end; {$ENDIF} {$IFDEF NODEJS} Writeln(S); {$ENDIF} end; end; procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer = Nil); Var S : String; begin S:=SApplicationException+ExceptObject.ClassName; if ExceptObject is Exception then S:=S+' : '+Exception(ExceptObject).Message; DoShowException(S); if ExceptAddr=nil then; end; Type TRTLExceptionHandler = procedure (aError : JSValue); Var rtlExceptionHandler : TRTLExceptionHandler; External name 'rtl.onUncaughtException'; rtlShowUncaughtExceptions : Boolean; External name 'rtl.showUncaughtExceptions'; OnPascalException : TUncaughtPascalExceptionHandler; OnJSException : TUncaughtJSExceptionHandler; Procedure RTLExceptionHook(aError : JSValue); Var S : String; begin if isClassInstance(aError) then begin if Assigned(OnPascalException) then OnPascalException(TObject(aError)) else ShowException(TObject(aError),Nil); end else if isObject(aError) then begin if Assigned(OnJSException) then OnJSException(TJSObject(aError)) else begin if TJSObject(aError).hasOwnProperty('message') then S:=SErrUnknownExceptionType+String(TJSObject(aError).Properties['message']) else S:=SErrUnknownExceptionType+TJSObject(aError).toString; DoShowException(S); end end else begin S:=SErrUnknownExceptionType+String(aError); DoShowException(S); end; end; Function SetOnUnCaughtExceptionHandler(aValue : TUncaughtPascalExceptionHandler) : TUncaughtPascalExceptionHandler; begin Result:=OnPascalException; OnPascalException:=aValue; HookUncaughtExceptions; end; Function SetOnUnCaughtExceptionHandler(aValue : TUncaughtJSExceptionHandler) : TUncaughtJSExceptionHandler; begin Result:=OnJSException; OnJSException:=aValue; HookUncaughtExceptions; end; Procedure HookUncaughtExceptions; begin rtlExceptionHandler:=@RTLExceptionHook; rtlShowUncaughtExceptions:=True; end; procedure Abort; begin Raise EAbort.Create(SAbortError); end; Type TCharSet = Set of Char; Function CharInSet(Ch: Char;Const CSet : TCharSet) : Boolean; overload; begin Result:=Ch in CSet; end; function CharInSet(Ch: Char; const CSet: array of char): Boolean; overload; Var I : integer; begin Result:=False; I:=Length(CSet)-1; While (Not Result) and (I>=0) do begin Result:=(Ch=CSet[i]); Dec(I); end; end; function LeftStr(const S: string; Count: Integer): String; assembler; asm return (Count>0) ? S.substr(0,Count) : ""; end; function RightStr(const S: string; Count: Integer): String; assembler; asm var l = S.length; return (Count<1) ? "" : ( Count>=l ? S : S.substr(l-Count)); end; function Trim(const S: String): String; assembler; asm return S.replace(/^[\s\uFEFF\xA0\x00-\x1f]+/,'').replace(/[\s\uFEFF\xA0\x00-\x1f]+$/,''); end; function TrimLeft(const S: String): String; assembler; asm return S.replace(/^[\s\uFEFF\xA0\x00-\x1f]+/,''); end; function TrimRight(const S: String): String; assembler; asm return S.replace(/[\s\uFEFF\xA0\x00-\x1f]+$/,''); end; function IntToStr(const Value: Integer): string; begin Result:=str(Value); end; function FloatToDecimal(Value: double; Precision, Decimals: integer): TFloatRec; Const Rounds = '123456789:'; var Buffer: String; //Though str func returns only 25 chars, this might change in the future InfNan: string; OutPos,Error, N, L, C: Integer; GotNonZeroBeforeDot, BeforeDot : boolean; begin Result.Negative:=False; Result.Exponent:=0; For C:=0 to FloatRecDigits do Result.Digits[C]:='0'; if Value=0 then exit; asm Buffer=Value.toPrecision(21); // Double precision end; // Writeln('Buffer :',Buffer); N := 1; L := Length(Buffer); while Buffer[N]=' ' do Inc(N); Result.Negative := (Buffer[N] = '-'); if Result.Negative then Inc(N) else if (Buffer[N] = '+') then inc(N); { special cases for Inf and Nan } if (L>=N+2) then begin InfNan:=copy(Buffer,N,3); if (InfNan='Inf') then begin Result.Digits[0]:=#0; Result.Exponent:=32767; exit end; if (InfNan='Nan') then begin Result.Digits[0]:=#0; Result.Exponent:=-32768; exit end; end; //Start := N; //Start of digits Outpos:=0; Result.Exponent := 0; BeforeDot := true; GotNonZeroBeforeDot := false; while (L>=N) and (Buffer[N]<>'E') do begin // Writeln('Examining : ',Buffer[N],'( output pos: ',outPos,')'); if Buffer[N]='.' then BeforeDot := false else begin if BeforeDot then begin // Currently this is always 1 char Inc(Result.Exponent); Result.Digits[Outpos] := Buffer[N]; if Buffer[N] <> '0' then GotNonZeroBeforeDot := true; end else Result.Digits[Outpos] := Buffer[N]; Inc(outpos); end; Inc(N); end; Inc(N); // Pass through 'E' if N<=L then begin Val(Copy(Buffer, N, L-N+1), C, Error); // Get exponent after 'E' Inc(Result.Exponent, C); end; // Calculate number of digits we have from str N:=OutPos; // Writeln('Number of digits: ',N,' requested precision : ',Precision); L:=Length(Result.Digits); While N= L Then N := L-1; // Writeln('Rounding on digit : ',N); if N = 0 Then begin if Result.Digits[0] >= '5' Then begin Result.Digits[0] := '1'; Result.Digits[1] := #0; Inc(Result.Exponent); end Else Result.Digits[0] := #0; end //N=0 Else if N > 0 Then begin if Result.Digits[N] >= '5' Then begin Repeat Result.Digits[N] := #0; Dec(N); // Writeln(N,': ',Result.Digits[N],', Rounding to : ',Rounds[StrToInt(Result.Digits[N])]); Result.Digits[N]:=Rounds[StrToInt(Result.Digits[N])+1]; Until (N = 0) Or (Result.Digits[N] < ':'); If Result.Digits[0] = ':' Then begin Result.Digits[0] := '1'; Inc(Result.Exponent); end; end Else begin Result.Digits[N] := '0'; While (N > -1) And (Result.Digits[N] = '0') Do begin Result.Digits[N] := #0; Dec(N); end; end; end //N>0 Else Result.Digits[0] := #0; if (Result.Digits[0] = #0) and not GotNonZeroBeforeDot then begin Result.Exponent := 0; Result.Negative := False; end; end; function FloatToStr(Value: Double): String; begin Result:=FloatToStrF(Value,ffGeneral,15,0); end; function TryStrToFloat(const S: String; out res: Extended): Boolean; begin Result:=TryStrToFloat(S,double(res)); end; function TryStrToFloat(const S: String; out res: Double): Boolean; Var J : JSValue; N : String; begin N:=S; // Delocalize if (ThousandSeparator <>'') then N:=StringReplace(N,ThousandSeparator,'',[rfReplaceAll]); if (DecimalSeparator<>'.') then N:=StringReplace(N,DecimalSeparator,'.',[]); J:=parseFloat(N); Result:=Not jsIsNaN(J); if Result then Res:=Double(J); end; function StrToFloatDef(const S: String; const aDef: Double): Double; begin if not TryStrToFloat(S,Result) then Result:=aDef; end; function StrToFloat(const S: String): Double; begin if not TryStrToFloat(S,Result) then Raise EConvertError.CreateFmt(SErrInvalidFloat,[S]); end; function FormatFloat(Fmt: String; aValue: Double): String; Type TPosArray = Array of Integer; const MaxPrecision = 18; // Extended precision var // Input in usable format E : Extended; // Value as extended. FV: TFloatRec; // Value as floatrec. Section : String; // Format can contain 3 sections, semicolon separated: Pos;Neg;Zero. This is the one to use. SectionLength : Integer; // Length of section. // Calculated based on section. Static during output ThousandSep: Boolean; // Thousands separator detected in format ? IsScientific: Boolean; // Use Scientific notation ? (E detected in format) DecimalPos: Integer; // Position of decimal point in pattern. FirstDigit: Integer; // First actual digit in input (# or 0), relative to decimal point LastDigit: Integer; // Last required (0) digit, relative to decimal point RequestedDigits: Integer; // Number of requested digits, # and 0 alike ExpSize : Integer; // Number of digits in exponent Available: Integer; // Available digits in FV. // These change during output loop Current: Integer; // Current digit in available digits PadZeroes: Integer; // Difference in requested digits before comma and exponent, needs to be padded with zeroes. DistToDecimal: Integer; // Place of current digit, relative to decimal point taking in account PadZeroes! Procedure InitVars; begin E:=aValue; Section:=''; SectionLength:=0; ThousandSep:=false; IsScientific:=false; DecimalPos:=0; FirstDigit:=MaxInt; LastDigit:=0; RequestedDigits:=0; ExpSize:=0; Available:=-1; end; procedure ToResult(const AChar: Char); begin Result:=Result+AChar; end; procedure AddToResult(const AStr: String); begin Result:=Result+AStr; end; procedure WriteDigit(ADigit: Char); // Write a digit to result, prepend with decimalseparator or append with 1000 separator begin if ADigit=#0 then exit; // Writeln('WriteDigit: ',ADigit,', DistToDecimal: ',DistToDecimal); Dec(DistToDecimal); // -1 -> we've arrived behind the decimal if (DistToDecimal=-1) then begin AddToResult(DecimalSeparator); ToResult(ADigit); end else begin // We're still before the decimal. ToResult(ADigit); if ThousandSep and ((DistToDecimal mod 3)=0) and (DistToDecimal>1) then AddToResult(ThousandSeparator); end; end; Function GetDigit : Char; // Return next digit from available digits. // May return #0 if none available. // Will return '0' if applicable. begin // Writeln(' DistToDecimal <= LastDigit : ',DistToDecimal,' <= ',LastDigit,' have digit: ',Current<=Available, ' (',Current,')'); Result:=#0; if (Current<=Available) then begin Result:=FV.Digits[Current]; Inc(Current); end else if (DistToDecimal <= LastDigit) then Dec(DistToDecimal) else Result:='0'; // Writeln('GetDigit ->: ',Result); end; procedure CopyDigit; // Copy a digit (#, 0) to the output with the correct value begin // Writeln('CopyDigit: Padzeroes: ',PadZeroes,', DistToDecimal: ',DistToDecimal); if (PadZeroes=0) then WriteDigit(GetDigit) // No shift needed, just copy what is available. else if (PadZeroes<0) then begin // We must prepend zeroes Inc(PadZeroes); if (DistToDecimal<=FirstDigit) then WriteDigit('0') else Dec(DistToDecimal); end else begin // We must append zeroes while PadZeroes > 0 do begin WriteDigit(GetDigit); Dec(PadZeroes); end; WriteDigit(GetDigit); end; end; Function GetSections(Var SP : TPosArray) : Integer; var FL : Integer; i : Integer; C,Q : Char; inQuote : Boolean; begin Result:=1; SP[1]:=-1; SP[2]:=-1; SP[3]:=-1; inQuote:=False; Q:=#0; I:=1; FL:=Length(Fmt); while (I<=FL) do begin C:=Fmt[I]; case C of ';': begin if not InQuote then begin if Result>3 then Raise Exception.Create('Invalid float format'); SP[Result]:=I+1; Inc(Result); end; end; '"','''': begin if InQuote then InQuote:=C<>Q else begin InQuote:=True; Q:=C; end; end; end; Inc(I); end; if SP[Result]=-1 then SP[Result]:=FL+1; end; Procedure AnalyzeFormat; var I,Len: Integer; Q,C: Char; InQuote : Boolean; begin Len:=Length(Section); I:=1; InQuote:=False; Q:=#0; while (I<=Len) do begin C:=Section[i]; if C in ['"',''''] then begin if InQuote then InQuote:=C<>Q else begin InQuote:=True; Q:=C; end; end else if not InQuote then case C of '.': if (DecimalPos=0) then DecimalPos:=RequestedDigits+1; ',': ThousandSep:=ThousandSeparator<>#0; 'e', 'E': begin Inc(I); if (I4 then ExpSize:=4; end; end; '#': Inc(RequestedDigits); '0': begin if RequestedDigits0 then LastDigit:=0; // Writeln('FirstDigit: ',DecimalPos,'-',FirstDigit); FirstDigit:=DecimalPos-FirstDigit; if FirstDigit<0 then FirstDigit:=0; end; Function ValueOutSideScope : Boolean; begin With FV do Result:=((Exponent >= 18) and (not IsScientific)) or (Exponent = $7FF) or (Exponent = $800) end; Procedure CalcRunVars; Var D,P: Integer; begin if IsScientific then begin P:=RequestedDigits; D:=9999; end else begin P:=MaxPrecision; D:=RequestedDigits-DecimalPos+1; end; FV:=FloatToDecimal(aValue,P,D); // Writeln('Number of digits available : ',Length(FV.Digits)); // For p:=0 to Length(FV.Digits)-1 do // Writeln(P,': ',FV.Digits[p]); DistToDecimal:=DecimalPos-1; // Writeln('DistToDecimal : ',DistToDecimal); if IsScientific then PadZeroes:=0 // No padding. else begin PadZeroes:=FV.Exponent-(DecimalPos-1); if (PadZeroes>=0) then DistToDecimal:=FV.Exponent end; // Writeln('PadZeroes : ',PadZeroes, ', DistToDecimal : ',DistToDecimal); Available:=-1; while (Available#0) do Inc(Available); // Writeln('Available: ',Available); end; Function FormatExponent(ASign: Char; aExponent: Integer) : String; begin Result:=IntToStr(aExponent); Result:=StringOfChar('0',ExpSize-Length(Result))+Result; if (aExponent<0) then Result:='-'+Result else if (aExponent>0) and (aSign='+') then Result:=aSign+Result; end; var I,S : Integer; C,Q : Char; PA : TPosArray; InLiteral : Boolean; begin SetLength(PA,4); Result:=''; Initvars; // What section to use ? if (E>0) then S:=1 else if (E<0) then S:=2 else S:=3; PA[0]:=0; I:=GetSections(PA); if (IQ else begin inLiteral:=True; Q:=C; end; end else if InLiteral then ToResult(C) else case C of '0', '#': CopyDigit; '.', ',': ; // Do nothing, handled by CopyDigit 'e', 'E': begin ToResult(C); // Always needed Inc(I); if I<=Length(Section) then begin C:=Section[I]; if (C in ['+','-']) then begin AddToResult(FormatExponent(C,FV.Exponent-DecimalPos+1)); // Skip rest while (I0.0) else begin CheckBoolStrs; for I:=low(TrueBoolStrs) to High(TrueBoolStrs) do if Temp=uppercase(TrueBoolStrs[I]) then begin Value:=true; exit; end; for I:=low(FalseBoolStrs) to High(FalseBoolStrs) do if Temp=uppercase(FalseBoolStrs[I]) then begin Value:=false; exit; end; Result:=false; end; end; function UpperCase(const s: String): String; assembler; asm return s.toUpperCase(); end; function LowerCase(const s: String): String; assembler; asm return s.toLowerCase(); end; function CompareStr(const s1, s2: String): Integer; assembler; asm var l1 = s1.length; var l2 = s2.length; if (l1<=l2){ var s = s2.substr(0,l1); if (s1s){ return 1; } else { return l1l2){ return 1; } else if (l10 then Result:=Copy(S,1,P-1)+DS+Copy(S,P+1,Length(S)-P) else Result:=S; end; function FormatGeneralFloat(Value : double; Precision : Integer; DS : String) : string; Var P, PE, Q, Exponent: Integer; Begin If (Precision = -1) Or (Precision > maxdigits) Then Precision := maxdigits; { First convert to scientific format, with correct precision } Str(Value:precision+7, Result); { Delete leading spaces } Result:=TrimLeft(Result); P:=Pos('.',Result); if P=0 then exit; { Consider removing exponent } PE:=Pos('E',Result); if PE=0 then begin Result:=ReplaceDecimalSep(Result,DS); exit; end; { Read exponent } Q:=PE+2; Exponent := 0; while (Q <= Length(Result)) do begin Exponent := Exponent*10 + Ord(Result[Q])-Ord('0'); Inc(Q); end; if Result[PE+1] = '-' then Exponent := -Exponent; if (P+Exponent < PE) and (Exponent > -6) then begin { OK to remove exponent } SetLength(Result,PE-1); { Trim exponent } if Exponent >= 0 then begin { Shift point to right } for Q := 0 to Exponent-1 do begin Result[P] := Result[P+1]; Inc(P); end; Result[P] := '.'; P := 1; if Result[P] = '-' then Inc(P); while (Result[P] = '0') and (P < Length(Result)) and (Copy(Result,P+1,Length(DS))<>DS) do { Trim leading zeros; conversion above should not give any, but occasionally does because of rounding } System.Delete(Result,P,1); end else begin { Add zeros at start } Insert(Copy('00000',1,-Exponent),Result,P-1); Result[P-Exponent] := Result[P-Exponent-1]; { Copy leading digit } Result[P] := '.'; if Exponent <> -1 then Result[P-Exponent-1] := '0'; end; { Remove trailing zeros } Q := Length(Result); while (Q > 0) and (Result[Q] = '0') do Dec(Q); if Result[Q] = '.' then Dec(Q); { Remove trailing decimal point } if (Q = 0) or ((Q=1) and (Result[1] = '-')) then Result := '0' else SetLength(Result,Q); end else begin { Need exponent, but remove superfluous characters } { Delete trailing zeros } while Result[PE-1] = '0' do begin System.Delete(Result,PE-1,1); Dec(PE); end; { If number ends in decimal point, remove it } if Result[PE-1] = DS then begin System.Delete(Result,PE-1,1); Dec(PE); end; { delete superfluous + in exponent } if Result[PE+1]='+' then System.Delete(Result,PE+1,1) else Inc(PE); while Result[PE+1] = '0' do { Delete leading zeros in exponent } System.Delete(Result,PE+1,1) end; Result:=ReplaceDecimalSep(Result,DS) end; function FormatExponentFloat(Value : double; Precision,Digits : Integer;DS : String) : string; Var P: Integer; Begin DS:=DecimalSeparator; If (Precision = -1) Or (Precision > maxdigits) Then Precision := maxdigits; Str(Value:Precision+7, Result); { Delete leading spaces } while Result[1] = ' ' do System.Delete(Result, 1, 1); P:=Pos('E',Result); if P=0 then begin Result:=ReplaceDecimalSep(Result,DS); exit; end; Inc(P, 2); if Digits > 4 then Digits:=4; Digits:=Length(Result) - P - Digits + 1; if Digits < 0 then insert(copy('0000',1,-Digits),Result,P) else while (Digits > 0) and (Result[P] = '0') do begin System.Delete(Result, P, 1); if P > Length(Result) then begin System.Delete(Result, P - 2, 2); break; end; Dec(Digits); end; Result:=ReplaceDecimalSep(Result,DS); End; function FormatFixedFloat(Value : double; Digits : Integer; DS : String) : string; Begin If Digits = -1 Then Digits := 2 Else If Digits > 18 Then Digits := 18; Str(Value:0:Digits, Result); if (Result<>'') and (Result[1]=' ') then Delete(Result,1,1); Result:=ReplaceDecimalSep(Result,DS); end; function FormatNumberFloat(Value : double; Digits : Integer; DS,TS : String) : string; Var P : integer; Begin If Digits = -1 Then Digits := 2 else If Digits > maxdigits Then Digits := maxdigits; Str(Value:0:Digits, Result); if (Result<>'') and (Result[1]=' ') then Delete(Result,1,1); P:=Pos('.',Result); if (P<=0) then P:=Length(Result)+1; Result:=ReplaceDecimalSep(Result,DS); Dec(P,3); if (TS<>'') and (TS<>#0) then While (P>1) Do Begin If (Result[P-1] <> '-') Then Insert(TS, Result, P); Dec(P, 3); End; End; function RemoveLeadingNegativeSign(var AValue: String; DS : String): Boolean; // removes negative sign in case when result is zero eg. -0.00 var i: PtrInt; TS: String; StartPos: PtrInt; begin Result:=False; StartPos := 2; TS := ThousandSeparator; for i :=StartPos to length(AValue) do begin Result := (AValue[i] in ['0', DS, 'E', '+']) or (aValue[i]=TS); if not Result then break; end; if (Result) and (AValue[1]='-') then Delete(AValue, 1, 1); end; Function FormatNumberCurrency(const Value : Currency; Digits : Integer; DS,TS : String) : string; Var Negative: Boolean; P : Integer; Begin // Writeln('Value ',D); If Digits = -1 Then Digits := CurrencyDecimals Else If Digits > 18 Then Digits := 18; Str(Value:0:Digits, Result); // Writeln('1. Result ',Result,' currencystring : ',CurrencyString); Negative:=Result[1] = '-'; if Negative then System.Delete(Result, 1, 1); P := Pos('.', Result); // Writeln('2. Result ',Result,' currencystring : ',CurrencyString); If TS<>'' Then begin If P <> 0 Then Result:=ReplaceDecimalSep(Result,DS) else P := Length(Result)+1; Dec(P, 3); While (P > 1) Do Begin Insert(TS, Result, P); Dec(P, 3); End; end; // Writeln('3. Result ',Result,' currencystring : ',CurrencyString); if Negative then RemoveLeadingNegativeSign(Result,DS); // Writeln('4. Result ',Result,' currencystring : ',CurrencyString); // Writeln('CurrencyFormat: ',CurrencyFormat,'NegcurrencyFormat: ',NegCurrFormat); If Not Negative Then Case CurrencyFormat Of 0: Result := CurrencyString + Result; 1: Result := Result + CurrencyString; 2: Result := CurrencyString + ' ' + Result; 3: Result := Result + ' ' + CurrencyString; end else Case NegCurrFormat Of 0: Result := '(' + CurrencyString + Result + ')'; 1: Result := '-' + CurrencyString + Result; 2: Result := CurrencyString + '-' + Result; 3: Result := CurrencyString + Result + '-'; 4: Result := '(' + Result + CurrencyString + ')'; 5: Result := '-' + Result + CurrencyString; 6: Result := Result + '-' + CurrencyString; 7: Result := Result + CurrencyString + '-'; 8: Result := '-' + Result + ' ' + CurrencyString; 9: Result := '-' + CurrencyString + ' ' + Result; 10: Result := Result + ' ' + CurrencyString + '-'; 11: Result := CurrencyString + ' ' + Result + '-'; 12: Result := CurrencyString + ' ' + '-' + Result; 13: Result := Result + '-' + ' ' + CurrencyString; 14: Result := '(' + CurrencyString + ' ' + Result + ')'; 15: Result := '(' + Result + ' ' + CurrencyString + ')'; end; end; function FloatToStrF(const Value: double; format: TFloatFormat; Precision, Digits: Integer): String; Var DS: string; Begin DS:=DecimalSeparator; Case format Of ffGeneral: Result:=FormatGeneralFloat(Value,Precision,DS); ffExponent: Result:=FormatExponentFloat(Value,Precision,Digits,DS); ffFixed: Result:=FormatFixedFloat(Value,Digits,DS); ffNumber: Result:=FormatNumberFloat(Value,Digits,DS,ThousandSeparator); ffCurrency: Result:=FormatNumberCurrency(Value,Digits,DS,ThousandSeparator); end; if (Format<>ffCurrency) and (length(Result)>1) and (Result[1]='-') then RemoveLeadingNegativeSign(Result,DS); end; function Format(const Fmt: String; const Args: array of JSValue): String; Var ChPos,OldPos,ArgPos,DoArg,Len : SizeInt; Hs,ToAdd : String; Index : Byte; Width,Prec : Longint; Left : Boolean; Fchar : char; vq : nativeint; { ReadFormat reads the format string. It returns the type character in uppercase, and sets index, Width, Prec to their correct values, or -1 if not set. It sets Left to true if left alignment was requested. In case of an error, DoFormatError is called. } Function ReadFormat : Char; Var Value : NativeInt; Procedure ReadInteger; var Code: integer; ArgN: SizeInt; begin If Value<>-1 then exit; // Was already read. OldPos:=ChPos; While (ChPos<=Len) and (Fmt[ChPos]<='9') and (Fmt[ChPos]>='0') do inc(ChPos); If ChPos>len then DoFormatError(feInvalidFormat,Fmt); If Fmt[ChPos]='*' then begin if Index=High(byte) then ArgN:=Argpos else begin ArgN:=Index; Inc(Index); end; If (ChPos>OldPos) or (ArgN>High(Args)) then DoFormatError(feInvalidFormat,Fmt); ArgPos:=ArgN+1; if IsNumber(Args[ArgN]) and IsInteger(Args[ArgN]) then Value:=Integer(Args[ArgN]) else DoFormatError(feInvalidFormat,Fmt); Inc(ChPos); end else begin If (OldPos0 then DoFormatError (feInvalidFormat,Fmt); end else Value:=-1; end; end; Procedure ReadIndex; begin If Fmt[ChPos]<>':' then ReadInteger else value:=0; // Delphi undocumented behaviour, assume 0, #11099 If Fmt[ChPos]=':' then begin If Value=-1 then DoFormatError(feMissingArgument,Fmt); Index:=Value; Value:=-1; Inc(ChPos); end; end; Procedure ReadLeft; begin If Fmt[ChPos]='-' then begin left:=True; Inc(ChPos); end else Left:=False; end; Procedure ReadWidth; begin ReadInteger; If Value<>-1 then begin Width:=Value; Value:=-1; end; end; Procedure ReadPrec; begin If Fmt[ChPos]='.' then begin inc(ChPos); ReadInteger; If Value=-1 then Value:=0; prec:=Value; end; end; begin Index:=High(byte); Width:=-1; Prec:=-1; Value:=-1; inc(ChPos); If Fmt[ChPos]='%' then begin Result:='%'; exit; // VP fix end; ReadIndex; ReadLeft; ReadWidth; ReadPrec; Result:=Upcase(Fmt[ChPos]); end; function Checkarg (AT : TJSValueType; err:boolean):boolean; { Check if argument INDEX is of correct type (AT) If Index=-1, ArgPos is used, and argpos is augmented with 1 DoArg is set to the argument that must be used. } begin result:=false; if Index=High(Byte) then DoArg:=Argpos else DoArg:=Index; ArgPos:=DoArg+1; If (Doarg>High(Args)) or (GetValueTYpe(Args[Doarg])<>AT) then begin if err then DoFormatError(feInvalidArgindex,Fmt); dec(ArgPos); exit; end; result:=true; end; begin Result:=''; Len:=Length(Fmt); ChPos:=1; OldPos:=1; ArgPos:=0; While ChPos<=len do begin While (ChPos<=Len) and (Fmt[ChPos]<>'%') do inc(ChPos); If ChPos>OldPos Then Result:=Result+Copy(Fmt,OldPos,ChPos-Oldpos); If ChPos'-' then ToAdd:=StringOfChar('0',Index)+ToAdd else // + 1 to accomodate for - sign in length !! Insert(StringOfChar('0',Index+1),toadd,2); end; 'U' : begin Checkarg(jvtinteger,True); if NativeInt(Args[Doarg])<0 then DoFormatError(feInvalidArgindex,Fmt); Toadd:=IntToStr(NativeInt(Args[Doarg])); Width:=Abs(width); Index:=Prec-Length(ToAdd); ToAdd:=StringOfChar('0',Index)+ToAdd end; 'E' : begin if CheckArg(jvtFloat,false) or CheckArg(jvtInteger,True) then ToAdd:=FloatToStrF(Double(Args[doarg]),ffFixed,9999,Prec); end; 'F' : begin if CheckArg(jvtFloat,false) or CheckArg(jvtInteger,True) then ToAdd:=FloatToStrF(Double(Args[doarg]),ffFixed,9999,Prec); end; 'G' : begin if CheckArg(jvtFloat,false) or CheckArg(jvtInteger,True) then ToAdd:=FloatToStrF(Double(Args[doarg]),ffGeneral,Prec,3); end; 'N' : begin if CheckArg(jvtFloat,false) or CheckArg(jvtInteger,True) then ToAdd:=FloatToStrF(Double(Args[doarg]),ffNumber,9999,Prec); end; 'M' : begin if CheckArg(jvtFloat,false) or CheckArg(jvtInteger,True) then ToAdd:=FloatToStrF(Double(Args[doarg]),ffCurrency,9999,Prec); end; 'S' : begin CheckArg(jvtString,true); hs:=String(Args[doarg]); Index:=Length(hs); If (Prec<>-1) and (Index>Prec) then Index:=Prec; ToAdd:=Copy(hs,1,Index); end; 'P' : Begin CheckArg(jvtInteger,true); ToAdd:=IntToHex(NativeInt(Args[DoArg]),31); end; 'X' : begin Checkarg(jvtinteger,true); vq:=nativeInt(Args[Doarg]); index:=31; // May need to adjust to NativeInt If Prec>index then ToAdd:=IntToHex(NativeInt(vq),index) else begin // determine minimum needed number of hex digits. Index:=1; While (NativeInt(1) shl (Index*4)<=vq) and (index<16) do inc(Index); If Index>Prec then Prec:=Index; ToAdd:=IntToHex(vq,Prec); end; end; '%': ToAdd:='%'; end; If Width<>-1 then If Length(ToAdd)= Len then exit; First := True; end; end else if not (Ident[I] in AlphaNum) then exit; I:=I+1; end; Result:=true; end; procedure FreeAndNil(var Obj); var o: TObject; begin o:=TObject(Obj); if o=nil then exit; TObject(Obj):=nil; o.Destroy; end; { EVariantError } constructor EVariantError.CreateCode(Code: Longint); begin ErrCode:=Code; end; { Exception } constructor Exception.Create(const Msg: String); begin fMessage:=Msg; {$ifdef nodejs} FNodeJSError:=TJSError.new; {$endif} if LogMessageOnCreate then Writeln('Created exception ',ClassName,' with message: ',Msg); end; constructor Exception.CreateFmt(const Msg: string; const Args: array of jsvalue ); begin //writeln('Exception.CreateFmt START ',ClassName,' "',Msg,'" Args=',Args); Create(Format(Msg,Args)); //writeln('Exception.CreateFmt END ',ClassName,' "',Msg,'" fMessage=',fMessage); end; constructor Exception.CreateHelp(const Msg: String; AHelpContext: Integer); begin Create(Msg); fHelpContext:=AHelpContext; end; constructor Exception.CreateFmtHelp(const Msg: string; const Args: array of jsvalue; AHelpContext: Integer); begin Create(Format(Msg,Args)); fHelpContext:=AHelpContext; end; function Exception.ToString: String; begin Result:=ClassName+': '+Message; end; Const RESpecials = '([\$\+\[\]\(\)\\\.\*\^])'; function StringReplace(aOriginal, aSearch, aReplace: string; Flags: TStringReplaceFlags): String; Var REFlags : String; REString : String; begin REFlags:=''; if rfReplaceAll in flags then ReFlags:='g'; if rfIgnoreCase in flags then ReFlags:=ReFlags+'i'; REString:=TJSString(aSearch).replace(TJSRegexp.new(RESpecials,'g'),'\$1'); Result:=TJSString(aOriginal).replace(TJSRegexp.new(REString,REFlags),aReplace); end; function QuoteString(aOriginal: String; AQuote: Char): String; begin Result:=AQuote+StringReplace(aOriginal,aQuote,aQuote+aQuote,[rfReplaceAll])+AQuote; end; function QuotedStr(const s: string; QuoteChar : Char = ''''): string; begin Result:=QuoteString(S,QuoteChar); end; function DeQuoteString(aQuoted: String; AQuote: Char): String; var i: Integer; begin Result:=aQuoted; if TJSString(Result).substr(0,1)<>AQuote then exit; Result:=TJSString(Result).slice(1); i:=1; while i<=length(Result) do begin if Result[i]=AQuote then begin if (i=length(Result)) or (Result[i+1]<>AQuote) then begin Result:=TJSString(Result).slice(0,i-1); exit; end else Result:=TJSString(Result).slice(0,i-1)+TJSString(Result).slice(i); end else inc(i); end; end; function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean; begin Result:=False; if (Index>0) and (Index<=Length(S)) then Result:=Pos(S[Index],Delimiters)<>0; // Note we don't do MBCS yet end; Function LastDelimiter(const Delimiters, S: string): SizeInt; begin Result:=Length(S); While (Result>0) and (Pos(S[Result],Delimiters)=0) do Dec(Result); end; function AdjustLineBreaks(const S: string): string; begin Result:=AdjustLineBreaks(S,DefaultTextLineBreakStyle); end; function AdjustLineBreaks(const S: string; Style: TTextLineBreakStyle): string; var I,L: Longint; Res : String; Procedure Add(C : Char); begin Res:=Res+C; end; begin I:=0; L:=Length(S); Result:=''; While (I<=L) do case S[I] of #10: begin if Style in [tlbsCRLF,tlbsCR] then Add(#13); if Style=tlbsCRLF then Add(#10); Inc(I); end; #13: begin if Style=tlbsCRLF then Add(#13); Add(#10); Inc(I); if S[I]=#10 then Inc(I); end; else Add(S[i]); Inc(I); end; Result:=Res; end; function WrapText(const Line, BreakStr: string; const BreakChars: array of char; MaxCol: Integer): string; const Quotes = ['''', '"']; Var L : String; C,LQ,BC : Char; P,BLen,Len : Integer; HB,IBC : Boolean; begin Result:=''; L:=Line; Blen:=Length(BreakStr); If (BLen>0) then BC:=BreakStr[1] else BC:=#0; Len:=Length(L); While (Len>0) do begin P:=1; LQ:=#0; HB:=False; IBC:=False; While ((P<=Len) and ((P<=MaxCol) or not IBC)) and ((LQ<>#0) or Not HB) do begin C:=L[P]; If (C=LQ) then LQ:=#0 else If (C in Quotes) then LQ:=C; If (LQ<>#0) then Inc(P) else begin HB:=((C=BC) and (BreakStr=Copy(L,P,BLen))); If HB then Inc(P,Blen) else begin If (P>=MaxCol) then IBC:=CharInSet(C,BreakChars); Inc(P); end; end; // Writeln('"',C,'" : IBC : ',IBC,' HB : ',HB,' LQ : ',LQ,' P>MaxCol : ',P>MaxCol); end; Result:=Result+Copy(L,1,P-1); Delete(L,1,P-1); Len:=Length(L); If (Len>0) and Not HB then Result:=Result+BreakStr; end; end; function WrapText(const Line: string; MaxCol: Integer): string; begin Result:=WrapText(Line,sLineBreak, [' ', '-', #9], MaxCol); end; function GetEnvironmentVariable(const EnvVar: String): String; begin if Assigned(OnGetEnvironmentVariable) then Result:=OnGetEnvironmentVariable(EnvVar) else Result:=''; end; function GetEnvironmentVariableCount: Integer; begin if Assigned(OnGetEnvironmentVariableCount) then Result:=OnGetEnvironmentVariableCount() else Result:=0; end; function GetEnvironmentString(Index: Integer): String; begin if Assigned(OnGetEnvironmentString) then Result:=OnGetEnvironmentString(Index) else Result:=''; end; { Date/Time routines} Function DoEncodeDate(Year, Month, Day: Word): longint; Var D : TDateTime; begin If TryEncodeDate(Year,Month,Day,D) then Result:=Trunc(D) else Result:=0; end; function DoEncodeTime(Hour, Minute, Second, MilliSecond: word): TDateTime; begin If not TryEncodeTime(Hour,Minute,Second,MilliSecond,Result) then Result:=0; end; function DateTimeToJSDate(aDateTime: TDateTime): TJSDate; Var Y,M,D,h,n,s,z : Word; begin DecodeDate(Trunc(aDateTime),Y,M,D); DecodeTime(Frac(aDateTime),H,N,S,Z); Result:=TJSDate.New(Y,M-1,D,h,n,s,z); end; function JSDateToDateTime(aDate: TJSDate): TDateTime; begin Result:=EncodeDate(ADate.FullYear,ADate.Month+1,ADate.Date) + EncodeTime(ADate.Hours,ADate.Minutes,ADate.Seconds,ADate.Milliseconds); end; { ComposeDateTime converts a Date and a Time into one TDateTime } function ComposeDateTime(Date,Time : TDateTime) : TDateTime; begin if Date < 0 then Result := trunc(Date) - Abs(frac(Time)) else Result := trunc(Date) + Abs(frac(Time)); end; function TryEncodeDate(Year, Month, Day: Word; out Date: TDateTime): Boolean; var c, ya: LongWord; begin Result:=(Year>0) and (Year<10000) and (Month >= 1) and (Month<=12) and (Day>0) and (Day<=MonthDays[IsleapYear(Year),Month]); If Result then begin if month > 2 then Dec(Month,3) else begin Inc(Month,9); Dec(Year); end; c:= Year DIV 100; ya:= Year - 100*c; Date := (146097*c) SHR 2 + (1461*ya) SHR 2 + (153*LongWord(Month)+2) DIV 5 + LongWord(Day); // Note that this line can't be part of the line above, since TDateTime is // signed and c and ya are not Date := Date - 693900; end end; function TryEncodeTime(Hour, Min, Sec, MSec: Word; out Time: TDateTime ): Boolean; begin Result:=(Hour<24) and (Min<60) and (Sec<60) and (MSec<1000); If Result then Time:=TDateTime(LongWord(Hour)*3600000+LongWord(Min)*60000+LongWord(Sec)*1000+MSec)/MSecsPerDay; end; { EncodeDate packs three variables Year, Month and Day into a TDateTime value the result is the number of days since 12/30/1899 } function EncodeDate(Year, Month, Day: word): TDateTime; begin If Not TryEncodeDate(Year,Month,Day,Result) then Raise EConvertError.CreateFmt('%s-%s-%s is not a valid date specification', [IntToStr(Year),IntToStr(Month),IntToStr(Day)]); end; { EncodeTime packs four variables Hour, Minute, Second and MilliSecond into a TDateTime value } function EncodeTime(Hour, Minute, Second, MilliSecond:word):TDateTime; begin If not TryEncodeTime(Hour,Minute,Second,MilliSecond,Result) then Raise EConvertError.CreateFmt('%s:%s:%s.%s is not a valid time specification', [IntToStr(Hour),IntToStr(Minute),IntToStr(Second),IntToStr(MilliSecond)]); end; { DecodeDate unpacks the value Date into three values: Year, Month and Day } procedure DecodeDate(Date: TDateTime; out Year, Month, Day: word); var ly,ld,lm,j : LongWord; begin if Date <= -datedelta then // If Date is before 1-1-1 then return 0-0-0 begin Year := 0; Month := 0; Day := 0; end else begin if Date>0 then Date:=(Date+(1/(msecsperday*2))) else Date:=Date-(1/(msecsperday*2)); if Date>MaxDateTime then Date:=MaxDateTime; // Raise EConvertError.CreateFmt('%f is not a valid TDatetime encoding, maximum value is %f.',[Date,MaxDateTime]); j := ((Trunc(Date) + 693900) SHL 2)-1; ly:= j DIV 146097; j:= j - 146097 * LongWord(ly); ld := j SHR 2; j:=(ld SHL 2 + 3) DIV 1461; ld:= ((ld SHL 2) + 7 - 1461*j) SHR 2; lm:=(5 * ld-3) DIV 153; ld:= (5 * ld +2 - 153*lm) DIV 5; ly:= 100 * LongWord(ly) + j; if lm < 10 then inc(lm,3) else begin dec(lm,9); inc(ly); end; year:=ly; month:=lm; day:=ld; end; end; function DecodeDateFully(const DateTime: TDateTime; out Year, Month, Day, DOW: Word): Boolean; begin DecodeDate(DateTime,Year,Month,Day); DOW:=DayOfWeek(DateTime); Result:=IsLeapYear(Year); end; { DateTimeToTimeStamp converts DateTime to a TTimeStamp } function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp; Var D : Double; begin D:=DateTime * Double(MSecsPerDay); if D<0 then D:=D-0.5 else D:=D+0.5; result.Time := Trunc(Abs(Trunc(D)) Mod MSecsPerDay); result.Date := DateDelta + (Trunc(D) div MSecsPerDay); end; { TimeStampToDateTime converts TimeStamp to a TDateTime value } function TimeStampToDateTime(const TimeStamp: TTimeStamp): TDateTime; begin Result := ComposeDateTime(TimeStamp.Date - DateDelta,TimeStamp.Time/MSecsPerDay) end; { MSecsToTimeStamp } function MSecsToTimeStamp(MSecs: NativeInt): TTimeStamp; begin result.Date := Trunc(msecs/msecsperday); msecs:= msecs-NativeInt(result.date)*msecsperday; result.Time := Round(MSecs); end; function TimeStampToMSecs(const TimeStamp: TTimeStamp): NativeInt; begin result := TimeStamp.Time + (timestamp.date*msecsperday); end ; { DecodeTime unpacks Time into four values: Hour, Minute, Second and MilliSecond } procedure DecodeTime(Time: TDateTime; out Hour, Minute, Second, MilliSecond: word); Var l : LongWord; begin l := DateTimeToTimeStamp(Time).Time; Hour := l div 3600000; l := l mod 3600000; Minute := l div 60000; l := l mod 60000; Second := l div 1000; l := l mod 1000; MilliSecond := l; end; { DateTimeToSystemTime converts DateTime value to SystemTime } procedure DateTimeToSystemTime(DateTime: TDateTime; out SystemTime: TSystemTime); begin DecodeDateFully(DateTime, SystemTime.Year, SystemTime.Month, SystemTime.Day,SystemTime.DayOfWeek); DecodeTime(DateTime, SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond); Dec(SystemTime.DayOfWeek); end ; { SystemTimeToDateTime converts SystemTime to a TDateTime value } function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime; begin result := ComposeDateTime(DoEncodeDate(SystemTime.Year, SystemTime.Month, SystemTime.Day), DoEncodeTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond)); end ; function DayOfWeek(DateTime: TDateTime): integer; begin Result:= 1+((Trunc(DateTime) - 1) mod 7); If (Result<=0) then Inc(Result,7); end; function Now: TDateTime; begin Result:=JSDateToDateTime(TJSDate.New()); end; function Date: TDateTime; begin Result:=Trunc(Now); end; function Time: TDateTime; begin Result:=Now-Date; end ; { IncMonth increments DateTime with NumberOfMonths months, NumberOfMonths can be less than zero } function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer = 1 ): TDateTime; var Year, Month, Day : word; begin DecodeDate(DateTime, Year, Month, Day); IncAMonth(Year, Month, Day, NumberOfMonths); result := ComposeDateTime(DoEncodeDate(Year, Month, Day), DateTime); end ; { IncAMonth is the same as IncMonth, but operates on decoded date } procedure IncAMonth(var Year, Month, Day: Word; NumberOfMonths: Integer = 1); var TempMonth, S: Integer; begin If NumberOfMonths>=0 then s:=1 else s:=-1; inc(Year,(NumberOfMonths div 12)); TempMonth:=Month+(NumberOfMonths mod 12)-1; if (TempMonth>11) or (TempMonth<0) then begin Dec(TempMonth, S*12); Inc(Year, S); end; Month:=TempMonth+1; { Months from 1 to 12 } If (Day>MonthDays[IsLeapYear(Year)][Month]) then Day:=MonthDays[IsLeapYear(Year)][Month]; end; { IsLeapYear returns true if Year is a leap year } function IsLeapYear(Year: Word): boolean; begin Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0)); end; { DateToStr returns a string representation of Date using ShortDateFormat } function DateToStr(Date: TDateTime): string; begin Result:=FormatDateTime('ddddd', Date); end ; { TimeToStr returns a string representation of Time using LongTimeFormat } function TimeToStr(Time: TDateTime): string; begin Result:=FormatDateTime('tt',Time); end ; { DateTimeToStr returns a string representation of DateTime using LongDateTimeFormat } Var DateTimeToStrFormat : Array[Boolean] of string = ('c','f'); function DateTimeToStr(DateTime: TDateTime; ForceTimeIfZero : Boolean = False): string; begin Result:=FormatDateTime(DateTimeToStrFormat[ForceTimeIfZero], DateTime) end ; { StrToDate converts the string S to a TDateTime value if S does not represent a valid date value an EConvertError will be raised } function IntStrToDate(Out ErrorMsg : String; const S: String; const useformat : string; separator : char): TDateTime; Const WhiteSpace = ' '#8#9#10#12#13; Digits = '0123456789'; procedure FixErrorMsg(const errmarg : String); begin ErrorMsg:=Format(SInvalidDateFormat,[errmarg]); end; var df:string; d,m,y,ly,ld,lm:word; n,i,len:longint; c: integer; dp,mp,yp,which : Byte; s1:string; values: array of integer; YearMoreThenTwoDigits : boolean; begin SetLength(values,4); Result:=0; Len:=Length(S); ErrorMsg:=''; While (Len>0) and (Pos(S[Len],WhiteSpace)>0) do Dec(len); if (Len=0) then begin FixErrorMsg(S); exit; end; YearMoreThenTwoDigits := False; if separator = #0 then if (DateSeparator<>#0) then separator := DateSeparator else separator:='-'; // Writeln('Separator: ',Separator); df := UpperCase(useFormat); { Determine order of D,M,Y } yp:=0; mp:=0; dp:=0; Which:=0; i:=0; while (i0 then s1 := s1 + s[i]; { space can be part of the shortdateformat, and is defaultly in slovak windows, therefor it shouldn't be taken as separator (unless so specified) and ignored } if (Separator <> ' ') and (s[i] = ' ') then Continue; if (s[i] = separator) or ((i = len) and (Pos(s[i],Digits)>0)) then begin inc(n); if n>3 then begin // Writeln('More than 3 separators'); FixErrorMsg(S); exit; end; // Check if the year has more then two digits (if n=yp, then we are evaluating the year.) if (n=yp) and (length(s1)>2) then YearMoreThenTwoDigits := True; val(s1, values[n], c); if c<>0 then begin // Writeln('S1 not a number ',S1); FixErrorMsg(s); Exit; end; s1 := ''; end else if (Pos(s[i],Digits)=0) then begin // Writeln('Not a number at pos ',I,' ',S[i]); FixErrorMsg(s); Exit; end; end ; // Writeln('Which : ',Which,' N : ',N); if (Which<3) and (N>Which) then begin FixErrorMsg(s); Exit; end; // Fill in values. DecodeDate(Date,Ly,LM,LD); If N=3 then begin y:=values[yp]; m:=values[mp]; d:=values[dp]; end Else begin Y:=ly; If n<2 then begin d:=values[1]; m := LM; end else If dp= 0) and (y < 100) and not YearMoreThenTwoDigits then begin ly := ly - TwoDigitYearCenturyWindow; Inc(Y, ly div 100 * 100); if (TwoDigitYearCenturyWindow > 0) and (Y < ly) then Inc(Y, 100); end; if not TryEncodeDate(y, m, d, result) then errormsg:=SErrInvalidDate; end; function StrToDate(const S: String; const useformat : string; separator : char): TDateTime; Var MSg : String; begin Result:=IntStrToDate(Msg,S,useFormat,Separator); If (Msg<>'') then Raise EConvertError.Create(Msg); end; function StrToDate(const S: String; separator : char): TDateTime; begin result := StrToDate(S,ShortDateFormat,separator) end; function StrToDate(const S: String): TDateTime; begin result := StrToDate(S,ShortDateFormat,#0); end; { StrToTime converts the string S to a TDateTime value if S does not represent a valid time value an EConvertError will be raised } function IntStrToTime(Out ErrorMsg : String; const S: String; Len : integer; separator : char): TDateTime; const AMPM_None = 0; AMPM_AM = 1; AMPM_PM = 2; tiHour = 0; tiMin = 1; tiSec = 2; tiMSec = 3; type TTimeValues = array of Word; var AmPm: integer; TimeValues: TTimeValues; function SplitElements(out TimeValues: TTimeValues; out AmPm: Integer): Boolean; //Strict version. It does not allow #32 as Separator, it will treat it as whitespace always const Digits = '0123456789'; var Cur, Offset, ElemLen, Err, TimeIndex, FirstSignificantDigit: Integer; Value: Integer; DigitPending, MSecPending: Boolean; AmPmStr: String; CurChar: Char; I : Integer; allowedchars : string; begin Result := False; AmPm := AMPM_None; //No Am or PM in string found yet MSecPending := False; TimeIndex := 0; //indicating which TTimeValue must be filled next For I:=tiHour to tiMSec do TimeValues[i]:=0; Cur := 1; //skip leading blanks While (Cur < Len) and (S[Cur] =#32) do Inc(Cur); Offset := Cur; //First non-blank cannot be Separator or DecimalSeparator if (Cur > Len - 1) or (S[Cur] = Separator) or (S[Cur] = Decimalseparator) then begin // Writeln('Error in sep S[Cur]',S[Cur],' ',separator,' ',GetDecimalSeparator); Exit; end; DigitPending := (Pos(S[Cur],Digits)>0); While (Cur <= Len) do begin //writeln; // writeln('Main While loop: Cur = ',Cur,' S[Cur] = "',S[Cur],'" Len = ',Len,' separator : ',Separator); CurChar := S[Cur]; if Pos(CurChar,Digits)>0 then begin//Digits //HH, MM, SS, or Msec? // writeln('Digit: ', CurChar); //Digits are only allowed after starting Am/PM or at beginning of string or after Separator //and TimeIndex must be <= tiMSec //Uncomment "or (#32 = Separator)" and it will allllow #32 as separator if (not (DigitPending {or (#32 = Separator)})) or (TimeIndex > tiMSec) then begin // Writeln('DigitPending',ElemLen); Exit; end; OffSet := Cur; if (CurChar <> '0') then FirstSignificantDigit := OffSet else FirstSignificantDigit := -1; while (Cur < Len) and (Pos(S[Cur + 1],Digits)>0) do begin //Mark first Digit that is not '0' if (FirstSignificantDigit = -1) and (S[Cur] <> '0') then FirstSignificantDigit := Cur; Inc(Cur); end; if (FirstSignificantDigit = -1) then FirstSignificantDigit := Cur; ElemLen := 1+ Cur - FirstSignificantDigit; // writeln(' S[FirstSignificantDigit] = ',S[FirstSignificantDigit], ' S[Cur] = ',S[Cur],' ElemLen = ',ElemLen,' -> ', S[Offset], ElemLen); // writeln(' Cur = ',Cur); //this way we know that Val() will never overflow Value ! if (ElemLen <= 2) or ((ElemLen <= 3) and (TimeIndex = tiMSec) ) then begin Val(Copy(S,FirstSignificantDigit, ElemLen), Value, Err); // writeln(' Value = ',Value,' HH = ',TimeValues[0],' MM = ',TimeValues[1],' SS = ',TimeValues[2],' MSec = ',Timevalues[3]); //This is safe now, because we know Value < High(Word) TimeValues[TimeIndex] := Value; Inc(TimeIndex); DigitPending := False; end else begin // Writeln('Wrong elemlen: ',ElemLen, ' timeIndex: ',timeindex); Exit; //Value to big, so it must be a wrong timestring end; end//Digits else if (CurChar = #32) then begin //writeln('#32'); //just skip, but we must adress this, or it will be parsed by either AM/PM or Separator end else if (CurChar = Separator) then begin // writeln('Separator ',Separator); if DigitPending or (TimeIndex > tiSec) then begin // Writeln ('DigitPending ',DigitPending,' or (TimeIndex',Timeindex,' > tiSec,', tiSec,')'); Exit; end; DigitPending := True; MSecPending := False; end else if (CurChar = DecimalSeparator) then begin //writeln('DecimalSeparator'); if DigitPending or MSecPending or (TimeIndex <> tiMSec) then begin // Writeln('DigitPending ',DigitPending,' or MSecPending ',MSecPending,' (',TimeIndex,',Timeindex, >', tiMSec,' tiSec)'); Exit; end; DigitPending := True; MSecPending := True; end else begin//AM/PM? //None of the above, so this char _must_ be the start of AM/PM string //If we already have found AM/PM or we expect a digit then then timestring must be wrong at this point //writeln('AM/PM?'); if (AmPm <> AMPM_None) or DigitPending then begin // Writeln('AmPm <> AMPM_None) or DigitPending'); Exit; end; OffSet := Cur; allowedchars:=DecimalSeparator+' '; if Separator<>#0 then allowedchars:=allowedchars+Separator; while (Cur < Len) and (Pos(S[Cur + 1],AllowedChars)=0) and (Pos(S[Cur + 1],Digits)=0) do Inc(Cur); ElemLen := 1 + Cur - OffSet; // writeln(' S[Offset] = ',S[Offset], ' S[Cur] = ',S[Cur],' ElemLen = ',ElemLen,' -> ', S[1+Offset], ElemLen); // writeln(' Cur = ',Cur, ', S =',S); AmPmStr := Copy(S,OffSet, ElemLen); // writeln('AmPmStr = ',ampmstr,' (',length(ampmstr),')'); //We must compare to TimeAMString before hardcoded 'AM' for delphi compatibility //Also it is perfectly legal, though insane to have TimeAMString = 'PM' and vice versa if (CompareText(AmPmStr, TimeAMString) = 0) then AmPm := AMPM_AM else if (CompareText(AmPmStr, TimePMString) = 0) then AmPm := AMPM_PM else if (CompareText(AmPmStr, 'AM') = 0) then AmPm := AMPM_AM else if (CompareText(AmPmStr, 'PM') = 0) then AmPm := AMPM_PM else begin // Writeln('No timestring ',AmPmStr); Exit; //If text does not match any of these, timestring must be wrong; end; //if AM/PM is at beginning of string, then a digit is mandatory after it if (TimeIndex = tiHour) then begin DigitPending := True; end //otherwise, no more TimeValues allowed after this else begin TimeIndex := tiMSec + 1; DigitPending := False; end; end;//AM/PM Inc(Cur) end;//while //If we arrive here, parsing the elements has been successfull //if not at least Hours specified then input is not valid //when am/pm is specified Hour must be <= 12 and not 0 if (TimeIndex = tiHour) or ((AmPm <> AMPM_None) and ((TimeValues[tiHour] > 12) or (TimeValues[tiHour] = 0))) or DigitPending then Exit; Result := True; end; begin setlength(timevalues,4); if separator = #0 then if (TimeSeparator<>#0) then separator := TimeSeparator else separator:=':'; AmPm := AMPM_None; if not SplitElements(TimeValues, AmPm) then begin ErrorMsg:=Format(SErrInvalidTimeFormat,[S]); Exit; end; if (AmPm=AMPM_PM) and (TimeValues[tiHour]<>12) then Inc(TimeValues[tiHour], 12) else if (AmPm=AMPM_AM) and (TimeValues[tiHour]=12) then TimeValues[tiHour]:=0; // Writeln( TimeValues[tiHour], TimeValues[tiMin], TimeValues[tiSec], TimeValues[tiMSec]); if not TryEncodeTime(TimeValues[tiHour], TimeValues[tiMin], TimeValues[tiSec], TimeValues[tiMSec], result) Then ErrorMsg:=Format(SErrInvalidTimeFormat,[S]); end ; function StrToTime(const S: String; separator: char): TDateTime; Var Msg : String; begin Result:=IntStrToTime(Msg,S,Length(S),Separator); If (Msg<>'') then Raise EConvertError.Create(Msg); end; function StrToTime(const S: String): TDateTime; begin result:= StrToTime(s, TimeSeparator); end; { StrToDateTime converts the string S to a TDateTime value if S does not represent a valid date and/or time value an EConvertError will be raised } function SplitDateTimeStr(DateTimeStr: String; out DateStr, TimeStr: String): Integer; { Helper function for StrToDateTime Pre-condition Date is before Time If either Date or Time is omitted then see what fits best, a time or a date (issue #0020522) Date and Time are separated by whitespace (space Tab, Linefeed or carriage return) FS.DateSeparator can be the same as FS.TimeSeparator (issue #0020522) If they are both #32 and TrimWhite(DateTimeStr) contains a #32 a date is assumed. Post-condition DateStr holds date as string or is empty TimeStr holds time as string or is empty Result = number of strings returned, 0 = error } const WhiteSpace = #9#10#13#32; var p: Integer; DummyDT: TDateTime; begin Result := 0; DateStr := ''; TimeStr := ''; DateTimeStr := Trim(DateTimeStr); if Length(DateTimeStr) = 0 then exit; if (DateSeparator = #32) and (TimeSeparator = #32) and (Pos(#32, DateTimeStr) > 0) then begin DateStr:=DateTimeStr; { Assume a date: dd [mm [yy]]. Really fancy would be counting the number of whitespace occurrences and decide and split accordingly } Exit(1); end; p:=1; //find separator if (DateSeparator<>#32) then begin while (p0)) do Inc(p); end else begin p:=Pos(TimeSeparator, DateTimeStr); if (p<>0) then repeat Dec(p); until (p=0) or (Pos(DateTimeStr[p],WhiteSpace)>0); end; //Always fill DateStr, it eases the algorithm later if (p=0) then p:=Length(DateTimeStr); DateStr:=Copy(DateTimeStr,1,p); TimeStr:=Trim(Copy(DateTimeStr,p+1,100)); if (Length(TimeStr)<>0) then Result:=2 else begin Result:=1; //found 1 string // 2 cases when DateTimeStr only contains a time: // Date/time separator differ, and string contains a timeseparator // Date/time separators are equal, but transformation to date fails. if ((DateSeparator<>TimeSeparator) and (Pos(TimeSeparator,DateStr) > 0)) or ((DateSeparator=TimeSeparator) and (not TryStrToDate(DateStr, DummyDT))) then begin TimeStr := DateStr; DateStr := ''; end; end; end; function StrToDateTime(const S: String): TDateTime; var TimeStr, DateStr: String; PartsFound: Integer; begin PartsFound := SplitDateTimeStr(S, DateStr, TimeStr); case PartsFound of 0: Result:=StrToDate(''); 1: if (Length(DateStr) > 0) then Result := StrToDate(DateStr,ShortDateFormat,DateSeparator) else Result := StrToTime(TimeStr); 2: Result := ComposeDateTime(StrTodate(DateStr,ShortDateFormat,DateSeparator), StrToTime(TimeStr)); end; end; function FormatDateTime(const FormatStr: string; const DateTime: TDateTime ): string; procedure StoreStr(APos,Len: Integer); begin // Writeln('StoreStr: ',Result,'+',Copy(FormatStr,APos,Len)); Result:=Result+Copy(FormatStr,APos,Len); end; procedure StoreString(const AStr: string); begin // Writeln('StoreString: ',Result,'+',AStr); Result:=Result+AStr; end; procedure StoreInt(Value, Digits: Integer); var S: string; begin S:=IntToStr(Value); While (Length(S) 1 then // 0 is original string, 1 is included FormatString Exit; FormatCurrent := 1; FormatEnd := Length(FormatStr); Clock12 := false; isInterval := false; // look for unquoted 12-hour clock token P:=1; while P<=FormatEnd do begin Token := FormatStr[P]; case Token of '''', '"': begin Inc(P); while (P < FormatEnd) and (FormatStr[P]<>Token) do Inc(P); end; 'A', 'a': begin if (CompareText(Copy(FormatStr,P,3),'A/P')=0) or (CompareText(Copy(FormatStr,P,4),'AMPM')=0) or (CompareText(Copy(FormatStr,P,5),'AM/PM')=0) then begin Clock12 := true; break; end; end; end; // case Inc(P); end ; token := #255; lastformattoken := ' '; prevlasttoken := 'H'; while FormatCurrent <= FormatEnd do begin Token := UpperCase(FormatStr[FormatCurrent])[1]; // Writeln('Treating token at pos ',FormatCurrent,', : ',Token,' (',FormatStr,')'); Count := 1; P := FormatCurrent + 1; case Token of '''', '"': begin while (P < FormatEnd) and (FormatStr[P]<>Token) do Inc(P); Inc(P); Count := P - FormatCurrent; StoreStr(FormatCurrent + 1, Count - 2); end ; 'A': begin if CompareText(Copy(FormatStr,FormatCurrent,4), 'AMPM') = 0 then begin Count := 4; if Hour < 12 then StoreString(TimeAMString) else StoreString(TimePMString); end else if CompareText(Copy(FormatStr,FormatCurrent,5), 'AM/PM') = 0 then begin Count := 5; if Hour < 12 then StoreStr(FormatCurrent, 2) else StoreStr(FormatCurrent+3, 2); end else if CompareText(Copy(FormatStr,FormatCurrent,3), 'A/P') = 0 then begin Count := 3; if Hour < 12 then StoreStr(FormatCurrent, 1) else StoreStr(FormatCurrent+2, 1); end else raise EConvertError.Create('Illegal character in format string'); end ; '/': begin // Writeln('Detected date separator'); StoreString(DateSeparator); end; ':': StoreString(TimeSeparator); ' ', 'C', 'D', 'H', 'M', 'N', 'S', 'T', 'Y', 'Z', 'F' : begin // Writeln(FormatCurrent,' Special Token: ',Token,', Count: ',Count,', P: ',P); while (P <= FormatEnd) and (UpperCase(FormatStr[P]) = Token) do Inc(P); Count := P - FormatCurrent; // Writeln(FormatCurrent,' Special Token: ',Token,', Count: ',Count,', P: ',P); case Token of ' ': StoreStr(FormatCurrent, Count); 'Y': begin if Count > 2 then StoreInt(Year, 4) else StoreInt(Year mod 100, 2); end; 'M': begin if isInterval and ((prevlasttoken = 'H') or TimeFlag) then StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0) else if (lastformattoken = 'H') or TimeFlag then begin if Count = 1 then StoreInt(Minute, 0) else StoreInt(Minute, 2); end else begin case Count of 1: StoreInt(Month, 0); 2: StoreInt(Month, 2); 3: StoreString(ShortMonthNames[Month]); else StoreString(LongMonthNames[Month]); end; end; end; 'D': begin case Count of 1: StoreInt(Day, 0); 2: StoreInt(Day, 2); 3: StoreString(ShortDayNames[DayOfWeek-1]); 4: StoreString(LongDayNames[DayOfWeek-1]); 5: StoreFormat(ShortDateFormat, Nesting+1, False); else StoreFormat(LongDateFormat, Nesting+1, False); end ; end ; 'H': if isInterval then StoreInt(Hour + trunc(abs(DateTime))*24, 0) else if Clock12 then begin tmp := hour mod 12; if tmp=0 then tmp:=12; if Count = 1 then StoreInt(tmp, 0) else StoreInt(tmp, 2); end else begin if Count = 1 then StoreInt(Hour, 0) else StoreInt(Hour, 2); end; 'N': if isInterval then StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0) else if Count = 1 then StoreInt(Minute, 0) else StoreInt(Minute, 2); 'S': if isInterval then StoreInt(Second + (Minute + (Hour + trunc(abs(DateTime))*24)*60)*60, 0) else if Count = 1 then StoreInt(Second, 0) else StoreInt(Second, 2); 'Z': if Count = 1 then StoreInt(MilliSecond, 0) else StoreInt(MilliSecond, 3); 'T': if Count = 1 then StoreFormat(ShortTimeFormat, Nesting+1, True) else StoreFormat(LongTimeFormat, Nesting+1, True); 'C': begin StoreFormat(ShortDateFormat, Nesting+1, False); if (Hour<>0) or (Minute<>0) or (Second<>0) then begin StoreString(' '); StoreFormat(LongTimeFormat, Nesting+1, True); end; end; 'F': begin StoreFormat(ShortDateFormat, Nesting+1, False); StoreString(' '); StoreFormat(LongTimeFormat, Nesting+1, True); end; end; prevlasttoken := lastformattoken; lastformattoken := token; end; else StoreString(Token); end ; Inc(FormatCurrent, Count); end; end; begin DecodeDateFully(DateTime, Year, Month, Day, DayOfWeek); DecodeTime(DateTime, Hour, Minute, Second, MilliSecond); // Writeln(DateTime,'->',Year,',', Month, ',',Day, ',',DayOfWeek,',',Hour, ',',Minute, ',',Second, ',',MilliSecond); if FormatStr <> '' then StoreFormat(FormatStr, 0, False) else StoreFormat('C', 0, False); end ; function CurrentYear: Word; begin Result:=TJSDate.New().FullYear; end; function TryStrToDate(const S: String; out Value: TDateTime): Boolean; begin Result:=TryStrToDate(S,Value,ShortDateFormat,#0); end; function TryStrToDate(const S: String; out Value: TDateTime; separator : char): Boolean; begin Result:=TryStrToDate(S,Value,ShortDateFormat,Separator); end; function TryStrToDate(const S: String; out Value: TDateTime; const useformat : string; separator : char): Boolean; Var Msg : String; begin Result:=Length(S)<>0; If Result then begin Value:=IntStrToDate(Msg,S,useformat,Separator); Result:=(Msg=''); end; end; function TryStrToTime(const S: String; out Value: TDateTime; separator : char): Boolean; Var Msg : String; begin Result:=Length(S)<>0; If Result then begin Value:=IntStrToTime(Msg,S,Length(S),Separator); Result:=(Msg=''); end; end; function TryStrToTime(const S: String; out Value: TDateTime): Boolean; begin result:=TryStrToTime(S,Value,#0); end; function TryStrToDateTime(const S: String; out Value: TDateTime): Boolean; var I: integer; dtdate, dttime :TDateTime; begin result:=false; I:=Pos(TimeSeparator,S); If (I>0) then begin While (I>0) and (S[I]<>' ') do Dec(I); If I>0 then begin if not TryStrToDate(Copy(S,1,I-1),dtdate) then exit; if not TryStrToTime(Copy(S,i+1, Length(S)-i),dttime) then exit; Value:=ComposeDateTime(dtdate,dttime); result:=true; end else result:=TryStrToTime(s,Value); end else result:=TryStrToDate(s,Value); end; function StrToDateDef(const S: String; const Defvalue : TDateTime): TDateTime; begin result := StrToDateDef(S,DefValue,#0); end; function StrToTimeDef(const S: String; const Defvalue : TDateTime): TDateTime; begin result := StrToTimeDef(S,DefValue,#0); end; function StrToDateTimeDef(const S: String; const Defvalue : TDateTime): TDateTime; begin if not TryStrToDateTime(s,Result) Then result:=defvalue; end; function StrToDateDef(const S: String; const Defvalue : TDateTime; separator : char): TDateTime; begin if not TryStrToDate(s,Result, separator) Then result:=defvalue; end; function StrToTimeDef(const S: String; const Defvalue : TDateTime; separator : char): TDateTime; begin if not TryStrToTime(s,Result, separator) Then result:=defvalue; end; procedure ReplaceTime(var dati:TDateTime; NewTime : TDateTime); begin dati:= ComposeDateTime(dati, newtime); end; procedure ReplaceDate(var DateTime: TDateTime; const NewDate: TDateTime); var tmp : TDateTime; begin tmp:=NewDate; ReplaceTime(tmp,DateTime); DateTime:=tmp; end; function FloatToDateTime(const Value: Extended): TDateTime; begin If (ValueMaxDateTime) then Raise EConvertError.CreateFmt (SInvalidDateTime,[FloatToStr(Value)]); Result:=Value; end; function FloattoCurr(const Value: Extended): Currency; begin if not TryFloatToCurr(Value, Result) then Raise EConvertError.CreateFmt(SInvalidCurrency, [FloatToStr(Value)]); end; function TryFloatToCurr(const Value: Extended; var AResult: Currency): Boolean; begin Result:=(Value>=MinCurrency) and (Value<=MaxCurrency); if Result then AResult := Value; end; function CurrToStr(Value: Currency): string; begin Result:=FloatToStrF(Value,ffGeneral,-1,0); end; (* function CurrToStr(Value: Currency; const FormatSettings: TFormatSettings): string; begin end; *) function StrToCurr(const S: string): Currency; begin if not TryStrToCurr(S,Result) then Raise EConvertError.createfmt(SInvalidCurrency,[S]); end; (* function StrToCurr(const S: string; const FormatSettings: TFormatSettings): Currency; begin end; *) function TryStrToCurr(const S: string; out Value: Currency): Boolean; Var D : Double; begin Result:=TryStrToFloat(S,D); if Result then Value:=D; end; (* function TryStrToCurr(const S: string; out Value: Currency; const FormatSettings: TFormatSettings): Boolean; begin end; *) function StrToCurrDef(const S: string; Default: Currency): Currency; Var R : Currency; begin if TryStrToCurr(S,R) then Result:=R else Result:=Default; end; (* function StrToCurrDef(const S: string; Default: Currency; const FormatSettings: TFormatSettings): Currency; begin end; *) { --------------------------------------------------------------------- Interface related ---------------------------------------------------------------------} function Supports(const Instance: IInterface; const AClass: TClass; out Obj ): Boolean; begin Result := (Instance<>nil) and (Instance.QueryInterface(IObjectInstance,Obj)=S_OK) and (TObject(Obj).InheritsFrom(AClass)); end; function Supports(const Instance: IInterface; const IID: TGuid; out Intf ): Boolean; begin Result:=(Instance<>nil) and (Instance.QueryInterface(IID,Intf)=S_OK); end; function Supports(const Instance: TObject; const IID: TGuid; out Intf): Boolean; begin Result:=(Instance<>nil) and Instance.GetInterface(IID,Intf); end; function Supports(const Instance: TObject; const IID: TGuidString; out Intf ): Boolean; begin Result:=(Instance<>nil) and Instance.GetInterfaceByStr(IID,Intf); end; function Supports(const Instance: IInterface; const AClass: TClass): Boolean; var Temp: TObject; begin Result:=Supports(Instance,AClass,Temp); end; function Supports(const Instance: IInterface; const IID: TGuid): Boolean; var Temp: IInterface; begin Result:=Supports(Instance,IID,Temp); end; function Supports(const Instance: TObject; const IID: TGuid): Boolean; var Temp: TJSObject; begin Result:=Supports(Instance,IID,Temp); asm if (Temp && Temp.$kind==='com') Temp._Release(); end; end; function Supports(const Instance: TObject; const IID: TGuidString): Boolean; var Temp: TJSObject; begin Result:=Supports(Instance,IID,Temp); asm if (Temp && Temp.$kind==='com') Temp._Release(); end; end; function Supports(const AClass: TClass; const IID: TGuid): Boolean; var maps: JSValue; begin if AClass=nil then exit(false); maps := TJSObject(AClass)['$intfmaps']; if not maps then exit(false); if TJSObject(maps)[GUIDToString(IID)] then exit(true); Result:=false; end; function Supports(const AClass: TClass; const IID: TGuidString): Boolean; var maps: JSValue; begin if AClass=nil then exit(false); maps := TJSObject(AClass)['$intfmaps']; if not maps then exit(false); if TJSObject(maps)[uppercase(IID)] then exit(true); Result:=false; end; function TryStringToGUID(const s: string; out Guid: TGuid): Boolean; var re: TJSRegexp; begin if Length(s)<>38 then Exit(False); re:=TJSRegexp.new('^\{[0-9a-fA-F]{8}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{12}\}$'); Result:=re.test(s); if not Result then begin Guid.D1:=0; exit; end; asm rtl.strToGUIDR(s,Guid); end; Result:=true; end; function StringToGUID(const S: string): TGuid; begin if not TryStringToGUID(S, Result) then raise EConvertError.CreateFmt(SInvalidGUID, [S]); end; function GUIDToString(const guid: TGuid): string; begin Result:=System.GUIDToString(guid); end; function IsEqualGUID(const guid1, guid2: TGuid): Boolean; var i: integer; begin if (guid1.D1<>guid2.D1) or (guid1.D2<>guid2.D2) or (guid1.D3<>guid2.D3) then exit(false); for i:=0 to 7 do if guid1.D4[i]<>guid2.D4[i] then exit(false); Result:=true; end; function GuidCase(const guid: TGuid; const List: array of TGuid): Integer; begin for Result := High(List) downto 0 do if IsEqualGUID(guid, List[Result]) then Exit; Result := -1; end; function CreateGUID(out GUID: TGUID): Integer; Function R(B: Integer) : NativeInt; Var v : NativeInt; begin v:=Random(256); While B>1 do begin v:=v*256+Random(256); Dec(B); end; Result:=V; end; Var I : Integer; begin Result:=0; GUID.D1:= R(4); GUID.D2:= R(2); GUID.D3:= R(2); For I:=0 to 7 do GUID.D4[I]:=R(1); end; { --------------------------------------------------------------------- Integer/Ordinal related ---------------------------------------------------------------------} function TryStrToInt(const S: String; out res: Integer): Boolean; Var NI : NativeInt; begin Result:=TryStrToInt(S,NI); if Result then res:=NI; end; function TryStrToInt(const S: String; out res: NativeInt): Boolean; Var Radix : Integer = 10; N : String; J : JSValue; begin N:=S; // Javascript Parseint allows 1.0 or 1E0 to be an integer, so we must check for this to get the same behaviour as FPC/Delphi. if (Pos(DecimalSeparator,N)<>0) or (Pos('.',N)<>0) then exit(False); case Copy(N,1,1) of '$': Radix:=16; '&': Radix:=8; '%': Radix:=2; end; // Check for E after we know radix if (Radix<>16) and (Pos('e',LowerCase(N))<>0) then exit(False); If Radix<>10 then Delete(N,1,1); J:=parseInt(N,Radix); Result:=Not jsIsNan(j); if Result then res:=NativeInt(J); end; function StrToIntDef(const S: String; const aDef: Integer): Integer; Var R : NativeInt; begin if TryStrToInt(S,R) then Result:=R else Result:=aDef; end; function StrToIntDef(const S: String; const aDef: NativeInt): NativeInt; Var R : NativeInt; begin if TryStrToInt(S,R) then Result:=R else Result:=aDef; end; function StrToInt(const S: String): Integer; Var R : NativeInt; begin if not TryStrToInt(S,R) then Raise EConvertError.CreateFmt(SErrInvalidInteger,[S]); Result:=R; end; function StrToNativeInt(const S: String): NativeInt; begin if not TryStrToInt(S,Result) then Raise EConvertError.CreateFmt(SErrInvalidInteger,[S]); end; function StrToInt64(const S: String): NativeLargeInt; Var N : NativeInt; begin if not TryStrToInt(S,N) then Raise EConvertError.CreateFmt(SErrInvalidInteger,[S]); Result:=N; end; function TryStrToInt64(const S: String; out res: NativeLargeInt): Boolean; Var R : nativeint; begin Result:=TryStrToInt(S,R); If Result then Res:=R; end; function StrToInt64Def(const S: String; ADefault: NativeLargeInt ): NativeLargeInt; begin if not TryStrToInt64(S,Result) then Result:=ADefault; end; function StrToQWord(const S: String): NativeLargeUInt; Var N : NativeInt; begin if (not TryStrToInt(S,N)) or (N<0) then Raise EConvertError.CreateFmt(SErrInvalidInteger,[S]); Result:=N; end; function TryStrToQWord(const S: String; out res: NativeLargeUInt): Boolean; Var R : nativeint; begin Result:=TryStrToInt(S,R) and (R>=0); If Result then Res:=R; end; function StrToQWordDef(const S: String; ADefault: NativeLargeUInt ): NativeLargeUInt; begin if Not TryStrToQword(S,Result) then Result:=ADefault; end; function StrToUInt64(const S: String): NativeLargeUInt; Var N : NativeInt; begin if (not TryStrToInt(S,N)) or (N<0) then Raise EConvertError.CreateFmt(SErrInvalidInteger,[S]); Result:=N; end; function TryStrToUInt64(const S: String; out res: NativeLargeUInt): Boolean; Var R : nativeint; begin Result:=TryStrToInt(S,R) and (R>=0); If Result then Res:=R; end; function StrToUInt64Def(const S: String; ADefault: NativeLargeUInt ): NativeLargeUInt; begin if Not TryStrToUInt64(S,Result) then Result:=ADefault; end; function TryStrToDWord(const S: String; out res: DWord): Boolean; Var R : nativeint; begin Result:=TryStrToInt(S,R) and (R>=0) and (R<=DWord($FFFFFFFF)); If Result then Res:=R; end; function StrToDWord(const S: String): DWord; begin if not TryStrToDWord(S,Result) then Raise EConvertError.CreateFmt(SErrInvalidInteger,[S]); end; function StrToDWordDef(const S: String; ADefault: DWord): DWord; begin if Not TryStrToDWord(S,Result) then Result:=ADefault; end; function IntToHex(Value: NativeInt; Digits: integer): string; begin // Result:=HexStr(Value,Digits); // TestNegLongintHelper Failed: "ToHexString" expected: but was: <00-20000> ! Result:=''; if Value<0 then asm if (Value<0) Value = 0xFFFFFFFF + Value + 1; end; asm Result=Value.toString(16); end; Result:=UpperCase(Result); while (Length(Result) 0) and not(FileName[I] in EndSep) do Dec(I); if (I = 0) or (FileName[I] <> ExtensionSeparator) then I := Length(FileName)+1 else begin SOF:=(I=1) or (FileName[i-1] in AllowDirectorySeparators); if (SOF) and not FirstDotAtFileNameStartIsExtension then I:=Length(FileName)+1; end; Result := Copy(FileName, 1, I - 1) + Extension; end; function ExtractFilePath(const FileName: PathStr): PathStr; var i : longint; EndSep : Set of Char; begin i := Length(FileName); EndSep:=AllowDirectorySeparators+AllowDriveSeparators; while (i > 0) and not CharInSet(FileName[i],EndSep) do Dec(i); If I>0 then Result := Copy(FileName, 1, i) else Result:=''; end; function ExtractFileDir(const FileName: PathStr): PathStr; var i : longint; EndSep : Set of Char; begin I := Length(FileName); EndSep:=AllowDirectorySeparators+AllowDriveSeparators; while (I > 0) and not CharInSet(FileName[I],EndSep) do Dec(I); if (I > 1) and CharInSet(FileName[I],AllowDirectorySeparators) and not CharInSet(FileName[I - 1],EndSep) then Dec(I); Result := Copy(FileName, 1, I); end; function ExtractFileDrive(const FileName: PathStr): PathStr; var i,l: longint; begin Result := ''; l:=Length(FileName); if (l<2) then exit; If CharInSet(FileName[2],AllowDriveSeparators) then result:=Copy(FileName,1,2) else if CharInSet(FileName[1],AllowDirectorySeparators) and CharInSet(FileName[2],AllowDirectorySeparators) then begin i := 2; { skip share } While (i 0) and not CharInSet(FileName[I],EndSep) do Dec(I); Result := Copy(FileName, I + 1, MaxInt); end; function ExtractFileExt(const FileName: PathStr): PathStr; var i : longint; EndSep : Set of Char; SOF : Boolean; // Dot at Start of filename ? begin Result:=''; I := Length(FileName); EndSep:=AllowDirectorySeparators+AllowDriveSeparators+[ExtensionSeparator]; while (I > 0) and not CharInSet(FileName[I],EndSep) do Dec(I); if (I > 0) and (FileName[I] = ExtensionSeparator) then begin SOF:=(I=1) or (FileName[i-1] in AllowDirectorySeparators); if (Not SOF) or FirstDotAtFileNameStartIsExtension then Result := Copy(FileName, I, MaxInt); end else Result := ''; end; function ExtractRelativepath(const BaseName, DestName: PathStr): PathStr; Var OneLevelBack,Source, Dest : PathStr; Sc,Dc,I,J : Longint; SD,DD : TPathStrArray; begin OneLevelBack := '..'+PathDelim; If Uppercase(ExtractFileDrive(BaseName))<>Uppercase(ExtractFileDrive(DestName)) Then begin Result:=DestName; exit; end; Source:=ExcludeTrailingPathDelimiter(ExtractFilePath(BaseName)); Dest:=ExcludeTrailingPathDelimiter(ExtractFilePath(DestName)); SD:=GetDirs (Source); SC:=Length(SD); DD:=GetDirs (Dest); DC:=Length(SD); I:=0; While (I'') then begin Result[L]:=D; Inc(L); end; J:=I; end; Inc(I); end; SetLength(Result,L); end; function IncludeTrailingPathDelimiter(const Path: PathStr): PathStr; Var l : Integer; begin Result:=Path; l:=Length(Result); If (L=0) or not CharInSet(Result[l],AllowDirectorySeparators) then Result:=Result+PathDelim; end; function ExcludeTrailingPathDelimiter(const Path: PathStr): PathStr; Var L : Integer; begin L:=Length(Path); If (L>0) and CharInSet(Path[L],AllowDirectorySeparators) then Dec(L); Result:=Copy(Path,1,L); end; function IncludeLeadingPathDelimiter(const Path: PathStr): PathStr; Var l : Integer; begin Result:=Path; l:=Length(Result); If (L=0) or not CharInSet(Result[1],AllowDirectorySeparators) then Result:=PathDelim+Result; end; function ExcludeLeadingPathDelimiter(const Path: PathStr): PathStr; Var L : Integer; begin Result:=Path; L:=Length(Result); If (L>0) and CharInSet(Result[1],AllowDirectorySeparators) then Delete(Result,1,1); end; function IsPathDelimiter(const Path: PathStr; Index: Integer): Boolean; begin Result:=(Index>0) and (Index<=Length(Path)) and CharInSet(Path[Index],AllowDirectorySeparators); end; function ConcatPaths(const Paths: array of PathStr): PathStr; var I: Integer; begin if Length(Paths) > 0 then begin Result := Paths[0]; for I := 1 to Length(Paths) - 1 do Result := IncludeTrailingPathDelimiter(Result) + ExcludeLeadingPathDelimiter(Paths[I]); end else Result := ''; end; Function EncodeHTMLEntities (S : String) : String; begin Result:=''; if S='' then exit; asm return S.replace(/[\u00A0-\u9999<>\&]/gim, function(i) { return '&#'+i.charCodeAt(0)+';'; }); end; end; { --------------------------------------------------------------------- Type helpers implementation ---------------------------------------------------------------------} { --------------------------------------------------------------------- TGUIDHelper ---------------------------------------------------------------------} Procedure NotImplemented(S : String); begin Raise Exception.Create('Not yet implemented : '+S); end; class function TGuidHelper.Create(Src: TGUID; BigEndian: Boolean): TGUID; begin Result:=Src; if Not Bigendian then begin Result.D1:=SwapEndian(Result.D1); Result.D2:=SwapEndian(Result.D2); Result.D3:=SwapEndian(Result.D3); end; end; class function TGuidHelper.Create(const Buf: TJSArrayBuffer; AStartIndex: Cardinal; BigEndian: Boolean): TGUID; Var A : Cardinal; B,C : Word; V : TJSDataView; begin V:=TJSDataView.New(Buf); // The get functions return by default correct endianness. if BigEndian then begin A:=V.getUint32(aStartIndex); B:=V.getUint16(AStartIndex+4); C:=V.getUint16(AStartIndex+6); end else begin A:=SwapEndian(V.getUint32(aStartIndex)); B:=SwapEndian(V.getUint16(AStartIndex+4)); C:=SwapEndian(V.getUint16(AStartIndex+6)); end; Result:=Create(A,B,C,V.GetUint8(AStartIndex+8),V.GetUint8(AStartIndex+9),V.GetUint8(AStartIndex+10),V.GetUint8(AStartIndex+11),V.GetUint8(AStartIndex+12),V.GetUint8(AStartIndex+13),V.GetUint8(AStartIndex+14),V.GetUint8(AStartIndex+15)); end; class function TGuidHelper.Create(const Data: array of Byte; AStartIndex: Cardinal; BigEndian: Boolean): TGUID; Var D : TJSUint8Array; begin if ((System.Length(Data)-AStartIndex)<16) then raise EArgumentException.CreateFmt('The length of a GUID array must be at least %d',[]); D:=TJSUint8Array.From(Data); Result:=Create(D.buffer,aStartIndex,BigEndian); end; class function TGuidHelper.Create(const B: TBytes; DataEndian: TEndian): TGUID; begin Result:=Create(B,0,DataEndian); end; class function TGuidHelper.Create(const B: TBytes; AStartIndex: Cardinal; DataEndian: TEndian): TGUID; begin if ((System.Length(B)-AStartIndex)<16) then raise EArgumentException.CreateFmt('The length of a GUID array must be at least %d',[]); Result:=Create(B,AStartIndex,DataEndian=TEndian.Big); end; class function TGuidHelper.Create(const S: string): TGUID; begin Result:=StringToGUID(S); end; class function TGuidHelper.Create(A: Integer; B: SmallInt; C: SmallInt; const D: TBytes): TGUID; begin if (System.Length(D)<>8) then raise EArgumentException.CreateFmt('The length of a GUID array must be %d',[]); Result:=Create(Cardinal(A),Word(B),Word(C),D[0],D[1],D[2],D[3],D[4],D[5],D[6],D[7]); end; (* class function TGuidHelper.Create(A: Integer; B: SmallInt; C: SmallInt; D, E, F, G, H, I, J, K: Byte): TGUID; begin Result:=Create(Cardinal(A),Word(B),Word(C),D,E,F,G,H,I,J,K); end; *) class function TGuidHelper.Create(A: Cardinal; B: Word; C: Word; D, E, F, G, H, I, J, K: Byte): TGUID; begin Result.D1 := Cardinal(A); Result.D2 := Word(B); Result.D3 := Word(C); Result.D4[0] := D; Result.D4[1] := E; Result.D4[2] := F; Result.D4[3] := G; Result.D4[4] := H; Result.D4[5] := I; Result.D4[6] := J; Result.D4[7] := K; end; class function TGuidHelper.NewGuid: TGUID; begin CreateGUID(Result) end; function TGuidHelper.ToByteArray(DataEndian: TEndian): TBytes; Var D : TJSUint8Array; V : TJSDataView; I : Integer; begin D:=TJSUint8array.New(16); V:=TJSDataView.New(D.buffer); V.setUint32(0,D1,DataEndian=TEndian.Little); V.setUint16(4,D2,DataEndian=TEndian.Little); V.setUint16(6,D3,DataEndian=TEndian.Little); for I:=0 to 7 do V.setUint8(8+I,D4[i]); SetLength(Result, 16); for I:=0 to 15 do Result[i]:=V.getUint8(I); end; function TGuidHelper.ToString(SkipBrackets: Boolean): string; begin Result:=GuidToString(Self); If SkipBrackets then Result:=Copy(Result,2,Length(Result)-2); end; { --------------------------------------------------------------------- TStringHelper ---------------------------------------------------------------------} Function HaveChar(AChar : Char; const AList: array of Char) : Boolean; Var I : SizeInt; begin I:=0; Result:=False; While (Not Result) and (ISystem.Length(A) then L:=System.Length(A); Result:=CompareOrdinal(A,0,B,0,L); end; class function TStringHelper.CompareOrdinal(const A: string; IndexA: SizeInt; const B: string; IndexB: SizeInt; ALen: SizeInt): Integer; Var I,M : integer; begin M:=System.Length(A)-IndexA; If M>(System.Length(B)-IndexB) then M:=(System.Length(B)-IndexB); if M>aLen then M:=aLen; I:=0; Result:=0; While (Result=0) and (I'') and (sysutils.CompareText(System.Copy(AText,System.Length(AText)-System.Length(ASubText)+1,System.Length(ASubText)),ASubText)=0); end; class function TStringHelper.Equals(const a: string; const b: string): Boolean; begin Result:=A=B; end; class function TStringHelper.Format(const AFormat: string; const args: array of JSValue): string; begin Result:=Sysutils.Format(AFormat,Args); end; class function TStringHelper.IsNullOrEmpty(const AValue: string): Boolean; begin Result:=system.Length(AValue)=0; end; class function TStringHelper.IsNullOrWhiteSpace(const AValue: string): Boolean; begin Result:=system.Length(sysutils.Trim(AValue))=0; end; class function TStringHelper.Join(const Separator: string; const Values: array of JSValue): string; begin Result:=TJSArray(Values).Join(Separator); end; class function TStringHelper.Join(const Separator: string; const Values: array of string): string; begin Result:=TJSArray(Values).Join(Separator); end; class function TStringHelper.Join(const Separator: string; const Values: array of string; StartIndex: SizeInt; ACount: SizeInt): string; Var VLen : SizeInt; begin VLen:=High(Values); If (ACount<0) or ((StartIndex>0) and (StartIndex>VLen)) then raise ERangeError.Create(SRangeError); If (ACount=0) or (VLen<0) then Result:='' else Result:=TJSArray(Values).Slice(StartIndex,StartIndex+aCount).Join(Separator); end; class function TStringHelper.LowerCase(const S: string): string; begin Result:=sysutils.Lowercase(S); end; class function TStringHelper.Parse(const AValue: Boolean): string; begin Result:=BoolToStr(AValue); end; class function TStringHelper.Parse(const AValue: Extended): string; begin Result:=FloatToStr(AValue); end; class function TStringHelper.Parse(const AValue: NativeInt): string; begin Result:=IntToStr(AValue); end; class function TStringHelper.Parse(const AValue: Integer): string; begin Result:=IntToStr(AValue); end; class function TStringHelper.ToBoolean(const S: string): Boolean; begin Result:=StrToBool(S); end; class function TStringHelper.ToDouble(const S: string): Double; begin Result:=StrToFloat(S); end; class function TStringHelper.ToExtended(const S: string): Extended; begin Result:=StrToFloat(S); end; class function TStringHelper.ToNativeInt(const S: string): NativeInt; begin Result:=StrToInt64(S); end; class function TStringHelper.ToInteger(const S: string): Integer; begin Result:=StrToInt(S); end; class function TStringHelper.UpperCase(const S: string): string; begin Result:=sysutils.Uppercase(S); end; class function TStringHelper.ToCharArray(const S: String): TCharArray; Var I,Len: integer; begin Len:=System.Length(S); SetLength(Result,Len); For I:=1 to Len do Result[I-1]:=S[I]; end; function TStringHelper.CompareTo(const B: string): Integer; begin // Order is important Result:=Compare(Self,B); end; function TStringHelper.Contains(const AValue: string): Boolean; begin Result:=(AValue<>'') and (Pos(AValue,Self)>0); end; function TStringHelper.CountChar(const C: Char): SizeInt; Var S : Char; begin Result:=0; For S in Self do if (S=C) then Inc(Result); end; function TStringHelper.DeQuotedString: string; begin Result:=DeQuotedString(''''); end; function TStringHelper.DeQuotedString(const AQuoteChar: Char): string; var L,I : SizeInt; Res : Array of Char; PS,PD : SizeInt; IsQuote : Boolean; begin L:=System.Length(Self); if (L<2) or Not ((Self[1]=AQuoteChar) and (Self[L]=AQuoteChar)) then Exit(Self); SetLength(Res,L); IsQuote:=False; PS:=2; PD:=1; For I:=2 to L-1 do begin if (Self[PS]=AQuoteChar) then begin IsQuote:=Not IsQuote; if Not IsQuote then begin Result[PD]:=Self[PS]; Inc(PD); end; end else begin if IsQuote then IsQuote:=false; Result[PD]:=Self[PS]; Inc(PD); end; Inc(PS); end; SetLength(Result,PD-1); end; function TStringHelper.EndsWith(const AValue: string): Boolean; begin Result:=EndsWith(AValue,False); end; function TStringHelper.EndsWith(const AValue: string; IgnoreCase: Boolean): Boolean; Var L : SizeInt; S : String; begin L:=system.Length(AVAlue); Result:=L=0; if Not Result then begin S:=system.Copy(Self,Length-L+1,L); Result:=system.Length(S)=L; if Result then if IgnoreCase then Result:=CompareText(S,AValue)=0 else Result:=S=AValue; end; end; function TStringHelper.Equals(const AValue: string): Boolean; begin Result:=(Self=AValue); end; function TStringHelper.Format(const args: array of jsValue): string; begin Result:=Sysutils.Format(Self,Args); end; function TStringHelper.GetHashCode: Integer; // Taken from contnrs, fphash var P,pmax : Integer; L : TJSString; begin {$push} {$Q-} L:=TJSString(Self); Result:=0; P:=1; pmax:=length+1; while (p-1 then Result:=Result+StartIndex; end; function TStringHelper.IndexOf(const AValue: string; StartIndex: SizeInt; ACount: SizeInt): SizeInt; Var S : String; begin S:=System.Copy(Self,StartIndex+1,ACount); Result:=Pos(AValue,S)-1; if Result<>-1 then Result:=Result+StartIndex; end; function TStringHelper.IndexOfUnQuoted(const AValue: string; StartQuote, EndQuote: Char; StartIndex: SizeInt = 0): SizeInt; Var LV : SizeInt; S : String; Function MatchAt(I : SizeInt) : Boolean ; Inline; Var J : SizeInt; begin J:=1; Repeat Result:=(S[I+J-1]=AValue[j]); Inc(J); Until (Not Result) or (J>LV); end; Var I,L,Q: SizeInt; begin S:=Self; Result:=-1; LV:=system.Length(AValue); L:=Length-LV+1; if L<0 then L:=0; I:=StartIndex+1; Q:=0; if StartQuote=EndQuote then begin While (Result=-1) and (I<=L) do begin if (S[I]=StartQuote) then Q:=1-Q; if (Q=0) and MatchAt(i) then Result:=I-1; Inc(I); end; end else begin While (Result=-1) and (I<=L) do begin if S[I]=StartQuote then Inc(Q) else if (S[I]=EndQuote) and (Q>0) then Dec(Q); if (Q=0) and MatchAt(i) then Result:=I-1; Inc(I); end; end; end; function TStringHelper.IndexOfAny(const AnyOf: string): SizeInt; begin Result:=IndexOfAny(AnyOf.ToCharArray); end; function TStringHelper.IndexOfAny(const AnyOf: array of Char): SizeInt; begin Result:=IndexOfAny(AnyOf,0,Length); end; function TStringHelper.IndexOfAny(const AnyOf: String; StartIndex: SizeInt): SizeInt; begin Result:=IndexOfAny(AnyOf.ToCharArray,StartIndex); end; function TStringHelper.IndexOfAny(const AnyOf: array of Char; StartIndex: SizeInt): SizeInt; begin Result:=IndexOfAny(AnyOf,StartIndex,Length); end; function TStringHelper.IndexOfAny(const AnyOf: String; StartIndex: SizeInt; ACount: SizeInt): SizeInt; begin Result:=IndexOfAny(AnyOf.ToCharArray,StartIndex,aCount); end; function TStringHelper.IndexOfAny(const AnyOf: array of Char; StartIndex: SizeInt; ACount: SizeInt): SizeInt; Var i,L : SizeInt; begin I:=StartIndex+1; L:=I+ACount-1; If L>Length then L:=Length; Result:=-1; While (Result=-1) and (I<=L) do begin if HaveChar(Self[i],AnyOf) then Result:=I-1; Inc(I); end; end; function TStringHelper.IndexOfAny(const AnyOf: array of String): SizeInt; begin Result:=IndexOfAny(AnyOf,0,Length); end; function TStringHelper.IndexOfAny(const AnyOf: array of String; StartIndex: SizeInt): SizeInt; begin Result:=IndexOfAny(AnyOf,StartIndex,Length-StartIndex); end; function TStringHelper.IndexOfAny(const AnyOf: array of String; StartIndex: SizeInt; ACount: SizeInt): SizeInt; Var M : SizeInt; begin Result:=IndexOfAny(AnyOf,StartIndex,ACount,M); end; function TStringHelper.IndexOfAny(const AnyOf: array of String; StartIndex: SizeInt; ACount: SizeInt; out AMatch: SizeInt): SizeInt; Var L,I : SizeInt; begin Result:=-1; For I:=0 to System.Length(AnyOf)-1 do begin L:=IndexOf(AnyOf[i],StartIndex,ACount); If (L>=0) and ((Result=-1) or (LLength then L:=Length; I:=StartIndex+1; Q:=0; if StartQuote=EndQuote then begin While (Result=-1) and (I<=L) do begin if (Self[I]=StartQuote) then Q:=1-Q; if (Q=0) and HaveChar(Self[i],AnyOf) then Result:=I-1; Inc(I); end; end else begin While (Result=-1) and (I<=L) do begin if Self[I]=StartQuote then Inc(Q) else if (Self[I]=EndQuote) and (Q>0) then Dec(Q); if (Q=0) and HaveChar(Self[i],AnyOf) then Result:=I-1; Inc(I); end; end; end; function TStringHelper.IndexOfAnyUnquoted(const AnyOf: array of string; StartQuote, EndQuote: Char; StartIndex: SizeInt; out Matched: SizeInt ): SizeInt; Var L,I : SizeInt; begin Result:=-1; For I:=0 to System.Length(AnyOf)-1 do begin L:=IndexOfUnquoted(AnyOf[i],StartQuote,EndQuote,StartIndex); If (L>=0) and ((Result=-1) or (L=Min) and (Self[Result]<>AValue) do Dec(Result); if ResultaCount then Result:=-1; end; function TStringHelper.LastIndexOfAny(const AnyOf: array of Char): SizeInt; begin Result:=LastIndexOfAny(AnyOf,Length-1,Length); end; function TStringHelper.LastIndexOfAny(const AnyOf: array of Char; AStartIndex: SizeInt): SizeInt; begin Result:=LastIndexOfAny(AnyOf,AStartIndex,Length); end; function TStringHelper.LastIndexOfAny(const AnyOf: array of Char; AStartIndex: SizeInt; ACount: SizeInt): SizeInt; Var Min : SizeInt; begin Result:=AStartIndex+1; Min:=Result-ACount+1; If Min<1 then Min:=1; While (Result>=Min) and Not HaveChar(Self[Result],AnyOf) do Dec(Result); if Result0 then Result:=StringOfChar(PaddingChar,L)+Result; end; function TStringHelper.PadRight(ATotalWidth: SizeInt): string; begin Result:=PadRight(ATotalWidth,' '); end; function TStringHelper.PadRight(ATotalWidth: SizeInt; PaddingChar: Char ): string; Var L : SizeInt; begin Result:=Self; L:=ATotalWidth-Length; If L>0 then Result:=Result+StringOfChar(PaddingChar,L); end; function TStringHelper.QuotedString: string; begin Result:=QuotedStr(Self); end; function TStringHelper.QuotedString(const AQuoteChar: Char): string; begin Result:=QuotedStr(Self,AQuoteChar); end; function TStringHelper.Remove(StartIndex: SizeInt): string; begin Result:=Remove(StartIndex,Self.Length-StartIndex); end; function TStringHelper.Remove(StartIndex: SizeInt; ACount: SizeInt): string; begin Result:=Self; System.Delete(Result,StartIndex+1,ACount); end; function TStringHelper.Replace(OldChar: Char; NewChar: Char): string; begin Result:=Replace(OldChar,NewChar,[rfReplaceAll]); end; function TStringHelper.Replace(OldChar: Char; NewChar: Char; ReplaceFlags: TReplaceFlags): string; begin Result:=StringReplace(Self,OldChar,NewChar,ReplaceFlags); end; function TStringHelper.Replace(const OldValue: string; const NewValue: string ): string; begin Result:=Replace(OldValue,NewValue,[rfReplaceAll]); end; function TStringHelper.Replace(const OldValue: string; const NewValue: string; ReplaceFlags: TReplaceFlags): string; begin Result:=StringReplace(Self,OldValue,NewValue,ReplaceFlags); end; function TStringHelper.Split(const Separators: String): TStringArray; begin Result:=Split(Separators.ToCharArray); end; function TStringHelper.Split(const Separators: array of Char): TStringArray; begin Result:=Split(Separators,#0,#0,Length+1,TStringSplitOptions.None); end; function TStringHelper.Split(const Separators: string; ACount: SizeInt): TStringArray; begin Result:=Split(Separators.ToCharArray,aCount); end; function TStringHelper.Split(const Separators: array of Char; ACount: SizeInt ): TStringArray; begin Result:=Split(Separators,#0,#0,ACount,TStringSplitOptions.None); end; function TStringHelper.Split(const Separators: string; Options: TStringSplitOptions): TStringArray; begin Result:=Split(Separators.ToCharArray,Options); end; function TStringHelper.Split(const Separators: array of Char; Options: TStringSplitOptions): TStringArray; begin Result:=Split(Separators,Length+1,Options); end; function TStringHelper.Split(const Separators: string; ACount: SizeInt; Options: TStringSplitOptions): TStringArray; begin Result:=Split(Separators.ToCharArray,aCount,Options); end; function TStringHelper.Split(const Separators: array of Char; ACount: SizeInt; Options: TStringSplitOptions): TStringArray; begin Result:=Split(Separators,#0,#0,ACount,Options); end; function TStringHelper.Split(const Separators: array of string): TStringArray; begin Result:=Split(Separators,Length+1); end; function TStringHelper.Split(const Separators: array of string; ACount: SizeInt ): TStringArray; begin Result:=Split(Separators,ACount,TStringSplitOptions.None); end; function TStringHelper.Split(const Separators: array of string; Options: TStringSplitOptions): TStringArray; begin Result:=Split(Separators,Length+1,Options); end; function TStringHelper.Split(const Separators: array of string; ACount: SizeInt; Options: TStringSplitOptions): TStringArray; begin Result:=Split(Separators,#0,#0,ACount,Options); end; function TStringHelper.Split(const Separators: String; AQuote: Char): TStringArray; begin Result:=Split(Separators.ToCharArray,aQuote); end; function TStringHelper.Split(const Separators: array of Char; AQuote: Char ): TStringArray; begin Result:=Split(Separators,AQuote,AQuote); end; function TStringHelper.Split(const Separators: String; AQuoteStart, AQuoteEnd: Char): TStringArray; begin Result:=Split(Separators.ToCharArray,aQuoteStart,aQuoteEnd); end; function TStringHelper.Split(const Separators: array of Char; AQuoteStart, AQuoteEnd: Char): TStringArray; begin Result:=Split(Separators,AQuoteStart,AQuoteEnd,TStringSplitOptions.None); end; function TStringHelper.Split(const Separators: string; AQuoteStart, AQuoteEnd: Char; Options: TStringSplitOptions): TStringArray; begin Result:=Split(Separators.ToCharArray,aQuoteStart,aQuoteEnd,Options); end; function TStringHelper.Split(const Separators: array of Char; AQuoteStart, AQuoteEnd: Char; Options: TStringSplitOptions): TStringArray; begin Result:=Split(Separators,AQuoteStart,AQuoteEnd,Length+1,Options); end; function TStringHelper.Split(const Separators: string; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt): TStringArray; begin Result:=Split(Separators.ToCharArray,aQuoteStart,aQuoteEnd,aCount); end; function TStringHelper.Split(const Separators: array of Char; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt): TStringArray; begin Result:=Split(Separators,AQuoteStart,AQuoteEnd,ACount,TStringSplitOptions.None); end; function TStringHelper.Split(const Separators: string; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt; Options: TStringSplitOptions ): TStringArray; begin Result:=Split(Separators.ToCharArray,aQuoteStart,aQuoteEnd,aCount,Options); end; function TStringHelper.Split(const Separators: array of Char; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt; Options: TStringSplitOptions): TStringArray; Const BlockSize = 10; Var S : String; Function NextSep(StartIndex : SizeInt) : SizeInt; begin if (AQuoteStart<>#0) then Result:=S.IndexOfAnyUnQuoted(Separators,AQuoteStart,AQuoteEnd,StartIndex) else Result:=S.IndexOfAny(Separators,StartIndex); end; Procedure MaybeGrow(Curlen : SizeInt); begin if System.Length(Result)<=CurLen then SetLength(Result,System.Length(Result)+BlockSize); end; Var Sep,LastSep,Len : SizeInt; T : String; begin S:=Self; SetLength(Result,BlockSize); Len:=0; LastSep:=0; Sep:=NextSep(0); While (Sep<>-1) and ((ACount=0) or (Len',T,'< at pos ',LastSep,', till pos ',Sep); If (T<>'') or (not (TStringSplitOptions.ExcludeEmpty=Options)) then begin MaybeGrow(Len); Result[Len]:=T; Inc(Len); end; LastSep:=Sep+1; Sep:=NextSep(LastSep); end; if (LastSep<=Length) and ((ACount=0) or (Len',T,'< at pos,',LastSep,' till pos ',Sep); If (T<>'') or (not (TStringSplitOptions.ExcludeEmpty=Options)) then begin MaybeGrow(Len); Result[Len]:=T; Inc(Len); end; end; SetLength(Result,Len); end; function TStringHelper.Split(const Separators: array of string; AQuote: Char ): TStringArray; begin Result:=SPlit(Separators,AQuote,AQuote); end; function TStringHelper.Split(const Separators: array of string; AQuoteStart, AQuoteEnd: Char): TStringArray; begin Result:=SPlit(Separators,AQuoteStart,AQuoteEnd,Length+1,TStringSplitOptions.None); end; function TStringHelper.Split(const Separators: array of string; AQuoteStart, AQuoteEnd: Char; Options: TStringSplitOptions): TStringArray; begin Result:=SPlit(Separators,AQuoteStart,AQuoteEnd,Length+1,Options); end; function TStringHelper.Split(const Separators: array of string; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt): TStringArray; begin Result:=SPlit(Separators,AQuoteStart,AQuoteEnd,ACount,TStringSplitOptions.None); end; function TStringHelper.Split(const Separators: array of string; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt; Options: TStringSplitOptions): TStringArray; Const BlockSize = 10; Var S : String; Function NextSep(StartIndex : SizeInt; out Match : SizeInt) : SizeInt; begin if (AQuoteStart<>#0) then Result:=S.IndexOfAnyUnQuoted(Separators,AQuoteStart,AQuoteEnd,StartIndex,Match) else Result:=S.IndexOfAny(Separators,StartIndex,Length,Match); end; Procedure MaybeGrow(Curlen : SizeInt); begin if System.Length(Result)<=CurLen then SetLength(Result,System.Length(Result)+BlockSize); end; Var Sep,LastSep,Len,Match : SizeInt; T : String; begin S:=Self; SetLength(Result,BlockSize); Len:=0; LastSep:=0; Sep:=NextSep(0,Match); While (Sep<>-1) and ((ACount=0) or (Len'') or (not (TStringSplitOptions.ExcludeEmpty=Options)) then begin MaybeGrow(Len); Result[Len]:=T; Inc(Len); end; LastSep:=Sep+System.Length(Separators[Match]); Sep:=NextSep(LastSep,Match); end; if (LastSep<=Length) and ((ACount=0) or (Len',T,'< at pos,',LastSep,' till pos ',Sep); If (T<>'') or (not (TStringSplitOptions.ExcludeEmpty=Options)) then begin MaybeGrow(Len); Result[Len]:=T; Inc(Len); end; end; SetLength(Result,Len); end; function TStringHelper.StartsWith(const AValue: string): Boolean; begin Result:=StartsWith(AValue,False); end; function TStringHelper.StartsWith(const AValue: string; IgnoreCase: Boolean ): Boolean; Var L : SizeInt; S : String; begin L:=System.Length(AValue); Result:=L<=0; if not Result then begin S:=System.Copy(Self,1,L); Result:=(System.Length(S)=L); if Result then if IgnoreCase then Result:=SameText(S,aValue) else Result:=SameStr(S,AValue); end; end; function TStringHelper.Substring(AStartIndex: SizeInt): string; begin Result:=Self.SubString(AStartIndex,Self.Length-AStartIndex); end; function TStringHelper.Substring(AStartIndex: SizeInt; ALen: SizeInt): string; begin Result:=system.Copy(Self,AStartIndex+1,ALen); end; function TStringHelper.ToBoolean: Boolean; begin Result:=StrToBool(Self); end; function TStringHelper.ToInteger: Integer; begin Result:=StrToInt(Self); end; function TStringHelper.ToNativeInt: NativeInt; begin Result:=StrToNativeInt(Self); end; function TStringHelper.ToDouble: Double; begin Result:=StrToFLoat(Self); end; function TStringHelper.ToExtended: Extended; begin Result:=StrToFLoat(Self); end; function TStringHelper.ToCharArray: TCharArray; begin Result:=ToCharArray(0,Self.Length); end; function TStringHelper.ToCharArray(AStartIndex: SizeInt; ALen: SizeInt ): TCharArray; Var I : SizeInt; begin SetLength(Result,ALen); For I:=0 to ALen-1 do Result[I]:=Self[AStartIndex+I+1]; end; function TStringHelper.ToLower: string; begin Result:=LowerCase(Self); end; function TStringHelper.ToLowerInvariant: string; begin Result:=LowerCase(Self); end; function TStringHelper.ToUpper: string; begin Result:=UpperCase(Self); end; function TStringHelper.ToUpperInvariant: string; begin Result:=UpperCase(Self); end; function TStringHelper.Trim: string; begin Result:=SysUtils.Trim(self); end; function TStringHelper.TrimLeft: string; begin Result:=SysUtils.TrimLeft(Self); end; function TStringHelper.TrimRight: string; begin Result:=SysUtils.TrimRight(Self); end; function TStringHelper.Trim(const ATrimChars: array of Char): string; begin Result:=Self.TrimLeft(ATrimChars).TrimRight(ATrimChars); end; function TStringHelper.TrimLeft(const ATrimChars: array of Char): string; Var I,Len : SizeInt; begin I:=1; Len:=Self.Length; While (I<=Len) and HaveChar(Self[i],ATrimChars) do Inc(I); if I=1 then Result:=Self else if I>Len then Result:='' else Result:=system.Copy(Self,I,Len-I+1); end; function TStringHelper.TrimRight(const ATrimChars: array of Char): string; Var I,Len : SizeInt; begin Len:=Self.Length; I:=Len; While (I>=1) and HaveChar(Self[i],ATrimChars) do Dec(I); if I<1 then Result:='' else if I=Len then Result:=Self else Result:=system.Copy(Self,1,I); end; function TStringHelper.TrimEnd(const ATrimChars: array of Char): string; begin Result:=TrimRight(ATrimChars); end; function TStringHelper.TrimStart(const ATrimChars: array of Char): string; begin Result:=TrimLeft(ATrimChars); end; { --------------------------------------------------------------------- TDoubleHelper ---------------------------------------------------------------------} Class Function TDoubleHelper.IsNan(const AValue: Double): Boolean; overload; inline; begin Result:=JS.jsIsNaN(AValue); end; Class Function TDoubleHelper.IsInfinity(const AValue: Double): Boolean; overload; inline; begin Result:=Not jsIsFinite(aValue); end; Class Function TDoubleHelper.IsNegativeInfinity(const AValue: Double): Boolean; overload; inline; begin asm return (AValue=Number.NEGATIVE_INFINITY); end; Result:=aValue=0; // Fool compiler end; Class Function TDoubleHelper.IsPositiveInfinity(const AValue: Double): Boolean; overload; inline; begin asm return (AValue=Number.POSITIVE_INFINITY); end; Result:=aValue=0; // Fool compiler. end; Class Function TDoubleHelper.Parse(const AString: string): Double; overload; inline; begin Result:=StrToFloat(AString); end; Class Function TDoubleHelper.ToString(const AValue: Double): string; overload; inline; begin Result:=FloatToStr(AValue); end; Class Function TDoubleHelper.ToString(const AValue: Double; const AFormat: TFloatFormat; const APrecision, ADigits: Integer): string; overload; inline; begin Result:=FloatToStrF(AValue,AFormat,APrecision,ADigits); end; Class Function TDoubleHelper.TryParse(const AString: string; out AValue: Double): Boolean; overload; inline; begin Result:=TryStrToFloat(AString,AValue); end; Function TDoubleHelper.GetB(AIndex: Cardinal): Byte; var F : TJSFloat64Array; B : TJSUInt8array; begin F:=TJSFloat64Array.New(1); B:=TJSUInt8array.New(F.Buffer); F[0]:=Self; Result:=B[AIndex]; end; Function TDoubleHelper.GetW(AIndex: Cardinal): Word; var F : TJSFloat64Array; W : TJSUInt16array; begin F:=TJSFloat64Array.New(1); W:=TJSUInt16array.New(F.Buffer); F[0]:=Self; Result:=W[AIndex]; end; Type TFloatParts = Record sign : boolean; exp : integer; mantissa : double; end; // See https://stackoverflow.com/questions/9383593/extracting-the-exponent-and-mantissa-of-a-javascript-number Function FloatToParts(aValue : Double) : TFloatParts; var F : TJSFloat64Array; B : TJSUInt8array; begin F:=TJSFloat64Array.New(1); B:=TJSUInt8array.New(F.Buffer); F[0]:=aValue; Result.Sign:=(B[7] shr 7)=0; Result.exp:=(((B[7] and $7f) shl 4) or (B[6] shr 4))- $3ff; B[3]:=$3F; B[6]:=B[6] or $F0; Result.Mantissa:=F[0]; end; Function TDoubleHelper.GetE: NativeUInt; inline; begin Result:=FloatToParts(Self).Exp; end; Function TDoubleHelper.GetF: NativeUInt; inline; begin Result:=0; NotImplemented('GetF'); end; Function TDoubleHelper.GetS: Boolean; inline; begin Result:=FloatToParts(Self).Sign; end; procedure TDoubleHelper.SetB(AIndex: Cardinal; const AValue: Byte); var F : TJSFloat64Array; B : TJSUInt8array; begin if (AIndex>=8) then raise ERangeError.Create(SRangeError); F:=TJSFloat64Array.New(1); B:=TJSUInt8array.New(F.Buffer); F[0]:=Self; B[AIndex]:=aValue; Self:=F[0]; end; procedure TDoubleHelper.SetW(AIndex: Cardinal; const AValue: Word); Var F : TJSFloat64Array; W : TJSUInt16array; begin if (AIndex>=4) then raise ERangeError.Create(SRangeError); F:=TJSFloat64Array.New(1); W:=TJSUInt16array.New(F.Buffer); F[0]:=Self; W[AIndex]:=aValue; Self:=F[0]; end; procedure TDoubleHelper.SetS(AValue: Boolean); Var F : TJSFloat64Array; B : TJSUInt8array; begin F:=TJSFloat64Array.New(1); B:=TJSUInt8array.New(F.Buffer); F[0]:=Self; if aValue then B[7]:=B[7] or (1 shr 7) else B[7]:=B[7] and not (1 shr 7); Self:=F[0]; end; Procedure TDoubleHelper.BuildUp(const ASignFlag: Boolean; const AMantissa: NativeUInt; const AExponent: Integer); begin NotImplemented('BuildUp'); // Following statement is just to fool the compiler if ASignFlag and (AMantissa>0) and (AExponent<0) then exit; // TFloatRec(Self).BuildUp(ASignFlag, AMantissa, AExponent); end; Function TDoubleHelper.Exponent: Integer; begin Result:=FloatToParts(Self).Exp; end; Function TDoubleHelper.Fraction: Extended; begin Result:=system.Frac(Self); end; Function TDoubleHelper.IsInfinity: Boolean; overload; inline; begin Result:=Double.IsInfinity(Self); end; Function TDoubleHelper.IsNan: Boolean; overload; inline; begin Result:=Double.IsNan(Self); end; Function TDoubleHelper.IsNegativeInfinity: Boolean; overload; inline; begin Result:=Double.IsNegativeInfinity(Self); end; Function TDoubleHelper.IsPositiveInfinity: Boolean; overload; inline; begin Result:=Double.IsPositiveInfinity(Self); end; Function TDoubleHelper.Mantissa: NativeUInt; begin Result:=Trunc(FloatToParts(Self).mantissa); end; Function TDoubleHelper.ToString(const AFormat: TFloatFormat; const APrecision, ADigits: Integer): string; overload; inline; begin Result:=FloatToStrF(Self,AFormat,APrecision,ADigits); end; Function TDoubleHelper.ToString: string; overload; inline; begin Result:=FloatToStr(Self); end; { --------------------------------------------------------------------- TByteHelper ---------------------------------------------------------------------} Class Function TByteHelper.Parse(const AString: string): Byte; inline; begin Result:=StrToInt(AString); end; Class Function TByteHelper.Size: Integer; inline; begin Result:=1; end; Class Function TByteHelper.ToString(const AValue: Byte): string; overload; inline; begin Result:=IntToStr(AValue); end; Class Function TByteHelper.TryParse(const AString: string; out AValue: Byte): Boolean; inline; Var C : Integer; begin Val(AString,AValue,C); Result:=(C=0); end; Function TByteHelper.ToBoolean: Boolean; inline; begin Result:=(Self<>0); end; Function TByteHelper.ToDouble: Double; inline; begin Result:=Self; end; Function TByteHelper.ToExtended: Extended; inline; begin Result:=Self; end; Function TByteHelper.ToBinString: string; inline; begin Result:=BinStr(Self,Size*8); end; Function TByteHelper.ToHexString(const AMinDigits: Integer): string; overload; inline; begin Result:=IntToHex(Self,AMinDigits); end; Function TByteHelper.ToHexString: string; overload; inline; begin Result:=IntToHex(Self,Size*2); end; Function TByteHelper.ToString: string; overload; inline; begin Result:=IntToStr(Self); end; Function TByteHelper.SetBit(const index: TByteBitIndex) : Byte; inline; begin Self := Self or (Byte(1) shl index); Result:=Self; end; Function TByteHelper.ClearBit(const index: TByteBitIndex) : Byte; inline; begin Self:=Self and not Byte((Byte(1) shl index)); Result:=Self; end; Function TByteHelper.ToggleBit(const index: TByteBitIndex) : Byte; inline; begin Self := Self xor Byte((Byte(1) shl index)); Result:=Self; end; Function TByteHelper.TestBit(const Index: TByteBitIndex):Boolean; inline; begin Result := (Self and Byte((Byte(1) shl index)))<>0; end; { --------------------------------------------------------------------- TShortintHelper ---------------------------------------------------------------------} Class Function TShortIntHelper.Parse(const AString: string): ShortInt; inline; begin Result:=StrToInt(AString); end; Class Function TShortIntHelper.Size: Integer; inline; begin Result:=1; end; Class Function TShortIntHelper.ToString(const AValue: ShortInt): string; overload; inline; begin Result:=IntToStr(AValue); end; Class Function TShortIntHelper.TryParse(const AString: string; out AValue: ShortInt): Boolean; inline; Var C : Integer; begin Val(AString,AValue,C); Result:=(C=0); end; Function TShortIntHelper.ToBoolean: Boolean; inline; begin Result:=(Self<>0); end; Function TShortIntHelper.ToDouble: Double; inline; begin Result:=Self; end; Function TShortIntHelper.ToExtended: Extended; inline; begin Result:=Self; end; Function TShortIntHelper.ToBinString: string; inline; begin Result:=BinStr(Self,Size*8); end; Function TShortIntHelper.ToHexString(const AMinDigits: Integer): string; overload; inline; Var B : Word; U : TJSUInt8Array; S : TJSInt8array; begin if Self>=0 then B:=Self else begin S:=TJSInt8Array.New(1); S[0]:=Self; U:=TJSUInt8Array.New(S); B:=U[0]; if AMinDigits>2 then B:=$FF00+B; end; Result:=IntToHex(B,AMinDigits); end; Function TShortIntHelper.ToHexString: string; overload; inline; begin Result:=ToHexString(Size*2); end; Function TShortIntHelper.ToString: string; overload; inline; begin Result:=IntToStr(Self); end; Function TShortIntHelper.SetBit(const index: TShortIntBitIndex) : ShortInt; inline; begin Self := Self or (ShortInt(1) shl index); Result:=Self; end; Function TShortIntHelper.ClearBit(const index: TShortIntBitIndex) : ShortInt; inline; begin Self:=Self and not ShortInt((ShortInt(1) shl index)); Result:=Self; end; Function TShortIntHelper.ToggleBit(const index: TShortIntBitIndex) : ShortInt; inline; begin Self := Self xor ShortInt((ShortInt(1) shl index)); Result:=Self; end; Function TShortIntHelper.TestBit(const Index: TShortIntBitIndex):Boolean; inline; begin Result := (Self and ShortInt((ShortInt(1) shl index)))<>0; end; { --------------------------------------------------------------------- TSmallintHelper ---------------------------------------------------------------------} Class Function TSmallIntHelper.Parse(const AString: string): SmallInt; inline; begin Result:=StrToInt(AString); end; Class Function TSmallIntHelper.Size: Integer; inline; begin Result:=2; end; Class Function TSmallIntHelper.ToString(const AValue: SmallInt): string; overload; inline; begin Result:=IntToStr(AValue); end; Class Function TSmallIntHelper.TryParse(const AString: string; out AValue: SmallInt): Boolean; inline; Var C : Integer; begin Val(AString,AValue,C); Result:=(C=0); end; Function TSmallIntHelper.ToBoolean: Boolean; inline; begin Result:=(Self<>0); end; Function TSmallIntHelper.ToDouble: Double; inline; begin Result:=Self; end; Function TSmallIntHelper.ToExtended: Extended; inline; begin Result:=Self; end; Function TSmallIntHelper.ToBinString: string; inline; begin Result:=BinStr(Self,Size*8); end; Function TSmallIntHelper.ToHexString(const AMinDigits: Integer): string; overload; inline; Var B : Cardinal; U : TJSUInt16Array; S : TJSInt16array; begin if Self>=0 then B:=Self else begin S:=TJSInt16Array.New(1); S[0]:=Self; U:=TJSUInt16Array.New(S); B:=U[0]; if AMinDigits>6 then B:=$FFFF0000+B else if AMinDigits>4 then B:=$FF0000+B; end; Result:=IntToHex(B,AMinDigits); end; Function TSmallIntHelper.ToHexString: string; overload; inline; begin Result:=ToHexString(Size*2); end; Function TSmallIntHelper.ToString: string; overload; inline; begin Result:=IntToStr(Self); end; Function TSmallIntHelper.SetBit(const index: TSmallIntBitIndex) : SmallInt; inline; begin Self := Self or (SmallInt(1) shl index); Result:=Self; end; Function TSmallIntHelper.ClearBit(const index: TSmallIntBitIndex) : SmallInt; inline; begin Self:=Self and not SmallInt((SmallInt(1) shl index)); Result:=Self; end; Function TSmallIntHelper.ToggleBit(const index: TSmallIntBitIndex) : SmallInt; inline; begin Self := Self xor SmallInt((SmallInt(1) shl index)); Result:=Self; end; Function TSmallIntHelper.TestBit(const Index: TSmallIntBitIndex):Boolean; inline; begin Result := (Self and SmallInt((SmallInt(1) shl index)))<>0; end; { --------------------------------------------------------------------- TWordHelper ---------------------------------------------------------------------} Class Function TWordHelper.Parse(const AString: string): Word; inline; begin Result:=StrToInt(AString); end; Class Function TWordHelper.Size: Integer; inline; begin Result:=2; end; Class Function TWordHelper.ToString(const AValue: Word): string; overload; inline; begin Result:=IntToStr(AValue); end; Class Function TWordHelper.TryParse(const AString: string; out AValue: Word): Boolean; inline; Var C : Integer; begin Val(AString,AValue,C); Result:=(C=0); end; Function TWordHelper.ToBoolean: Boolean; inline; begin Result:=(Self<>0); end; Function TWordHelper.ToDouble: Double; inline; begin Result:=Self; end; Function TWordHelper.ToExtended: Extended; inline; begin Result:=Self; end; Function TWordHelper.ToBinString: string; inline; begin Result:=BinStr(Self,Size*8); end; Function TWordHelper.ToHexString(const AMinDigits: Integer): string; overload; inline; begin Result:=IntToHex(Self,AMinDigits); end; Function TWordHelper.ToHexString: string; overload; inline; begin Result:=IntToHex(Self,Size*2); end; Function TWordHelper.ToString: string; overload; inline; begin Result:=IntToStr(Self); end; Function TWordHelper.SetBit(const index: TWordBitIndex) : Word; inline; begin Self := Self or (Word(1) shl index); Result:=Self; end; Function TWordHelper.ClearBit(const index: TWordBitIndex) : Word; inline; begin Self:=Self and not Word((Word(1) shl index)); Result:=Self; end; Function TWordHelper.ToggleBit(const index: TWordBitIndex) : Word; inline; begin Self := Self xor Word((Word(1) shl index)); Result:=Self; end; Function TWordHelper.TestBit(const Index: TWordBitIndex):Boolean; inline; begin Result := (Self and Word((Word(1) shl index)))<>0; end; { --------------------------------------------------------------------- TCardinalHelper ---------------------------------------------------------------------} Class Function TCardinalHelper.Parse(const AString: string): Cardinal; inline; begin Result:=StrToInt(AString); end; Class Function TCardinalHelper.Size: Integer; inline; begin Result:=4; end; Class Function TCardinalHelper.ToString(const AValue: Cardinal): string; overload; inline; begin Result:=IntToStr(AValue); end; Class Function TCardinalHelper.TryParse(const AString: string; out AValue: Cardinal): Boolean; inline; Var C : Integer; begin Val(AString,AValue,C); Result:=(C=0); end; Function TCardinalHelper.ToBoolean: Boolean; inline; begin Result:=(Self<>0); end; Function TCardinalHelper.ToDouble: Double; inline; begin Result:=Self; end; Function TCardinalHelper.ToExtended: Extended; inline; begin Result:=Self; end; Function TCardinalHelper.ToBinString: string; inline; begin Result:=BinStr(Self,Size*8); end; Function TCardinalHelper.ToHexString(const AMinDigits: Integer): string; overload; inline; begin Result:=IntToHex(Self,AMinDigits); end; Function TCardinalHelper.ToHexString: string; overload; inline; begin Result:=ToHexString(Size*2); end; Function TCardinalHelper.ToString: string; overload; inline; begin Result:=IntToStr(Self); end; Function TCardinalHelper.SetBit(const index: TCardinalBitIndex) : Cardinal; inline; begin Self := Self or (Cardinal(1) shl index); Result:=Self; end; Function TCardinalHelper.ClearBit(const index: TCardinalBitIndex) : Cardinal; inline; begin Self:=Self and not Cardinal((Cardinal(1) shl index)); Result:=Self; end; Function TCardinalHelper.ToggleBit(const index: TCardinalBitIndex) : Cardinal; inline; begin Self := Self xor Cardinal((Cardinal(1) shl index)); Result:=Self; end; Function TCardinalHelper.TestBit(const Index: TCardinalBitIndex):Boolean; inline; begin Result := (Self and Cardinal((Cardinal(1) shl index)))<>0; end; { --------------------------------------------------------------------- TIntegerHelper ---------------------------------------------------------------------} Class Function TIntegerHelper.Parse(const AString: string): Integer; inline; begin Result:=StrToInt(AString); end; Class Function TIntegerHelper.Size: Integer; inline; begin Result:=4; end; Class Function TIntegerHelper.ToString(const AValue: Integer): string; overload; inline; begin Result:=IntToStr(AValue); end; Class Function TIntegerHelper.TryParse(const AString: string; out AValue: Integer): Boolean; inline; Var C : Integer; begin Val(AString,AValue,C); Result:=(C=0); end; Function TIntegerHelper.ToBoolean: Boolean; inline; begin Result:=(Self<>0); end; Function TIntegerHelper.ToDouble: Double; inline; begin Result:=Self; end; Function TIntegerHelper.ToExtended: Extended; inline; begin Result:=Self; end; Function TIntegerHelper.ToBinString: string; inline; begin Result:=BinStr(Self,Size*8); end; Function TIntegerHelper.ToHexString(const AMinDigits: Integer): string; overload; inline; Var B : Word; U : TJSUInt32Array; S : TJSInt32array; begin if Self>=0 then B:=Self else begin S:=TJSInt32Array.New(1); S[0]:=Self; U:=TJSUInt32Array.New(S); B:=U[0]; end; Result:=IntToHex(B,AMinDigits); end; Function TIntegerHelper.ToHexString: string; overload; inline; begin Result:=ToHexString(Size*2); end; Function TIntegerHelper.ToString: string; overload; inline; begin Result:=IntToStr(Self); end; Function TIntegerHelper.SetBit(const index: TIntegerBitIndex) : Integer; inline; begin Self := Self or (Integer(1) shl index); Result:=Self; end; Function TIntegerHelper.ClearBit(const index: TIntegerBitIndex) : Integer; inline; begin Self:=Self and not Integer((Integer(1) shl index)); Result:=Self; end; Function TIntegerHelper.ToggleBit(const index: TIntegerBitIndex) : Integer; inline; begin Self := Self xor Integer((Integer(1) shl index)); Result:=Self; end; Function TIntegerHelper.TestBit(const Index: TIntegerBitIndex):Boolean; inline; begin Result := (Self and Integer((Integer(1) shl index)))<>0; end; { --------------------------------------------------------------------- TNativeIntHelper ---------------------------------------------------------------------} Class Function TNativeIntHelper.Parse(const AString: string): NativeInt; inline; begin Result:=StrToInt(AString); end; Class Function TNativeIntHelper.Size: Integer; inline; begin Result:=7; end; Class Function TNativeIntHelper.ToString(const AValue: NativeInt): string; overload; inline; begin Result:=IntToStr(AValue); end; Class Function TNativeIntHelper.TryParse(const AString: string; out AValue: NativeInt): Boolean; inline; Var C : Integer; begin Val(AString,AValue,C); Result:=(C=0); end; Function TNativeIntHelper.ToBoolean: Boolean; inline; begin Result:=(Self<>0); end; Function TNativeIntHelper.ToDouble: Double; inline; begin Result:=Self; end; Function TNativeIntHelper.ToExtended: Extended; inline; begin Result:=Self; end; Function TNativeIntHelper.ToBinString: string; inline; begin Result:=BinStr(Self,Size*8); end; Function TNativeIntHelper.ToHexString(const AMinDigits: Integer): string; overload; inline; begin Result:=IntToHex(Self,AMinDigits); end; Function TNativeIntHelper.ToHexString: string; overload; inline; begin Result:=IntToHex(Self,Size*2); end; Function TNativeIntHelper.ToString: string; overload; inline; begin Result:=IntToStr(Self); end; Function TNativeIntHelper.SetBit(const index: TNativeIntBitIndex) : NativeInt; inline; begin Self := Self or (NativeInt(1) shl index); Result:=Self; end; Function TNativeIntHelper.ClearBit(const index: TNativeIntBitIndex) : NativeInt; inline; begin Self:=Self and not NativeInt((NativeInt(1) shl index)); Result:=Self; end; Function TNativeIntHelper.ToggleBit(const index: TNativeIntBitIndex) : NativeInt; inline; begin Self := Self xor NativeInt((NativeInt(1) shl index)); Result:=Self; end; Function TNativeIntHelper.TestBit(const Index: TNativeIntBitIndex):Boolean; inline; begin Result := (Self and NativeInt((NativeInt(1) shl index)))<>0; end; { --------------------------------------------------------------------- TNativeUIntHelper ---------------------------------------------------------------------} Class Function TNativeUIntHelper.Parse(const AString: string): NativeUInt; inline; begin Result:=StrToInt(AString); end; Class Function TNativeUIntHelper.Size: Integer; inline; begin Result:=7; end; Class Function TNativeUIntHelper.ToString(const AValue: NativeUInt): string; overload; inline; begin Result:=IntToStr(AValue); end; Class Function TNativeUIntHelper.TryParse(const AString: string; out AValue: NativeUInt): Boolean; inline; Var C : Integer; begin Val(AString,AValue,C); Result:=(C=0); end; Function TNativeUIntHelper.ToBoolean: Boolean; inline; begin Result:=(Self<>0); end; Function TNativeUIntHelper.ToDouble: Double; inline; begin Result:=Self; end; Function TNativeUIntHelper.ToExtended: Extended; inline; begin Result:=Self; end; Function TNativeUIntHelper.ToBinString: string; inline; begin Result:=BinStr(Self,Size*8); end; Function TNativeUIntHelper.ToHexString(const AMinDigits: Integer): string; overload; inline; begin Result:=IntToHex(Self,AMinDigits); end; Function TNativeUIntHelper.ToHexString: string; overload; inline; begin Result:=IntToHex(Self,Size*2); end; Function TNativeUIntHelper.ToSingle: Single; inline; begin Result:=Self; end; Function TNativeUIntHelper.ToString: string; overload; inline; begin Result:=IntToStr(Self); end; Function TNativeUIntHelper.SetBit(const index: TNativeUIntBitIndex) : NativeUInt; inline; begin Self := Self or (NativeUInt(1) shl index); Result:=Self; end; Function TNativeUIntHelper.ClearBit(const index: TNativeUIntBitIndex) : NativeUInt; inline; begin Self:=Self and not NativeUInt((NativeUInt(1) shl index)); Result:=Self; end; Function TNativeUIntHelper.ToggleBit(const index: TNativeUIntBitIndex) : NativeUInt; inline; begin Self := Self xor NativeUInt((NativeUInt(1) shl index)); Result:=Self; end; Function TNativeUIntHelper.TestBit(const Index: TNativeUIntBitIndex):Boolean; inline; begin Result := (Self and NativeUInt((NativeUInt(1) shl index)))<>0; end; { --------------------------------------------------------------------- TBooleanHelper ---------------------------------------------------------------------} Class Function TBooleanHelper.Parse(const S: string): Boolean; inline; begin Result:=StrToBool(S); end; Class Function TBooleanHelper.Size: Integer; inline; begin Result:=1; end; Class Function TBooleanHelper.ToString(const AValue: Boolean; UseBoolStrs: Boolean = False): string; overload; inline; begin Result:=BoolToStr(AValue,True); end; Class Function TBooleanHelper.TryToParse(const S: string; out AValue: Boolean): Boolean; inline; begin Result:=TryStrToBool(S,AValue); end; Function TBooleanHelper.ToInteger: Integer; inline; begin Result:=Integer(Self); end; Function TBooleanHelper.ToString(UseBoolStrs: Boolean= False): string; overload; inline; begin Result:=BoolToStr(Self,True); end; { --------------------------------------------------------------------- TByteBoolHelper ---------------------------------------------------------------------} Class Function TByteBoolHelper.Parse(const S: string): Boolean; inline; begin Result:=StrToBool(S); end; Class Function TByteBoolHelper.Size: Integer; inline; begin Result:=1; end; Class Function TByteBoolHelper.ToString(const AValue: Boolean; UseBoolStrs: Boolean = False): string; overload; inline; begin Result:=BoolToStr(AValue,True); end; Class Function TByteBoolHelper.TryToParse(const S: string; out AValue: Boolean): Boolean; inline; begin Result:=TryStrToBool(S,AValue); end; Function TByteBoolHelper.ToInteger: Integer; inline; begin Result:=Integer(Self); end; Function TByteBoolHelper.ToString(UseBoolStrs: Boolean = False): string; overload; inline; begin Result:=BoolToStr(Self,True); end; { --------------------------------------------------------------------- TWordBoolHelper ---------------------------------------------------------------------} Class Function TWordBoolHelper.Parse(const S: string): Boolean; inline; begin Result:=StrToBool(S); end; Class Function TWordBoolHelper.Size: Integer; inline; begin Result:=2; end; Class Function TWordBoolHelper.ToString(const AValue: Boolean; UseBoolStrs: boolean = False): string; overload; inline; begin Result:=BoolToStr(AValue,True); end; Class Function TWordBoolHelper.TryToParse(const S: string; out AValue: Boolean): Boolean; inline; begin Result:=TryStrToBool(S,AValue); end; Function TWordBoolHelper.ToInteger: Integer; inline; begin Result:=Integer(Self); end; Function TWordBoolHelper.ToString(UseBoolStrs: Boolean = False): string; overload; inline; begin Result:=BoolToStr(Self,True); end; { --------------------------------------------------------------------- TLongBoolHelper ---------------------------------------------------------------------} Class Function TLongBoolHelper.Parse(const S: string): Boolean; inline; begin Result:=StrToBool(S); end; Class Function TLongBoolHelper.Size: Integer; inline; begin Result:=4; end; Class Function TLongBoolHelper.ToString(const AValue: Boolean; UseBoolStrs: Boolean = False): string; overload; inline; begin Result:=BoolToStr(AValue,True); end; Class Function TLongBoolHelper.TryToParse(const S: string; out AValue: Boolean): Boolean; inline; begin Result:=TryStrToBool(S,AValue); end; Function TLongBoolHelper.ToInteger: Integer; inline; begin Result:=Integer(Self); end; Function TLongBoolHelper.ToString(UseBoolStrs: Boolean = False): string; overload; inline; begin Result:=BoolToStr(Self,True); end; end.