{ *********************************************************************** }
{                                                                         }
{ Delphi Runtime Library                                                  }
{                                                                         }
{ Copyright (c) 1988-2004 Borland Software Corporation                    }
{                                                                         }
{ *********************************************************************** }

unit Borland.Delphi.System;

interface

uses
  System.Text,
  System.IO,
  System.Runtime.CompilerServices, // required for typed constant initialization at runtime
  System.Runtime.InteropServices,
  System.Diagnostics,  // DebuggableAttribute is required at link phase
  System.Globalization,
  System.Threading,
  System.Reflection;

(* You can use RTLVersion in $IF expressions to test the runtime library
  version level independently of the compiler version level.
  Example:  {$IF RTLVersion >= 16.2} ... {$IFEND}                  *)

const
  RTLVersion = 16.00;

type
  TObject = System.Object;
  TCustomAttribute = System.Attribute;
  Exception = System.Exception;
  TGUID = System.Guid;

{ TClass = class of TObject

  For each class type (TMyClass) declared in Delphi source code, the compiler
  will create a corresponding metaclass (@MetaTMyClass) inherited from TClass
  to implement Delphi "class of object" behaviors, such as virtual
  constructors and virtual class methods.  All Delphi metaclasses inherit from
  TClass.  Delphi metaclasses are not CLS compliant and not intended for use
  by other languages.

  Whenever an object instance or a class type is assigned to a class reference
  variable or parameter, the compiler will select the appropriate metaclass
  to pass instead of the actual object instance.

  Instead of constructing an instance of the metaclass each time it is
  referenced, the compiler will define a constant static instance of
  the metaclass.  For most class method calls and class reference assignments,
  that constant static instance will be passed as the Self param of the call.
  This allows TObjectHelper.ClassParent to return the ancestor's actual
  TClass without having to construct a System.Type instance, and without
  having to search for the appropriate TClass.

  If a class type is imported from CLR (and is not a Delphi-generated class),
  it will not have a metaclass.  When a CLR imported class is used in
  a Delphi class reference expression, the compiler will construct an
  instance of a generic TClass, passing the CLR type to the constructor.
  The generic TClass can simulate Delphi metaclass behaviors for CLR classes,
  but not as efficiently as compiler-constructed metaclasses.

  If you extract the System.Type from a Delphi class and use it in a Delphi
  class reference expression, you lose the Delphi-specific behaviors provided
  by the Delphi metaclass associated with the Delphi class.

  TClass uses System.RuntimeTypeHandle to identify the object instance type.
  RuntimeTypeHandles are more memory efficient than instances of
  System.Type, particularly when we don't expect to use them very often.
}

{ Do not place any class declarations before _TClass! }

  _TClass = class;

  TClass = class of TObject;

  _TClass = class
  strict protected
    FInstanceTypeHandle: System.RuntimeTypeHandle;
    FInstanceType: System.Type;
    FClassParent: _TClass;
  protected
    procedure SetInstanceType(ATypeHandle: System.RuntimeTypeHandle);
    procedure SetDelegator(ATypeDelegator: System.Type);
  public
    constructor Create; overload;
    constructor Create(ATypeHandle: System.RuntimeTypeHandle); overload;
    constructor Create(AType: System.Type); overload;
    function ClassParent: TClass;
    function InstanceTypeHandle: System.RuntimeTypeHandle;
    function InstanceType: System.Type;
    function Equals(AObj: TObject): Boolean; override;
    function GetHashCode: Integer; override;
  end;

  TClassHelperBase = class(TObject)
  public
    FInstance: TObject;
  end;

  [AttributeUsageAttribute(AttributeTargets.Method, AllowMultiple=False)]
  MessageMethodAttribute = class(TCustomAttribute)
  private
    FID: Integer;
  public
    constructor Create(AID: Integer);
    property ID: Integer read FID;
  end;

  [AttributeUsageAttribute(AttributeTargets.Assembly or AttributeTargets.Module, AllowMultiple=True)]
  RuntimeRequiredAttribute = class(Attribute)
  public
    constructor Create(AType: System.Type);
  end;

  TMethodCode = MemberInfo;

  TObjectHelper = class helper for TObject
  public
    procedure Free;
    function ClassType: TClass;
    class function ClassName: string;
    class function ClassNameIs(const Name: string): Boolean;
    class function ClassParent: TClass;
    class function ClassInfo: System.Type;
    class function InheritsFrom(AClass: TClass): Boolean;
    class function MethodAddress(const AName: string): TMethodCode;
    class function MethodName(ACode: TMethodCode): string;
    function FieldAddress(const AName: string): TObject;
    procedure Dispatch(var Message);
  end;

function _CreateCastException(Obj:TObject; CastType: System.Type): TObject;
function _GetMetaFromHandle(ATypeHandle: System.RuntimeTypeHandle): _TClass;
function _GetMetaFromObject(Obj: TObject): _TClass;

type
  // TResourceKeyStringAttribute is needed to be defined before
  // using resourcestring
  [System.AttributeUsageAttribute(System.AttributeTargets.Field)]
  TResourceKeyStringAttribute = class(TCustomAttribute)
  end;


// Methods
resourcestring
  SMethodMultiError = 'TMethod does not support conversion from MultiDelegates';
  SMethodInvokeError = 'TMethod instance is not callable';
  SMethodTypeMismatchError = 'Declaring method type and class type mismatched';

type
  EMethodError = class(Exception);
  EMethodMultiError = class(EMethodError);
  EMethodInvokeError = class(EMethodError);
  EMethodTypeMismatchError = class(EMethodError);
  TMethod = record
  public
    var
      Data: TObject;
      Code: TMethodCode;

                                                                                          
    constructor Create(AData: TObject; ACode: TMethodCode); overload;
    constructor Create(AData: TObject; const AName: string); overload;
    function Clone: TMethod;

    function CanInvoke: Boolean;
    function Invoke(AParams: array of TObject): TObject;
    function ToString: string; override;

    function IsEmpty: Boolean;
    class function Empty: TMethod; static;

    class operator Implicit(ADelegate: Delegate): TMethod;
    class operator Equal(const ALeft, ARight: TMethod): Boolean;
    class operator NotEqual(const ALeft, ARight: TMethod): Boolean;
  end;

// Interfaces
type
  TInterfacedObject = TObject;
  IInterface = interface
  end;

// Modifiers
type
  TUniqueTypeModifier = class(TCustomAttribute)
  end;

// Attributes
type
  [System.AttributeUsageAttribute(System.AttributeTargets.Struct)]
  TSetElementTypeAttribute = class(System.Attribute)
  strict private
    FElementType: System.Type;
  public
    constructor Create(AElementType: System.Type);
    property ElementType: System.Type read FElementType;
  end;

  [System.AttributeUsageAttribute(System.AttributeTargets.Enum)]
  TSubrangeAttribute = class(TCustomAttribute)
  end;

  [System.AttributeUsageAttribute(System.AttributeTargets.Enum)]
  TSignedSubrangeAttribute = class(TSubrangeAttribute)
  strict private
    FMinValue: Int64;
    FMaxValue: Int64;
    FBaseType: System.Type;
  public
    constructor Create(AMinValue, AMaxValue: Integer;
                       ABaseType: System.Type); overload;
    constructor Create(AMinValue, AMaxValue: Int64;
                       ABaseType: System.Type); overload;
    property MinValue: Int64 read FMinValue;
    property MaxValue: Int64 read FMaxValue;
    property BaseType: System.Type read FBaseType;
  end;

  [System.AttributeUsageAttribute(System.AttributeTargets.Enum)]
  TUnsignedSubrangeAttribute = class(TSubrangeAttribute)
  strict private
    FMinValue: UInt64;
    FMaxValue: UInt64;
    FBaseType: System.Type;
  public
    constructor Create(AMinValue, AMaxValue: Cardinal;
                       ABaseType: System.Type); overload;
    constructor Create(AMinValue, AMaxValue: UInt64;
                       ABaseType: System.Type); overload;
    property MinValue: UInt64 read FMinValue;
    property MaxValue: UInt64 read FMaxValue;
    property BaseType: System.Type read FBaseType;
  end;

  TAliasTypeBase = class
  end;

  [System.AttributeUsageAttribute(System.AttributeTargets.Field or
                                  System.AttributeTargets.Parameter or
                                  System.AttributeTargets.Property or
                                  System.AttributeTargets.ReturnValue)]
  TAliasTypeAttribute = class(TCustomAttribute)
  strict private
    FAliasType: System.Type;
  public
    constructor Create(AAliasType: System.Type);
    property AliasType: System.Type read FAliasType;
  end;

  [System.AttributeUsageAttribute(System.AttributeTargets.Struct)]
  TShortStringAttribute = class(TCustomAttribute)
  strict private
    FSize: Byte;
  public
    constructor Create(Size:Byte);
    property Size: Byte read FSize;
  end;

  // if a param is marked as Const
  TConstantParamAttribute = class(TCustomAttribute)
  end;

  TPackageFlag = (pf_NeverBuild, pf_DesignOnly, pf_RunOnly, pfDuplicateEnable);
  TPackageFlags = set of TPackageFlag;

  TPackageAttribute = class(TCustomAttribute)
  strict private
    FFlags: TPackageFlags;
    FDcpFileName: string;
  public
    constructor Create(flags: Integer; const dcpFileName: string);  // integer for compiler convenience
    property Flags: TPackageFlags read FFlags;
    property DcpFileName: string read FDcpFileName;
  end;

{ resource string helper functions }
function LoadResString(ID:String): String; deprecated;
function _LoadResString(AType: System.Type; ID:String): String;

type
  TBytes = array of Byte;

{ AnsiString handling }

var
  AnsiEncoding: System.Text.Encoding;

{ Typed-file and untyped-file record }

const

{ File mode magic numbers }

  fmClosed = $D7B0;
  fmInput  = $D7B1;
  fmOutput = $D7B2;
  fmInOut  = $D7B3;

{ Text file flags         }
  tfCRLF   = $01;    // Dos compatibility flag, for CR+LF line breaks and EOF checks

type
  Extended = type Double;   // 80 bit reals are unique to the Intel x86 architecture
  Comp = Int64 deprecated;

type
  TOACurrency = Int64;
  Currency = packed record(IFormattable, IComparable, IConvertible)
  strict private
    var
      FValue: TOACurrency;
    class var
      FMinValue, FMaxValue, FScale: TOACurrency;
  public
    class constructor Create;
    constructor Create(const Value: Double); overload;
    constructor Create(const Value: System.Decimal); overload;

    function ToString: string; overload; override;
    function GeneralFormatString: string;

    class function Parse(const AValue: string): Currency; overload; static;
    class function Parse(const AValue: string;
      AProvider: IFormatProvider): Currency; overload; static;
    class function Parse(const AValue: string;
      AStyle: System.Globalization.NumberStyles): Currency; overload; static;
    class function Parse(const AValue: string;
      AStyle: System.Globalization.NumberStyles;
      AProvider: IFormatProvider): Currency; overload; static;
    class function TryParse(const AValue: string;
      AStyle: System.Globalization.NumberStyles;
      AProvider: IFormatProvider; out AResult: Currency): Boolean; static;

    class function MinValue: Currency; static; { -922337203685477.5807 }
    class function MaxValue: Currency; static; {  922337203685477.5807 }

    class function FromOACurrency(const Value: TOACurrency): Currency; static;
    function ToOACurrency: TOACurrency;
    class function FromBytes(const AValue: TBytes): Currency; static;
    class function ToBytes(const Value: Currency): TBytes; static;
    class function FromObject(AObject: System.Object): Currency; static;

    class operator Trunc(const Value: Currency): Int64;
    class operator Round(const Value: Currency): Int64;

    class operator Negative(const Value: Currency): Currency;
    class operator Positive(const Value: Currency): Currency;

    class operator Inc(const Value: Currency): Currency;
    class operator Dec(const Value: Currency): Currency;

    class operator Add(const Left, Right: Currency): Currency;
    class operator Subtract(const Left, Right: Currency): Currency;
    class operator Multiply(const Left, Right: Currency): Currency;
    class operator Divide(const Left, Right: Currency): Double;
    class operator Modulus(const Left, Right: Currency): Double;

    class operator Equal(const Left, Right: Currency): Boolean;
    class operator NotEqual(const Left, Right: Currency): Boolean;
    class operator LessThan(const Left, Right: Currency): Boolean;
    class operator LessThanOrEqual(const Left, Right: Currency): Boolean;
    class operator GreaterThan(const Left, Right: Currency): Boolean;
    class operator GreaterThanOrEqual(const Left, Right: Currency): Boolean;

    class operator Implicit(const Value: Integer): Currency;
    class operator Implicit(const Value: Int64): Currency;
    class operator Implicit(const Value: Double): Currency;
    class operator Implicit(const Value: Currency): Double;
    class operator Implicit(const Value: Extended): Currency;
    class operator Implicit(const Value: Currency): Extended;
    class operator Implicit(const Value: System.Decimal): Currency;
    class operator Implicit(const Value: Currency): System.Decimal;

    // IFormattable
    /// Note: format is the CLR format string, not a Delphi format string
    function ToString(AFormat: string; AProvider: IFormatProvider): string; overload;

    // IComparable
    function CompareTo(AValue: TObject): Integer;

    // IConvertible
    function GetTypeCode: TypeCode;
    function ToInt16(AProvider: IFormatProvider): SmallInt;
    function ToInt32(AProvider: IFormatProvider): Integer;
    function ToSingle(AProvider: IFormatProvider): Single;
    function ToDouble(AProvider: IFormatProvider): Double;
    function ToDateTime(AProvider: IFormatProvider): DateTime;
    function ToBoolean(AProvider: IFormatProvider): Boolean;
    function ToDecimal(AProvider: IFormatProvider): Decimal;
    function ToSByte(AProvider: IFormatProvider): ShortInt;
    function ToByte(AProvider: IFormatProvider): Byte;
    function ToUInt16(AProvider: IFormatProvider): Word;
    function ToUInt32(AProvider: IFormatProvider): LongWord;
    function ToInt64(AProvider: IFormatProvider): Int64;
    function ToUInt64(AProvider: IFormatProvider): UInt64;
    function ToString(AProvider: IFormatProvider): string; overload;
    function ToChar(AProvider: IFormatProvider): Char;
    function ToType(AType: System.Type; AProvider: IFormatProvider): TObject;
  end;

resourcestring
  SCurrencyOutOfRangeError = 'Value given is out of Currency''s range';

type
  /// Uninitialized TDateTime variables will return 1/1/1 0:00:00 in
  ///   Delphi v8 for .NET instead of Delphi v7's 12/30/1899 0:00:00
  TOADate = Double;
  TDateTime = packed record(IFormattable, IComparable, IConvertible)
  strict private
    var
      FValue: System.DateTime;
    class var
      FMinValue, FMaxValue: System.DateTime;
  public
    class constructor Create;
    constructor Create(const AValue: Double); overload;
    constructor Create(const ADays: Integer); overload;
    constructor Create(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Integer); overload;

    function ToString: string; overload; override;

    class function Parse(const AValue: string): TDateTime; overload; static;
    class function Parse(const AValue: string;
      AProvider: IFormatProvider): TDateTime; overload; static;
    class function Parse(const AValue: string; AProvider: IFormatProvider;
      AStyle: System.Globalization.DateTimeStyles): TDateTime; overload; static;

    function Year: Integer;
    function Month: Integer;
    function Day: Integer;
    function Hour: Integer;
    function Minute: Integer;
    function Second: Integer;
    function MilliSecond: Integer;
    function DayOfYear: Integer;
    function DayOfWeek: Integer;
    function Time: TDateTime;
    function Date: TDateTime;
    class function IsLeapYear(AYear: Word): Boolean; static;
    class function DaysInMonth(AYear, AMonth: Word): Word; static;
    class function Now: TDateTime; static;
    class function TheDate: TDateTime; static;
    class function TheTime: TDateTime; static;
    class function TheYear: Word; static;

    class procedure DecodeDate(const AValue: TDateTime; out AYear, AMonth, ADay: Word); overload; static;
    class function DecodeDate(const AValue: TDateTime; out AYear, AMonth, ADay, ADOW: Word): Boolean; overload; static;
    class procedure DecodeTime(const AValue: TDateTime; out AHour, AMinute, ASecond, AMilliSecond: Word); static;
    class procedure DecodeDateTime(const AValue: TDateTime; out AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word); static;
    class function EncodeDate(AYear, AMonth, ADay: Word): TDateTime; static;
    class function EncodeTime(AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime; static;
    class function EncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime; static;
    class function TryEncodeDate(AYear, AMonth, ADay: Word; out ADate: TDateTime): Boolean; static;
    class function TryEncodeTime(AHour, AMinute, ASecond, AMilliSecond: Word; out ATime: TDateTime): Boolean; static;
    class function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; out AValue: TDateTime): Boolean; static;

    function ReplaceDate(AYear, AMonth, ADay: Word): TDateTime; overload;
    function ReplaceDate(const ADate: TDateTime): TDateTime; overload;
    function ReplaceTime(AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime; overload;
    function ReplaceTime(const ATime: TDateTime): TDateTime; overload;
    function AddMonth(AMonths: Integer = 1): TDateTime;

    class function MinValue: TDateTime; static; { 01/01/0100 12:00:00.000 AM }
    class function MaxValue: TDateTime; static; { 12/31/9999 11:59:59.999 PM }

    class function FromOADate(const AValue: TOADate): TDateTime; static;
    function ToOADate: TOADate;
    class function FromBytes(const AValue: TBytes): TDateTime; static;
    class function ToBytes(const AValue: TDateTime): TBytes; static;
    class function FromObject(AObject: System.Object): TDateTime; static;

    class operator Trunc(const AValue: TDateTime): Int64;
    class operator Round(const AValue: TDateTime): Int64;

    class operator Negative(const AValue: TDateTime): Double;
    class operator Positive(const AValue: TDateTime): Double;

    class operator Add(const Left, Right: TDateTime): Double;
    class operator Add(const Left: TDateTime; const Right: Double): TDateTime;
    class operator Add(const Left: TDateTime; const Right: System.TimeSpan): TDateTime;
    class operator Subtract(const Left, Right: TDateTime): Double;
    class operator Subtract(const Left: TDateTime; const Right: Double): TDateTime;
    class operator Subtract(const Left: TDateTime; const Right: System.TimeSpan): TDateTime;
    class operator Multiply(const Left, Right: TDateTime): Double;
    class operator Multiply(const Left: TDateTime; const Right: Double): Double;
    class operator Divide(const Left, Right: TDateTime): Double;
    class operator Divide(const Left: TDateTime; const Right: Double): Double;

    class operator Equal(const Left, Right: TDateTime): Boolean;
    class operator NotEqual(const Left, Right: TDateTime): Boolean;
    class operator LessThan(const Left, Right: TDateTime): Boolean;
    class operator LessThanOrEqual(const Left, Right: TDateTime): Boolean;
    class operator GreaterThan(const Left, Right: TDateTime): Boolean;
    class operator GreaterThanOrEqual(const Left, Right: TDateTime): Boolean;

    class operator Implicit(const AValue: Integer): TDateTime;
    class operator Implicit(const AValue: Int64): TDateTime;
    class operator Implicit(const AValue: Double): TDateTime;
    class operator Implicit(const AValue: TDateTime): Double;
    class operator Implicit(const AValue: Extended): TDateTime;
    class operator Implicit(const AValue: TDateTime): Extended;
    class operator Implicit(const aValue: System.DateTime): TDateTime;
    class operator Implicit(const AValue: TDateTime): System.DateTime;

    // IFormattable
    /// Note: format is the CLR format string, not a Delphi format string
    function ToString(AFormat: string; AProvider: IFormatProvider): string; overload;

    // IComparable
    function CompareTo(AValue: TObject): Integer;

    // IConvertible
    function GetTypeCode: TypeCode;
    function ToInt16(AProvider: IFormatProvider): SmallInt;
    function ToInt32(AProvider: IFormatProvider): Integer;
    function ToSingle(AProvider: IFormatProvider): Single;
    function ToDouble(AProvider: IFormatProvider): Double;
    function ToDateTime(AProvider: IFormatProvider): DateTime;
    function ToBoolean(AProvider: IFormatProvider): Boolean;
    function ToDecimal(AProvider: IFormatProvider): Decimal;
    function ToSByte(AProvider: IFormatProvider): ShortInt;
    function ToByte(AProvider: IFormatProvider): Byte;
    function ToUInt16(AProvider: IFormatProvider): Word;
    function ToUInt32(AProvider: IFormatProvider): LongWord;
    function ToInt64(AProvider: IFormatProvider): Int64;
    function ToUInt64(AProvider: IFormatProvider): UInt64;
    function ToString(AProvider: IFormatProvider): string; overload;
    function ToChar(AProvider: IFormatProvider): Char;
    function ToType(AType: System.Type; AProvider: IFormatProvider): TObject;
  end;

  TDayTable = array[1..12] of Word;

resourcestring
  SDateOutOfRangeError = 'Value given is out of TDateTime''s range';
  SDateToStringError = 'TDateTime value cannot be converted to a string';
  SStringToDateError = 'String value cannot be converted to a TDateTime';
  SObjectToDateError = 'Object value cannot be converted to a TDateTime';
  SDateEncodeError = 'Date values given cannot be converted to a TDateTime';
  STimeEncodeError = 'Time values given cannot be converted to a TDateTime';
  SDateTimeEncodeError = 'Date and Time values given cannot be converted to a TDateTime';

const
{ The MonthDays array can be used to quickly find the number of
  days in a month:  MonthDays[IsLeapYear(Y), M]      }

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

{ Units of time }

  HoursPerDay   = 24;
  MinsPerHour   = 60;
  SecsPerMin    = 60;
  MSecsPerSec   = 1000;
  MinsPerDay    = HoursPerDay * MinsPerHour;
  SecsPerDay    = MinsPerDay * SecsPerMin;
  MSecsPerDay   = SecsPerDay * MSecsPerSec;

{ Days between 1/1/0001 and 12/31/1899 }

  DateDelta = 693594;

{ Min/Max TDateTime double value }

  MinDateTimeAsDouble = -657434.0;     //  1/ 1/ 100  0:00:00.000 AM
  MaxDateTimeAsDouble = 2958465.99999; // 12/31/9999 11:59:59.999 PM

{ general exceptions }
type
  EConvertError = class(Exception);
  EInvalidCast = System.InvalidCastException;

  EIntError = System.ArithmeticException;
  EDivByZero = System.DivideByZeroException;
  ERangeError = class(System.ArithmeticException);
  EIntOverflow = System.OverflowException;

  EMathError = System.ArithmeticException;
  EInvalidOp = System.NotFiniteNumberException;
  EZeroDivide = System.DivideByZeroException;
  EOverflow = System.OverflowException;
  EUnderflow = class(System.NotFiniteNumberException);

resourcestring
  SDivByZero = 'Division by zero';
  SRangeError = 'Range check error';
  SIntOverflow = 'Integer overflow';
  SInvalidOp = 'Invalid floating point operation';
  SZeroDivide = 'Floating point division by zero';
  SOverflow = 'Floating point overflow';
  SUnderflow = 'Floating point underflow';
  SInvalidFormatString = 'Invalid format string';
  SInvalidCastString = 'Invalid cast operation';

procedure ConvertError(const ACaption: string);
procedure InvalidCastError(const ACaption: string);
procedure OverflowError(const ACaption: string);

{ debugging functions }

procedure _Assert(const Message, Filename: String; LineNumber: Integer);

type
  EAssertionFailed = class(Exception)
  public
    ShortMessage: string;
    Filename: string;
    LineNumber: Integer;
  end;

{ assignment testing }

// compiler std proc:  function Assigned(const P): Boolean; overload;
function Assigned(const AGCHandle: GCHandle): boolean; overload;

{ random functions }

var
  RandSeed: LongInt = 0;

procedure Randomize;

function Random(const ARange: Integer): Integer; overload;
function Random: Extended; overload;


{ numeric functions }

function _Trunc(const AValue: Double): Int64; /// Trunc is still a compiler magic function
function Int(const AValue: Double): Double; overload;
function Frac(const AValue: Double): Double; overload;
function Exp(const AValue: Double): Double; overload;
function Ln(const AValue: Double): Double; overload;
function Sqrt(const AValue: Double): Double; overload;
function Sin(const AValue: Double): Double; overload;
function Cos(const AValue: Double): Double; overload;
function ArcTan(const AValue: Double): Double; overload;

{ string functions }

function UpCase(Ch: Char): Char; overload;
function UpCase(Ch: AnsiChar): AnsiChar; overload;

function _ValShort(const s: string; var code: Integer): ShortInt;
function _ValByte(const s: string; var code: Integer): Byte;
function _ValInt(const s: string; var code: Integer): SmallInt;
function _ValWord(const s: string; var code: Integer): Word;
function _ValLong(const s: string; var code: Integer): LongInt;
function _ValULong(const s: string; var code: Integer): LongWord;
function _ValInt64(const s: string; var code: Integer): Int64;
function _ValUInt64(const s: string; var code: Integer): UInt64;
function _ValExt(const s: string; var code: Integer): Double;

function _Str2Ext(Val: Double; Width, Decimals: Integer): string;
function _StrLong(Val: Integer; Width: Integer): string;
function _StrUInt64(Val: UInt64; Width: Integer): string;
function _StrInt64(Val: Int64; Width: Integer): string;
function _Str0Ext(Val: Double): string;
function _Str0Long(Val: Integer): string;
function _Str0UInt64(Val: UInt64): string;
function _Str0Int64 (Val: Int64): string;

// TBytes/string conversion routines
function BytesOf(const Val: AnsiString): TBytes; overload;
function BytesOf(const Val: WideString): TBytes; overload;
function BytesOf(const Val: WideChar): TBytes; overload;
function BytesOf(const Val: AnsiChar): TBytes; overload;
function StringOf(const Bytes: array of Byte): string;
function PlatformBytesOf(const Value: string): TBytes;
function PlatformStringOf(const Value: TBytes): string;
function WideStringOf(const Value: TBytes): WideString;
function WideBytesOf(const Value: WideString): TBytes;

// Double to Extended conversion routines
function DoubleToExtendedAsBytes(const Value: Double): TBytes;
function ExtendedAsBytesToDouble(const Bytes: array of Byte): Double;

// command line
function CmdLine: string;
function ParamCount: Integer;
function ParamStr(Index: Integer): string;

resourcestring
  SInvalidCast = 'Invalid cast';

const
  sLineBreak = #13#10;

{ File functions }
type
  [ComVisible(False)]
  TFileRec = record
    Stream: Stream;
    Mode: Word;
    Flags: Word;
  end;

  ITextDeviceFactory = interface;

  TTextLineBreakStyle = (tlbsLF, tlbsCRLF);

  Text = class
    Mode: Word;
    Flags: Word;
    Factory: ITextDeviceFactory;
    Reader: System.IO.TextReader;
    Writer: System.IO.TextWriter;
    Filename: string;

    procedure Flush;

    function Eof: Boolean;
    function Eoln: Boolean;
    function SeekEof: Boolean;
    function SeekEoln: Boolean;

    function ReadAnsiChar: AnsiChar;
    function ReadWideChar: WideChar;
    function ReadInteger: Integer;
    function ReadInt64: Int64;
    function ReadUInt64: UInt64;
    function ReadAnsiString: AnsiString;
    function ReadWideString: WideString;
    function ReadShortString(maxLen: Integer): ShortString;
    function ReadFloat: Double;
    procedure ReadLn;

    function WriteAnsiChar(Ch: AnsiChar; Width: Integer): Text;
    function WriteWideChar(Ch: WideChar; Width: Integer): Text;
    function WriteBoolean(Val: Boolean; Width: Integer): Text;
    function WriteInteger(Val, Width: Integer): Text;
    function WriteWideString(const S: WideString; Width: Integer): Text;
    function WriteAnsiString(const S: AnsiString; Width: Integer): Text;
    function WriteShortString(const s: ShortString; Width: Integer): Text;
    function WriteFloat(Val: Double; Width, Prec: LongInt): Text;
    function WriteInt64(Val: Int64; Width: Integer): Text;
    function WriteUInt64(Val: UInt64; Width: Integer): Text;
    procedure WriteLn;
  protected
    procedure WriteSpaces(Count: Integer);
    class constructor Create;
  public
    { Text output line break handling.  Default value for all text files }
    class var DefaultTextLineBreakStyle: TTextLineBreakStyle;
  end;

  // ITextDeviceFactory is responsible for initializing the Reader or
  // Writer field of the Text object, appropriate to the given Mode.
  // Close is provided for devices that require additional handling
  // to close the resource.  Note that Text may close the associated
  // Reader or Writer without destroying the Text object itself.
  // Function results are runtime error codes, zero for success.
  ITextDeviceFactory = interface
    function Open(t: Text; Mode: Word): Integer;
    function Close(t: Text): Integer;
  end;

  TextFile = Text;
  TTextRec = Text;

  TextOutput = class
  public
    class var Output: Text;
    class constructor Create;
  end;

  TextInput = class
  public
    class var Input: Text;
    class constructor Create;
  end;

  TextErrOutput = class
  public
    class var ErrOutput: Text;
    class constructor Create;
  end;

function Output: Text;      // for backward compatibility only
function Input: Text;       // for backward compatibility only
function ErrOutput: Text;

procedure SetInOutRes(NewValue: Integer);

resourcestring
  sFileNotOpenForInput = 'File not open for input';
  sFileNotOpenForOutput = 'File not open for output';
  sRuntimeError = 'Runtime Error %s';
  sRuntimeErrorCode = 'Runtime Error {0}';
  SFileNotFound = 'File not found';
  SInvalidFilename = 'Invalid filename';
  STooManyOpenFiles = 'Too many open files';
  SAccessDenied = 'File access denied';
  SEndOfFile = 'Read beyond end of file';
  SDiskFull = 'Disk full';
  SInvalidInput = 'Invalid numeric input';

type
  ERuntimeError = class(Exception);
  EFileNotOpenForInput = class(ERuntimeError);
  EFileNotOpenForOutput = class(ERuntimeError);
  EFileNotFound = class(ERuntimeError);
  EInvalidFilename = class(ERuntimeError);
  ETooManyOpenFiles = class(ERuntimeError);
  EAccessDenied = class(ERuntimeError);
  EEndOfFile = class(ERuntimeError);
  EDiskFull = class(ERuntimeError);
  EInvalidInput = class(ERuntimeError);

procedure _Append(t: Text);
procedure _Assign(var t: Text; const Filename: string);
procedure _Close(t: Text);

procedure _ResetText(t: Text);
procedure _RewritText(t: Text);

procedure __IOTest;
procedure Erase(var t: Text);

{ Dynamic array helper functions }

function _DynArrayCopy(Src: System.Array): System.Array;
function _DynArrayCopyRange(Src: System.Array;
                            ElemTypeHandle: System.RuntimeTypeHandle;
                            Index, Count: Integer): System.Array;
function _DynArrayHigh(A: System.Array): Integer;
function _DynArrayLength(A: System.Array): Integer;

function Pos(const substr, str: AnsiString): Integer; overload;
function Pos(const substr, str: WideString): Integer; overload;

procedure ChDir(const S: string);
procedure _LGetDir(D: Byte; var S: AnsiString);
procedure _SGetDir(D: Byte; var S: ShortString);
procedure _WGetDir(D: Byte; var S: WideString);
function IOResult: Integer;
procedure MkDir(const S: string);
procedure RmDir(const S: string);

function StringOfChar(ch: AnsiChar; Count: Integer): AnsiString; overload;
function StringOfChar(ch: WideChar; Count: Integer): WideString; overload;

{ GetLastError returns the last error reported by an OS API call.  Calling
  this function usually resets the OS error state. }

function GetLastError: Integer;
{$EXTERNALSYM GetLastError}

{ Helper class helper }

function _GetHelperIntf(Instance: TObject; HelperType: System.Type): TObject;
function _GetHelperDelegate(Instance: TObject; HelperType: System.Type): TObject;

procedure _Halt(Code: Integer);
procedure _Halt0;

function _CreateRangeException: TObject;

{ Set helper functions }

type
  _TSet = Array of Byte;
function  _SetNew      (Size:Integer): _TSet;
function  _SetElem     (Elem,Size:Integer): _TSet;
function  _SetRange    (aLo,aHi,aSize:Integer): _TSet;
function  _SetRangeUInt64(aLo,aHi,aSize:Integer): Uint64;
function  _SetExpand   (const Src:_TSet; dHi,dLo,sHi,sLo:Integer): _TSet;
function  _SetExpandFromUInt64(Src:UInt64; dHi,dLo,sHi,sLo:Integer): _TSet;
function  _SetExpandToUInt64(const Src:_TSet; dHi,dLo,sHi,sLo:Integer): UInt64;
function  _SetExpandUInt64(Src:UInt64; dHi,dLo,sHi,sLo:Integer): UInt64;
function  _SetClone    (const Src:_TSet; Size:Integer): _TSet;
function  _SetEq       (const L,R:_TSet; Size:Integer): Boolean;
function  _SetLe       (const L,R:_TSet; Size:Integer): Boolean;
function  _SetTest     (const Src:_TSet; Elem,Size:Integer): Boolean;
procedure _SetAsg      (var Dest:_TSet; const Src:_TSet; Size:Integer);
procedure _SetIntersect(var Dest:_TSet; const Src:_TSet; Size:Integer);
procedure _SetUnion    (var Dest:_TSet; const Src:_TSet; Size:Integer);
procedure _SetSub      (var Dest:_TSet; const Src:_TSet; Size:Integer);
procedure _SetInclude  (var Dest:_TSet; Elem,Size:Integer);
procedure _SetExclude  (var Dest:_TSet; Elem,Size:Integer);

{ String helper functions }

type
  _TShortStringElem = Byte;
  _TShortString = Array of _TShortStringElem;
  _TAnsiStringElem = Byte;
  _TAnsiString = Array of _TAnsiStringElem;
  _TWideString = WideString;

  _AnsiString = record(IFormattable, IComparable, IConvertible)
    Data: _TAnsiString;

    constructor Create(AData: _TAnsiString);

    function ToString: string; overload; override;

    function get_Chars(At: Integer): AnsiChar;
    procedure set_Chars(At: Integer; AChar: AnsiChar);
    property Chars[At: Integer]: AnsiChar read get_Chars write set_Chars; default;

    function Length: Integer;

    class operator Add(const Left, Right: _AnsiString): _AnsiString;

    class operator Equal(const Left, Right: _AnsiString): Boolean;
    class operator NotEqual(const Left, Right: _AnsiString): Boolean;
    class operator LessThan(const Left, Right: _AnsiString): Boolean;
    class operator LessThanOrEqual(const Left, Right: _AnsiString): Boolean;
    class operator GreaterThan(const Left, Right: _AnsiString): Boolean;
    class operator GreaterThanOrEqual(const Left, Right: _AnsiString): Boolean;

    class operator Implicit(Value: string): _AnsiString;
    class operator Implicit(Value: WideChar): _AnsiString;
    class operator Implicit(Value: AnsiChar): _AnsiString;
    class operator Implicit(Value: _TAnsiString): _AnsiString;

    class operator Implicit(Value: _AnsiString): string;
    class operator Implicit(Value: _AnsiString): _TAnsiString;

    // IFormattable
    /// Note: format is the CLR format string, not a Delphi format string
    function ToString(AFormat: string;
                      AProvider: IFormatProvider): string; overload;

    // IComparable
    function CompareTo(AValue: TObject): Integer;

    // IConvertible
    function GetTypeCode: TypeCode;
    function ToInt16(AProvider: IFormatProvider): SmallInt;
    function ToInt32(AProvider: IFormatProvider): Integer;
    function ToSingle(AProvider: IFormatProvider): Single;
    function ToDouble(AProvider: IFormatProvider): Double;
    function ToDateTime(AProvider: IFormatProvider): DateTime;
    function ToBoolean(AProvider: IFormatProvider): Boolean;
    function ToDecimal(AProvider: IFormatProvider): Decimal;
    function ToSByte(AProvider: IFormatProvider): ShortInt;
    function ToByte(AProvider: IFormatProvider): Byte;
    function ToUInt16(AProvider: IFormatProvider): Word;
    function ToUInt32(AProvider: IFormatProvider): LongWord;
    function ToInt64(AProvider: IFormatProvider): Int64;
    function ToUInt64(AProvider: IFormatProvider): UInt64;
    function ToString(AProvider: IFormatProvider): string; overload;
    function ToChar(AProvider: IFormatProvider): Char;
    function ToType(AType: System.Type; AProvider: IFormatProvider): TObject;
  end;

function _PStrLen(const Dest:_TShortString): Integer;
function _LStrLen(const Dest:_TAnsiString): Integer;
function _WStrLen(const Dest:_TWideString): Integer;
procedure _PStrSetLen(var Dest:_TShortString; Len:Integer);
procedure _LStrSetLen(var Dest:_TAnsiString; Len:Integer);
procedure _LStrAsg(var Dest:_TAnsiString; Src:_TAnsiString);
procedure _LStrClear(var Dest:_TAnsiString);
function _AStrCmp(const L, R:Array of Byte; Size:Integer): Integer;
function _PStrCmp(const L, R:_TShortString): Integer;
function _LStrCmp(const L, R:_TAnsiString): Integer;
function _WStrCmp(const L, R:_TWideString): Integer;

procedure _PStrNCat(var Dest:_TShortString; Src:_TShortString; Size:Integer);
procedure _PStrCat(var Dest:_TShortString; Src:_TShortString);
procedure _PStrNCpy(var Dest:_TShortString; Src:_TShortString; Size:Integer);
procedure _PStrCpy(var Dest:_TShortString; Src:_TShortString);
procedure _PStrAsg(var Dest:_TShortString; Src:_TShortString; Size:Integer);

function _LStrConcat2(const L, R:_TAnsiString): _TAnsiString;
function _WStrConcat2(const L, R:_TWideString): _TWideString;
function _LStrConcatN(Strs:array of _TAnsiString): _TAnsiString;
function _WStrConcatN(Strs:array of _TWideString): _TWideString;

procedure _PStrSubstring(var Dest:_TShortString; Size: Integer;
                         const Src:_TShortString;
                         Index1, Count:Integer);
function _LStrCopy(const S:_TAnsiString; Index1, Count:Integer): _TAnsiString;
function _WStrCopy(const S:_TWideString; Index1, Count:Integer): _TWideString;

procedure _PStrDelete(var Dest:_TShortString; Index1, Count:Integer);
procedure _LStrDelete(var Dest:_TAnsiString; Index1, Count:Integer);
procedure _WStrDelete(var Dest:_TWideString; Index1, Count:Integer);

procedure _LStrSetElem(var Dest:_TAnsiString; Index:Integer; Val:AnsiChar);
procedure _WStrSetElem(var Dest:_TWideString; Index:Integer; Val:WideChar);

procedure _PStrInsert(Src:_TShortString;
                      var Dest:_TShortString; Size: Integer; Index1:Integer);
procedure _LStrInsert(Src:_TAnsiString;var Dest:_TAnsiString;Index1:Integer);
procedure _WStrInsert(Src:_TWideString;var Dest:_TWideString;Index1:Integer);

function _LStrFromChar(Val:AnsiChar): _TAnsiString;
function _WStrFromChar(Val:AnsiChar): _TWideString;
function _LStrFromWChar(Val:WideChar): _TAnsiString;
function _WStrFromWChar(Val:WideChar): _TWideString;
function _LStrFromPStr(const Val:_TShortString): _TAnsiString;
function _WStrFromPStr(const Val:_TShortString): _TWideString;
function _LStrFromWStr(const Val:_TWideString): _TAnsiString;
function _WStrFromLStr(const Val:_TAnsiString): _TWideString;
function _LStrFromLArray(Val:Array of Byte): _TAnsiString;
function _WStrFromLArray(Val:Array of Byte): _TWideString;
function _LStrFromWArray(Val:Array of WideChar): _TAnsiString;
function _WStrFromWArray(Val:Array of WideChar): _TWideString;
function _LStrFromLArrayLen(A:Array of Byte; S, N:Integer): _TAnsiString;
function _WStrFromLArrayLen(A:Array of Byte; S, N:Integer): _TWideString;
function _LStrFromWArrayLen(A:Array of WideChar; S, N:Integer): _TAnsiString;
function _WStrFromWArrayLen(A:Array of WideChar; S, N:Integer): _TWideString;
function _LStrFromLArrayZLen(A:Array of Byte; S, N:Integer): _TAnsiString;
function _WStrFromLArrayZLen(A:Array of Byte; S, N:Integer): _TWideString;
function _LStrFromWArrayZLen(A:Array of WideChar; S, N:Integer): _TAnsiString;
function _WStrFromWArrayZLen(A:Array of WideChar; S, N:Integer): _TWideString;

procedure _PStrFromWChar(var Dest:_TShortString; MaxLen:Integer;
                         Src:WideChar);
procedure _PStrFromLStr(var Dest:_TShortString; MaxLen:Integer;
                        Src:_TAnsiString);
procedure _PStrFromWStr(var Dest:_TShortString; MaxLen:Integer;
                        Src:_TWideString);
procedure _PStrFromLArray(var Dest:_TShortString; MaxLen:Integer;
                          Src:Array of Byte);
procedure _PStrFromWArray(var Dest:_TShortString; MaxLen:Integer;
                          Src:Array of WideChar);
procedure _PStrFromLArrayLen(var Dest:_TShortString; MaxLen:Integer;
                             Src:Array of Byte; S, N:Integer);
procedure _PStrFromWArrayLen(var Dest:_TShortString; MaxLen:Integer;
                             Src:Array of WideChar; S, N:Integer);
procedure _PStrFromLArrayZLen(var Dest:_TShortString; MaxLen:Integer;
                              Src:Array of Byte; S, N:Integer);
procedure _PStrFromWArrayZLen(var Dest:_TShortString; MaxLen:Integer;
                              Src:Array of WideChar; S, N:Integer);

function _PStrToString(S:_TShortString; AFormat: String;
                       AProvider: IFormatProvider): String;

{ Unit finalization helper functions }
// .NET Compact Frameworks does not implement AppDomain.CurrentAppDomain
const
  SimpleFinalizer =
    {$IF DEFINED(SIMPLEFINALIZER)
        OR NOT DECLARED(System.AppDomain.CurrentDomain)
        OR NOT DECLARED(System.AppDomain.CurrentDomain.ProcessExit)}
      True;
    {$ELSE}
      False;
    {$IFEND}

var
  _GlobalFinalizerObject: TObject;

type
  _FinalizeHandler = procedure of object;

procedure _AddFinalization(f: _FinalizeHandler);

threadvar
  _ExceptObject: TObject;

function ExceptObject: TObject; deprecated;  // expensive.  Get out of the habit

function MainThread: System.Threading.Thread;

function IsLibrary: Boolean;

var
  IsConsole: Boolean; { True if compiled as console app }

type
  TVCLFreeNotify = procedure(AInstance: TObject);
  TVCLGetClassName = function(AType: System.Type; const ASuggestedName: string): string;
  TVCLInitLocaleOverride = procedure;

var
  VCLFreeNotify: TVCLFreeNotify;
  VCLGetClassName: TVCLGetClassName;
  VCLInitLocaleOverride: TVCLInitLocaleOverride;
  TraditionalClassNames: Boolean = False;

type
  EClassDelegatorError = class(Exception);

resourcestring
  SClassDelegatorNotFound = 'Class delegator not found';
  SClassDelegatorMetaNil = 'Class delegator MetaClass cannot be nil';
  SClassDelegatorMetaMismatch = 'Class delegator MetaClasses do not match';

procedure SetClassDelegator(ATypeDelegator: System.Type); overload; deprecated;
procedure SetClassDelegator(ATypeDelegator: System.Type; AMetaClass: TObject); overload; deprecated;
procedure RemoveClassDelegator(AType: System.Type); deprecated;

type
  IProxySystemSupport = interface
    function GetMethodAddress(AClass: TClass; const AName: string; out ACode: TMethodCode): Boolean;
  end;

var
  ProxySystemSupport: IProxySystemSupport = nil;

implementation

uses
  System.ComponentModel, System.Collections, System.Resources,
  System.Security, System.Security.Permissions;

{ resource string helper functions }

var
  ResourceManagers: Hashtable;

function LoadResString(ID: string): string;
var
  A: System.Reflection.Assembly;
  R: System.Resources.ResourceManager;
begin
  if ResourceManagers = nil then
  begin
    if Assigned(VCLInitLocaleOverride) then
      VCLInitLocaleOverride;
    ResourceManagers := Hashtable.Create;
  end;
  A := System.Reflection.Assembly.GetCallingAssembly;
  R := System.Resources.ResourceManager(ResourceManagers[A]);
  if R = nil then
  begin
    R := System.Resources.ResourceManager.Create('_ResourceStrings', A);
    ResourceManagers[A] := R;
  end;
  Result := R.GetString(ID);
end;

function _LoadResString(AType: System.Type; ID: string): string;
var
  A: System.Reflection.Assembly;
  R: System.Resources.ResourceManager;
begin
  if ResourceManagers = nil then
  begin
    if Assigned(VCLInitLocaleOverride) then
      VCLInitLocaleOverride;
    ResourceManagers := Hashtable.Create;
  end;
  A := AType.Assembly;
  R := System.Resources.ResourceManager(ResourceManagers[A]);
  if R = nil then
  begin
    R := System.Resources.ResourceManager.Create('_ResourceStrings', A);
    ResourceManagers[A] := R;
  end;
  Result := R.GetString(ID);
end;

procedure ConvertError(const ACaption: string);
begin
  raise EConvertError.Create(ACaption);
end;

procedure InvalidCastError(const ACaption: string);
begin
  raise EInvalidCast.Create(ACaption);
end;

procedure OverflowError(const ACaption: string);
begin
  raise EOverflow.Create(ACaption);
end;

// Currency and TDateTime need range and overflow checking
{$IFOPT R-}
  {$DEFINE RangeCheckingOFF}
{$ENDIF}
{$IFOPT Q-}
  {$DEFINE OverflowCheckingOFF}
{$ENDIF}

{$R+}
{$Q+}

// Currency

class constructor Currency.Create;
begin
  FMinValue := $8000000000000000; // -922337203685477.5808
  FMaxValue := $7FFFFFFFFFFFFFFF; //  922337203685477.5807
  FScale := 10000;
end;

constructor Currency.Create(const Value: Double);
begin
  inherited Create;
  try
    FValue := Trunc(Value * FScale);
  except
    OverflowError(SCurrencyOutOfRangeError);
  end;
end;

constructor Currency.Create(const Value: System.Decimal);
begin
  inherited Create;
  FValue := Decimal.ToOACurrency(Value);
end;

function Currency.GeneralFormatString: string;
begin
  if FValue = 0 then
    Result := '0' // .NET has a problem when formatting a zero given a pattern
  else
    Result := '0.####';
end;

function Currency.ToString: string;
begin
  Result := ToString(GeneralFormatString, nil);
end;

function Currency.ToString(AProvider: IFormatProvider): string;
begin
  Result := ToString(GeneralFormatString, AProvider);
end;

function Currency.ToString(AFormat: string; AProvider: IFormatProvider): string;
begin
  Result := Decimal.FromOACurrency(FValue).ToString(AFormat, AProvider);
end;

class function Currency.Parse(const AValue: string): Currency;
begin
  Result.FValue := Decimal.ToOACurrency(Decimal.Parse(AValue));
end;

class function Currency.Parse(const AValue: string;
  AProvider: IFormatProvider): Currency;
begin
  Result.FValue := Decimal.ToOACurrency(Decimal.Parse(AValue, AProvider));
end;

class function Currency.Parse(const AValue: string;
  AStyle: System.Globalization.NumberStyles): Currency;
begin
  Result.FValue := Decimal.ToOACurrency(Decimal.Parse(AValue, AStyle));
end;

class function Currency.Parse(const AValue: string;
  AStyle: System.Globalization.NumberStyles;
  AProvider: IFormatProvider): Currency;
begin
  Result.FValue := Decimal.ToOACurrency(Decimal.Parse(AValue, AStyle, AProvider));
end;

class function Currency.TryParse(const AValue: string;
  AStyle: System.Globalization.NumberStyles; AProvider: IFormatProvider;
  out AResult: Currency): Boolean;
begin
  // Would like to avoid using of try..except,
  //   but alas there isn't a TryParse available for Decimal }
  try
    AResult.FValue := Decimal.ToOACurrency(Decimal.Parse(AValue, AStyle, AProvider));
    Result := True;
  except
    Result := False;
  end;
end;

function Currency.CompareTo(AValue: TObject): Integer;
var
  LCurrency: Currency;
begin
  if AValue is Currency then
    LCurrency := AValue as Currency
  else
    LCurrency := Decimal.ToOACurrency(Convert.ToDecimal(AValue));
  if LCurrency < FValue then
    Result := -1
  else if LCurrency > FValue then
    Result := 1
  else
    Result := 0;
end;

class function Currency.MinValue: Currency;
begin
  Result.FValue := FMinValue;
end;

class function Currency.MaxValue: Currency;
begin
  Result.FValue := FMaxValue;
end;

class function Currency.FromOACurrency(const Value: TOACurrency): Currency;
begin
  Result.FValue := Value;
end;

function Currency.ToOACurrency: TOACurrency;
begin
  Result := FValue;
end;

class function Currency.FromBytes(const AValue: TBytes): Currency;
begin
  Result.FValue := System.BitConverter.ToInt64(AValue, 0);
end;

class function Currency.ToBytes(const Value: Currency): TBytes;
begin
  Result := System.BitConverter.GetBytes(Value.FValue);
end;

class function Currency.FromObject(AObject: TObject): Currency;
begin
  if AObject = nil then
    Result.FValue := 0
  else if AObject is Currency then
    Result.FValue := Currency(AObject).FValue
  else if AObject is Decimal then
    Result.FValue := Decimal.ToOACurrency(Decimal(AObject))
  else if AObject is System.Boolean then
    if Boolean(AObject) then
      Result.FValue := -FScale // Delphi assumes True = -1, in this case -FScale 
    else
      Result.FValue := 0
  else
    try
      Result := Parse(Convert.ToString(AObject));
    except
      Result.FValue := Decimal.ToOACurrency(Convert.ToDecimal(AObject));
    end;
end;

class operator Currency.Trunc(const Value: Currency): Int64;
begin
  Result := Value.FValue div FScale;
end;

class operator Currency.Round(const Value: Currency): Int64;
begin
  Result := Round(Value.FValue / FScale);
end;

class operator Currency.Negative(const Value: Currency): Currency;
begin
  Result.FValue := -Value.FValue;
end;

class operator Currency.Positive(const Value: Currency): Currency;
begin
  Result.FValue := Value.FValue;
end;

class operator Currency.Inc(const Value: Currency): Currency;
begin
  Result.FValue := Value.FValue + FScale;
end;

class operator Currency.Dec(const Value: Currency): Currency;
begin
  Result.FValue := Value.FValue - FScale;
end;

class operator Currency.Add(const Left, Right: Currency): Currency;
begin
  Result.FValue := Left.FValue + Right.FValue;
end;

class operator Currency.Subtract(const Left, Right: Currency): Currency;
begin
  Result.FValue := Left.FValue - Right.FValue;
end;

class operator Currency.Multiply(const Left, Right: Currency): Currency;
begin
  Result.FValue := (Left.FValue * Right.FValue) div FScale;
end;

class operator Currency.Divide(const Left, Right: Currency): Double;
begin
  Result := (Left.FValue / Right.FValue) / FScale;
end;

class operator Currency.Modulus(const Left, Right: Currency): Double;
begin
  Result := (Left.FValue mod Right.FValue) / FScale;
end;

class operator Currency.Equal(const Left, Right: Currency): Boolean;
begin
  Result := Left.FValue = Right.FValue;
end;

class operator Currency.NotEqual(const Left, Right: Currency): Boolean;
begin
  Result := Left.FValue <> Right.FValue;
end;

class operator Currency.LessThan(const Left, Right: Currency): Boolean;
begin
  Result := Left.FValue < Right.FValue;
end;

class operator Currency.LessThanOrEqual(const Left, Right: Currency): Boolean;
begin
  Result := Left.FValue <= Right.FValue;
end;

class operator Currency.GreaterThan(const Left, Right: Currency): Boolean;
begin
  Result := Left.FValue > Right.FValue;
end;

class operator Currency.GreaterThanOrEqual(const Left, Right: Currency): Boolean;
begin
  Result := Left.FValue >= Right.FValue;
end;

class operator Currency.Implicit(const Value: Integer): Currency;
begin
  Result.FValue := Value * FScale;
end;

class operator Currency.Implicit(const Value: Int64): Currency;
begin
  Result.FValue := Value * FScale;
end;

class operator Currency.Implicit(const Value: Double): Currency;
begin
  try
    // Try and avoid floating point creep
    Result.FValue := Trunc(Double(Decimal(Value) * 10000));
  except
    OverflowError(SCurrencyOutOfRangeError);
  end;
end;

class operator Currency.Implicit(const Value: Currency): Double;
begin
  Result := Value.FValue / FScale;
end;

class operator Currency.Implicit(const Value: Extended): Currency;
begin
  try
    // Try and avoid floating point creep
    Result.FValue := Trunc(Double(Decimal(Double(Value)) * 10000));
  except
    OverflowError(SCurrencyOutOfRangeError);
  end;
end;

class operator Currency.Implicit(const Value: Currency): Extended;
begin
  Result := Value.FValue / FScale;
end;

class operator Currency.Implicit(const Value: System.Decimal): Currency;
begin
  Result.FValue := Decimal.ToOACurrency(Value);
end;

class operator Currency.Implicit(const Value: Currency): System.Decimal;
begin
  Result := Decimal.FromOACurrency(Value.FValue);
end;

function Currency.GetTypeCode: TypeCode;
begin
  Result := TypeCode.Object;
end;

function Currency.ToInt16(AProvider: IFormatProvider): SmallInt;
begin
  Result := FValue div FScale;
end;

function Currency.ToInt32(AProvider: IFormatProvider): Integer;
begin
  Result := FValue div FScale;
end;

function Currency.ToSingle(AProvider: IFormatProvider): Single;
begin
  Result := FValue / FScale;
end;

function Currency.ToDouble(AProvider: IFormatProvider): Double;
begin
  Result := FValue / FScale;
end;

function Currency.ToDateTime(AProvider: IFormatProvider): DateTime;
begin
  Result := DateTime.FromOADate(ToDouble(AProvider));
end;

function Currency.ToBoolean(AProvider: IFormatProvider): Boolean;
begin
  Result := FValue <> 0;
end;

function Currency.ToDecimal(AProvider: IFormatProvider): Decimal;
begin
  Result := Decimal.FromOACurrency(FValue);
end;

function Currency.ToSByte(AProvider: IFormatProvider): ShortInt;
begin
  Result := FValue div FScale;
end;

function Currency.ToByte(AProvider: IFormatProvider): Byte;
begin
  Result := FValue div FScale;
end;

function Currency.ToUInt16(AProvider: IFormatProvider): Word;
begin
  Result := FValue div FScale;
end;

function Currency.ToUInt32(AProvider: IFormatProvider): LongWord;
begin
  Result := FValue div FScale;
end;

function Currency.ToInt64(AProvider: IFormatProvider): Int64;
begin
  Result := FValue div FScale;
end;

function Currency.ToUInt64(AProvider: IFormatProvider): UInt64;
begin
  Result := FValue div FScale;
end;

function Currency.ToChar(AProvider: IFormatProvider): Char;
begin
  Result := ToString(AProvider)[1];
end;

function Currency.ToType(AType: System.Type; AProvider: IFormatProvider): TObject;
begin
  if AType is Currency then
    Result := Self
  else
    case System.Type.GetTypeCode(AType) of
      TypeCode.Empty:
        Result := nil;
      // any others?
    else
      Result := Convert.ChangeType(TObject(FValue / FScale), AType, AProvider);
    end;
end;

// TDateTime Value type

class constructor TDateTime.Create;
begin
  FMinValue := System.DateTime.Create(100, 1, 1, 0, 0, 0, 0);
  FMaxValue := System.DateTime.Create(9999, 12, 31, 23, 59, 59, 999);
end;

constructor TDateTime.Create(const AValue: Double);
begin
  inherited Create;
  FValue := System.DateTime.FromOADate(AValue);
end;

constructor TDateTime.Create(const ADays: Integer);
begin
  inherited Create;
  FValue := System.DateTime.FromOADate(ADays);
end;

constructor TDateTime.Create(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Integer);
begin
  inherited Create;
  FValue := System.DateTime.Create(AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond);
end;

function TDateTime.ToString: string;
begin
  Result := FValue.ToString;
end;

function TDateTime.ToString(AProvider: IFormatProvider): string;
begin
  Result := FValue.ToString(AProvider);
end;

function TDateTime.ToString(AFormat: string; AProvider: IFormatProvider): string;
begin
  Result := FValue.ToString(AFormat, AProvider);
end;

class function TDateTime.Parse(const AValue: string): TDateTime;
begin
  Result.FValue := System.DateTime.Parse(AValue);
end;

class function TDateTime.Parse(const AValue: string; AProvider: IFormatProvider): TDateTime;
begin
  Result.FValue := System.DateTime.Parse(AValue, AProvider);
end;

class function TDateTime.Parse(const AValue: string; AProvider: IFormatProvider;
  AStyle: System.Globalization.DateTimeStyles): TDateTime;
begin
  Result.FValue := System.DateTime.Parse(AValue, AProvider, AStyle);
end;

function TDateTime.CompareTo(AValue: TObject): Integer;
begin
  if AValue is TDateTime then
    Result := FValue.CompareTo(TDateTime(AValue).FValue)
  else if AValue is System.DateTime then
    Result := FValue.CompareTo(AValue)
  else
    try
      try
        Result := FValue.CompareTo(Convert.ToDateTime(AValue));
      except
        Result := FValue.CompareTo(System.DateTime.FromOADate(Convert.ToDouble(AValue)));
      end;
    except
      ConvertError(SObjectToDateError);
      Result := 0;
    end;
end;

function TDateTime.Year: Integer;
begin
  Result := FValue.Year;
end;

function TDateTime.Month: Integer;
begin
  Result := FValue.Month;
end;

function TDateTime.Day: Integer;
begin
  Result := FValue.Day;
end;

function TDateTime.Hour: Integer;
begin
  Result := FValue.Hour;
end;

function TDateTime.Minute: Integer;
begin
  Result := FValue.Minute;
end;

function TDateTime.Second: Integer;
begin
  Result := FValue.Second;
end;

function TDateTime.MilliSecond: Integer;
begin
  Result := FValue.MilliSecond;
end;

function TDateTime.DayOfYear: Integer;
begin
  Result := FValue.DayOfYear;
end;

function TDateTime.DayOfWeek: Integer;
begin
  Result := Ord(FValue.DayOfWeek) + 1; // Sunday = 1...Saturday = 7
end;

const
  CDefaultYear = 1899;
  CDefaultMonth = 12;
  CDefaultDay = 30;
  CDefaultHour = 0;
  CDefaultMinute = 0;
  CDefaultSecond = 0;
  CDefaultMilliSecond = 0;

function TDateTime.Time: TDateTime;
begin
  with FValue do
    Result := EncodeTime(Hour, Minute, Second, Millisecond);
end;

function TDateTime.Date: TDateTime;
begin
  Result.FValue := FValue.Date;
end;

class function TDateTime.IsLeapYear(AYear: Word): Boolean;
begin
  Result := System.DateTime.IsLeapYear(AYear);
end;

class function TDateTime.DaysInMonth(AYear, AMonth: Word): Word;
begin
  Result := System.DateTime.DaysInMonth(AYear, AMonth);
end;

class function TDateTime.Now: TDateTime;
begin
  Result.FValue := System.DateTime.Now;
end;

class function TDateTime.TheDate: TDateTime;
begin
  Result := Now.Date;
end;

class function TDateTime.TheTime: TDateTime;
begin
  Result := Now.Time;
end;

class function TDateTime.TheYear: Word;
begin
  Result := Now.Year;
end;

class procedure TDateTime.DecodeDate(const AValue: TDateTime; out AYear, AMonth, ADay: Word); overload;
var
  LDOW: Word;
begin
  DecodeDate(AValue, AYear, AMonth, ADay, LDOW);
end;

class function TDateTime.DecodeDate(const AValue: TDateTime; out AYear, AMonth, ADay, ADOW: Word): Boolean; overload;
begin
  with AValue do
  begin
    AYear := Year;
    if (AYear < 100) or (AYear > 9999) then
    begin
      AYear := 0;
      AMonth := 0;
      ADay := 0;
      ADOW := 0;
      Result := False;
    end
    else
    begin
      AMonth := Month;
      ADay := Day;
      ADOW := DayOfWeek;
      Result := IsLeapYear(AYear);
    end;
  end;
end;

class procedure TDateTime.DecodeTime(const AValue: TDateTime; out AHour, AMinute, ASecond, AMilliSecond: Word);
begin
  with AValue do
  begin
    AHour := Hour;
    AMinute := Minute;
    ASecond := Second;
    AMilliSecond := Millisecond;
  end;
end;

class procedure TDateTime.DecodeDateTime(const AValue: TDateTime; out AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word);
begin
  DecodeDate(AValue, AYear, AMonth, ADay);
  DecodeTime(AValue, AHour, AMinute, ASecond, AMilliSecond);
end;

class function TDateTime.EncodeDate(AYear, AMonth, ADay: Word): TDateTime;
begin
  if not TryEncodeDate(AYear, AMonth, ADay, Result) then
    ConvertError(SDateEncodeError);
end;

class function TDateTime.EncodeTime(AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
begin
  if not TryEncodeTime(AHour, AMinute, ASecond, AMilliSecond, Result) then
    ConvertError(STimeEncodeError);
end;

class function TDateTime.EncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
begin
  if not TryEncodeDateTime(AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond, Result) then
    ConvertError(SDateTimeEncodeError);
end;

class function TDateTime.TryEncodeDate(AYear, AMonth, ADay: Word; out ADate: TDateTime): Boolean;
begin
  Result := TryEncodeDateTime(AYear, AMonth, ADay, CDefaultHour, CDefaultMinute, CDefaultSecond, CDefaultMilliSecond, ADate);
end;

class function TDateTime.TryEncodeTime(AHour, AMinute, ASecond, AMilliSecond: Word; out ATime: TDateTime): Boolean;
begin
  Result := TryEncodeDateTime(CDefaultYear, CDefaultMonth, CDefaultDay, AHour, AMinute, ASecond, AMilliSecond, ATime);
end;

class function TDateTime.TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; out AValue: TDateTime): Boolean;
begin
  Result := not ((AYear < 100) or (AYear > 9999) or
                 (AMonth < 1) or (AMonth > 12) or
                 (ADay < 1) or (ADay > DaysInMonth(AYear, AMonth)) or
                 (AHour > 23) or (AMinute > 59) or (ASecond > 59) or (AMilliSecond > 999));
  if Result then
    AValue.FValue := System.DateTime.Create(AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond);
end;

function TDateTime.ReplaceDate(AYear, AMonth, ADay: Word): TDateTime;
var
  LHour, LMinute, LSecond, LMilliSecond: Word;
begin
  DecodeTime(Self, LHour, LMinute, LSecond, LMilliSecond);
  Result := EncodeDateTime(AYear, AMonth, ADay, LHour, LMinute, LSecond, LMilliSecond);
end;

function TDateTime.ReplaceDate(const ADate: TDateTime): TDateTime;
var
  LYear, LMonth, LDay: Word;
begin
  DecodeDate(ADate, LYear, LMonth, LDay);
  Result := ReplaceDate(LYear, LMonth, LDay);
end;

function TDateTime.ReplaceTime(AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
var
  LYear, LMonth, LDay: Word;
begin
  DecodeDate(Self, LYear, LMonth, LDay);
  Result := EncodeDateTime(LYear, LMonth, LDay, AHour, AMinute, ASecond, AMilliSecond);
end;

function TDateTime.ReplaceTime(const ATime: TDateTime): TDateTime;
var
  LHour, LMinute, LSecond, LMilliSecond: Word;
begin
  DecodeTime(ATime, LHour, LMinute, LSecond, LMilliSecond);
  Result := ReplaceTime(LHour, LMinute, LSecond, LMilliSecond);
end;

function TDateTime.AddMonth(AMonths: Integer): TDateTime;
begin
  Result.FValue := FValue.AddMonths(AMonths);
end;

class function TDateTime.MinValue: TDateTime;
begin
  Result.FValue := FMinValue;
end;

class function TDateTime.MaxValue: TDateTime;
begin
  Result.FValue := FMaxValue;
end;

class function TDateTime.FromOADate(const AValue: TOADate): TDateTime;
begin
  Result.FValue := System.DateTime.FromOADate(AValue);
end;

function TDateTime.ToOADate: TOADate;
begin
  Result := FValue.ToOADate;
end;

class function TDateTime.FromBytes(const AValue: TBytes): TDateTime;
begin
  Result := FromOADate(System.BitConverter.ToDouble(AValue, 0));
end;

class function TDateTime.ToBytes(const AValue: TDateTime): TBytes;
begin
  Result := System.BitConverter.GetBytes(AValue.ToOADate);
end;

class function TDateTime.FromObject(AObject: TObject): TDateTime;
begin
  if AObject is TDateTime then
    Result.FValue := TDateTime(AObject).FValue
  else if AObject is System.DateTime then
    Result := System.DateTime(AObject)
  else if AObject is System.Double then
    Result := FromOADate(Double(AObject))
  else if AObject is System.Boolean then
    if Boolean(AObject) then
      Result.FValue := FromOADate(-1)
    else
      Result.FValue := FromOADate(0)
  else
    try
      // We have to attempt conversion via double first as System.DateTime's
      //  Parse (which TDateTime uses) will interpert strings like '5.01'
      //  as equaling a little after 5am on 12/30/1899.  Crazy but true.
      Result := FromOADate(Convert.ToDouble(AObject));
    except
      Result := Parse(Convert.ToString(AObject));
    end;
end;

class operator TDateTime.Trunc(const AValue: TDateTime): Int64;
begin
  Result := Trunc(AValue.ToOADate);
end;

class operator TDateTime.Round(const AValue: TDateTime): Int64;
begin
  Result := Round(AValue.ToOADate);
end;

class operator TDateTime.Negative(const AValue: TDateTime): Double;
begin
  Result := -(AValue.ToOADate);
end;

class operator TDateTime.Positive(const AValue: TDateTime): Double;
begin
  Result := AValue.ToOADate;
end;

class operator TDateTime.Add(const Left, Right: TDateTime): Double;
begin
  Result := Left.ToOADate + Right.ToOADate;
end;

class operator TDateTime.Add(const Left: TDateTime; const Right: Double): TDateTime;
begin
  Result.FValue := Left.FValue + TimeSpan.FromDays(Right);
end;

class operator TDateTime.Add(const Left: TDateTime; const Right: System.TimeSpan): TDateTime;
begin
  Result.FValue := Left.FValue + Right;
end;

class operator TDateTime.Subtract(const Left, Right: TDateTime): Double;
begin
  Result := Left.ToOADate - Right.ToOADate;
end;

class operator TDateTime.Subtract(const Left: TDateTime; const Right: Double): TDateTime;
begin
  Result.FValue := Left.FValue - TimeSpan.FromDays(Right);
end;

class operator TDateTime.Subtract(const Left: TDateTime; const Right: System.TimeSpan): TDateTime;
begin
  Result.FValue := Left.FValue - Right;
end;

class operator TDateTime.Multiply(const Left, Right: TDateTime): Double;
begin
  Result := Left.ToOADate * Right.ToOADate;
end;

class operator TDateTime.Multiply(const Left: TDateTime; const Right: Double): Double;
begin
  Result := Left.ToOADate * Right;
end;

class operator TDateTime.Divide(const Left, Right: TDateTime): Double;
begin
  Result := Left.ToOADate / Right.ToOADate;
end;

class operator TDateTime.Divide(const Left: TDateTime; const Right: Double): Double;
begin
  Result := Left.ToOADate / Right;
end;

class operator TDateTime.Equal(const Left, Right: TDateTime): Boolean;
begin
  Result := Left.FValue = Right.FValue;
end;

class operator TDateTime.NotEqual(const Left, Right: TDateTime): Boolean;
begin
  Result := Left.FValue <> Right.FValue;
end;

class operator TDateTime.LessThan(const Left, Right: TDateTime): Boolean;
begin
  Result := Left.FValue < Right.FValue;
end;

class operator TDateTime.LessThanOrEqual(const Left, Right: TDateTime): Boolean;
begin
  Result := Left.FValue <= Right.FValue;
end;

class operator TDateTime.GreaterThan(const Left, Right: TDateTime): Boolean;
begin
  Result := Left.FValue > Right.FValue;
end;

class operator TDateTime.GreaterThanOrEqual(const Left, Right: TDateTime): Boolean;
begin
  Result := Left.FValue >= Right.FValue;
end;

class operator TDateTime.Implicit(const AValue: Integer): TDateTime;
begin
  Result := FromOADate(AValue);
end;

class operator TDateTime.Implicit(const AValue: Int64): TDateTime;
begin
  Result := FromOADate(AValue);
end;

class operator TDateTime.Implicit(const AValue: Double): TDateTime;
begin
  Result := FromOADate(AValue);
end;

class operator TDateTime.Implicit(const AValue: TDateTime): Double;
begin
  Result := AValue.ToOADate;
end;

class operator TDateTime.Implicit(const AValue: Extended): TDateTime;
begin
  Result := FromOADate(AValue);
end;

class operator TDateTime.Implicit(const AValue: TDateTime): Extended;
begin
  Result := AValue.ToOADate;
end;

class operator TDateTime.Implicit(const AValue: System.DateTime): TDateTime;
begin
  Result.FValue := AValue;
end;

class operator TDateTime.Implicit(const AValue: TDateTime): System.DateTime;
begin
  Result := AValue.FValue;
end;

function TDateTime.GetTypeCode: TypeCode;
begin
  Result := TypeCode.Object;
end;

function TDateTime.ToInt16(AProvider: IFormatProvider): SmallInt;
begin
  Result := Trunc(ToOADate);
end;

function TDateTime.ToInt32(AProvider: IFormatProvider): Integer;
begin
  Result := Trunc(ToOADate);
end;

function TDateTime.ToSingle(AProvider: IFormatProvider): Single;
begin
  Result := ToOADate;
end;

function TDateTime.ToDouble(AProvider: IFormatProvider): Double;
begin
  Result := ToOADate;
end;

function TDateTime.ToDateTime(AProvider: IFormatProvider): DateTime;
begin
  Result := Self;
end;

function TDateTime.ToBoolean(AProvider: IFormatProvider): Boolean;
begin
  Result := ToOADate <> 0;
end;

function TDateTime.ToDecimal(AProvider: IFormatProvider): Decimal;
begin
  Result := Convert.ToDecimal(ToOADate);
end;

function TDateTime.ToSByte(AProvider: IFormatProvider): ShortInt;
begin
  Result := Trunc(ToOADate);
end;

function TDateTime.ToByte(AProvider: IFormatProvider): Byte;
begin
  Result := Trunc(ToOADate);
end;

function TDateTime.ToUInt16(AProvider: IFormatProvider): Word;
begin
  Result := Trunc(ToOADate);
end;

function TDateTime.ToUInt32(AProvider: IFormatProvider): LongWord;
begin
  Result := Trunc(ToOADate);
end;

function TDateTime.ToInt64(AProvider: IFormatProvider): Int64;
begin
  Result := Trunc(ToOADate);
end;

function TDateTime.ToUInt64(AProvider: IFormatProvider): UInt64;
begin
  Result := Convert.ToUInt64(ToOADate);
end;

function TDateTime.ToChar(AProvider: IFormatProvider): Char;
begin
  Result := ToString(AProvider)[1];
end;

function TDateTime.ToType(AType: System.Type; AProvider: IFormatProvider): TObject;
begin
  if AType is TDateTime then
    Result := Self
  else
    case System.Type.GetTypeCode(AType) of
      TypeCode.Empty:
        Result := FromOADate(0);
      // any others?
    else
      Result := (FValue as IConvertible).ToType(AType, AProvider);
    end;
end;

{$IF DEFINED(RangeCheckingOFF)}
  {$R-}
{$IFEND}
{$IF DEFINED(OverflowCheckingOFF)}
  {$Q-}
{$IFEND}

// Exception support

function ExceptObject: TObject;
begin
  Result := _ExceptObject;
end;

resourcestring
  SAssertionFailed = '{0} ({1} at {2})';

procedure _Assert(const Message, Filename: String; LineNumber: Integer);
var
  LException: EAssertionFailed;
begin
                                                                   
  LException := EAssertionFailed.Create(System.String.Format(SAssertionFailed,
    Message, Filename, TObject(LineNumber)));
  LException.ShortMessage := Message;
  LException.Filename := Filename;
  LException.LineNumber := LineNumber;
  raise LException;
end;

function Assigned(const AGCHandle: GCHandle): boolean;
begin
  Result := AGCHandle.IsAllocated;
end;

var
  LMainThread: System.Threading.Thread;

function MainThread: System.Threading.Thread;
begin
  Result := LMainThread;
end;

var
  LastRandSeed: Integer = -1;
  RandomEngine: System.Random;

procedure InitRandom;
begin
  if LastRandSeed <> RandSeed then
  begin
    if RandSeed = 0 then
      RandomEngine := System.Random.Create
    else
      RandomEngine := System.Random.Create(RandSeed);
    LastRandSeed := RandSeed;
  end;
end;

procedure Randomize;
begin
  LastRandSeed := -1;
  RandSeed := 0;
end;

function Random(const ARange: Integer): Integer;
begin
  InitRandom;
  Result := RandomEngine.Next(ARange);
end;

function Random: Extended;
begin
  InitRandom;
  Result := RandomEngine.NextDouble;
end;

function _Trunc(const AValue: Double): Int64;
begin
  Result := System.Convert.ToInt64(Int(AValue));
end;

function Int(const AValue: Double): Double;
begin
  if AValue > 0 then
    Result := System.Math.Floor(AValue)
  else
    Result := System.Math.Ceiling(AValue);
end;

function Frac(const AValue: Double): Double;
begin
  Result := AValue - Int(AValue);
end;

function Exp(const AValue: Double): Double;
begin
  Result := System.Math.Exp(AValue);
end;

function Ln(const AValue: Double): Double;
begin
  Result := System.Math.Log(AValue);
end;

function Sqrt(const AValue: Double): Double;
begin
  Result := System.Math.Sqrt(AValue);
end;

function Sin(const AValue: Double): Double;
begin
  Result := System.Math.Sin(AValue);
end;

function Cos(const AValue: Double): Double;
begin
  Result := System.Math.Cos(AValue);
end;

function ArcTan(const AValue: Double): Double;
begin
  Result := System.Math.Atan(AValue);
end;

function UpCase(ch : Char): Char;
begin
  Result := System.Char.ToUpper(ch);
end;

function UpCase(ch : AnsiChar): AnsiChar;
begin
  Result := ch;
  case Result of
    'a'..'z':  Dec(Result, Ord('a') - Ord('A'));
  end;
end;

function ValInt64Cvt(const s: string; var Code: Integer; const MinValue, MaxValue: Int64;
  MaxHexLen: Integer): Int64;
var
  i, StartPos: Integer;
  dig: Integer;
  IsNegative: Boolean;
  empty: Boolean;
  hex: Boolean;
  len: Integer;
  LResult: Int64;
begin
  i := 1;
  dig := 0;
  Result := 0;

  len := Length(s);
  if len <= 0 then
  begin
    code := i;
    exit;
  end;
  while (i <= len) and (s[i] = ' ') do
    Inc(i);
  IsNegative := False;
  if i > len then
  begin
    code := i;
    exit;
  end;
  if s[i] = '-' then
  begin
    IsNegative := True;
    Inc(i);
  end
  else if s[i] = '+' then
    Inc(i);
  empty := True;
  hex := False;
  if i > len then
  begin
    code := i;
    exit;
  end;
  case s[i] of
    '$',
    'x',
    'X': begin
           if IsNegative then
           begin
             code := i;
             exit;
           end;
           Hex := True;
           Inc(i);
         end;
    '0': begin
           if IsNegative then
           begin
             code := i;
             exit;
           end;
           Hex := (i < len) and ((s[i+1] = 'X') or (s[i+1] = 'x'));
           if Hex then Inc(i,2);
         end;
  end;
  if i > len then
  begin
    code := i;
    exit;
  end;
  if Hex then
  begin
    StartPos := i;
    while i <= len do
    begin
      case s[i] of
        '0'..'9': dig := Ord(s[i]) -  Ord('0');
        'A'..'F': dig := Ord(s[i]) - (Ord('A') - 10);
        'a'..'f': dig := Ord(s[i]) - (Ord('a') - 10);
      else
        break;
      end;
      Result := Result shl 4 + dig;

      if Result > MaxValue then
        Result := MinValue - (MaxValue - Result) - 1;
      if Result < MinValue then
        Result := MaxValue - (MinValue - Result) + 1;
      Inc(i);
      if (i - StartPos) >= MaxHexLen then
        Break;
      empty := False;
    end;
  end
  else
  begin
    while i <= len do
    begin
      case s[i] of
      '0'..'9': dig := Ord(s[i]) - Ord('0');
      else
        break;
      end;
      if IsNegative then
      begin
        LResult := Result * 10 - dig;
        if LResult > Result then
          Break
        else
          Result := LResult;
      end
      else
      begin
        LResult := Result * 10 + dig;
        if LResult < Result then
          Break
        else
          Result := LResult;
      end;

      if Result > MaxValue then
      begin
        Result := MinValue - (MaxValue - Result) - 1;
        Break;
      end;
      if Result < MinValue then
      begin
        Result := MaxValue - (MinValue - Result) + 1;
        Break;
      end;
      Inc(i);
      empty := False;
    end;
    if (Result <> 0) and (IsNegative <> (Result < 0)) then
      Dec(i);
  end;
  if (i <= len) or empty then
    code := i
  else
    code := 0;
end;

function ValUInt64Cvt(const s: string; var Code: Integer; const MaxValue: UInt64): UInt64;
var
  i: Integer;
  dig: Integer;
  empty: Boolean;
  hex: Boolean;
  len: Integer;
  LResult: UInt64;
begin
  i := 1;
  dig := 0;
  Result := 0;

  len := Length(s);
  if len <= 0 then
  begin
    code := i;
    exit;
  end;
  while (i <= len) and (s[i] = ' ') do
    Inc(i);
  if i > len then
  begin
    code := i;
    exit;
  end;
  if s[i] = '+' then
    Inc(i);
  empty := True;
  hex := False;
  if i > len then
  begin
    code := i;
    exit;
  end;
  case s[i] of
    '$',
    'x',
    'X': begin
           Hex := True;
           Inc(i);
         end;
    '0': begin
           Hex := (i < len) and ((s[i+1] = 'X') or (s[i+1] = 'x'));
           if Hex then Inc(i,2);
         end;
  end;
  if i > len then
  begin
    code := i;
    exit;
  end;
  if Hex then
  begin
    while i <= len do
    begin
      case s[i] of
        '0'..'9': dig := Ord(s[i]) -  Ord('0');
        'A'..'F': dig := Ord(s[i]) - (Ord('A') - 10);
        'a'..'f': dig := Ord(s[i]) - (Ord('a') - 10);
      else
        break;
      end;
      LResult := Result shl 4 + dig;
      if LResult <= Result then
        Break
      else
        Result := LResult;
      if Result > MaxValue then
        break;
      Inc(i);
      empty := False;
    end;
  end
  else
  begin
    while i <= len do
    begin
      case s[i] of
      '0'..'9': dig := Ord(s[i]) - Ord('0');
      else
        break;
      end;
      LResult := Result * 10 + dig;
      if LResult < Result then
        Break
      else
        Result := LResult;
      if Result > MaxValue then
        break;
      Inc(i);
      empty := False;
    end;
  end;
  if (i <= len) or empty then
    code := i
  else
    code := 0;
end;

/// ValExtCvt does not scan to +/- Inf as Delphi for Win32 does
function ValExtCvt(const S: string; var Code: Integer): Double;
var
  IsNegative: Boolean;
  LDouble, LResult: Double;
  I, K, Len, Digit: Integer;

  function ConvertFraction: Boolean;
  var
    Exponent: Double;
  begin
    Code := 0;
    Inc(I);
    Result := I <= Len;
    if not Result then
      Exit;

    // Convert fraction
    K := I;
    LDouble := 0;
    while i <= len do
    begin
      case s[i] of
        '0'..'9': Digit := Ord(s[i]) - Ord('0');
      else
        Code := I;
        Break;
      end;
      LDouble := LDouble * 10 + Digit;
      Inc(I);
    end;
    Exponent := I - K;
    LResult := LResult + (LDouble / Math.Pow(10, Exponent));
    Result := I <= Len;
  end;

  procedure ConvertExponent;
  var
    ExpIsNegative: Boolean;
  begin
    Code := 0;
    ExpIsNegative := False;

    Inc(I);
    if I > Len then
    begin
      Code := I;
      Exit;
    end;

    // Check for sign characters
    if S[I] in ['+', '-'] then
    begin
      ExpIsNegative := S[I] = '-';
      Inc(I);
      if I > Len then
      begin
        Code := I;
        Exit;
      end;
    end;

    // Convert exponent
    LDouble := 0;
    while I <= Len do
    begin
      case S[I] of
        '0'..'9': Digit := Ord(S[I]) - Ord('0');
      else
        Code := I;
        Break;
      end;
      LDouble := LDouble * 10 + Digit;
      Inc(I);
    end;
    if ExpIsNegative then
      LDouble := 0 - LDouble;
    LResult := LResult * Math.Pow(10, LDouble);
  end;

begin
  I := 1;
  Code := 0;
  IsNegative := False;
  Result := 0;

  try
    Len := Length(S);
    if Len <= 0 then
    begin
      Code := 1;
      Exit;
    end;

    // Skip leading blanks
    while (I <= Len) and (S[I] = ' ') do
      Inc(I);
    if I > Len then
    begin
      Code := I;
      Exit;
    end;

    // Check for sign characters
    if S[I] in ['+', '-'] then
    begin
      IsNegative := S[I] = '-';
      Inc(I);
      if I > Len then
      begin
        Code := I;
        Exit;
      end;
    end;

    // Get integer part
    while I <= Len do
    begin
      case S[I] of
        '0'..'9': Digit := Ord(S[I]) - Ord('0');
      else
        Code := I;
        Break;
      end;
      LResult := LResult * 10 + Digit;
      Inc(I);
    end;
    if I > Len then
      Exit;

    // Look for an exponent
    if S[I] in ['e', 'E'] then
      ConvertExponent
    else
    begin
      // Now look for a fraction
      if S[I] = '.' then
        if ConvertFraction then
          // Look for an exponent following the fraction
          if S[I] in ['e', 'E'] then
            ConvertExponent;
    end;
  finally
    if IsNegative then
      Result := - LResult
    else
      Result := LResult;
  end;
end;

function _ValShort(const s: string; var code: Integer): ShortInt;
begin
  Result := ValInt64Cvt(S, Code, Low(Result), High(Result), SizeOf(Result) * 2);
end;

function _ValByte(const s: string; var code: Integer): Byte;
begin
  Result := ValUInt64Cvt(S, Code, High(Result));
end;

function _ValInt(const s: string; var code: Integer): SmallInt;
begin
  Result := ValInt64Cvt(S, Code, Low(Result), High(Result), SizeOf(Result) * 2);
end;

function _ValWord(const s: string; var code: Integer): Word;
begin
  Result := ValUInt64Cvt(S, Code, High(Result));
end;

function _ValLong(const s: string; var code: Integer): LongInt;
begin
  Result := ValInt64Cvt(S, Code, Low(Result), High(Result), SizeOf(Result) * 2);
end;

function _ValULong(const s: string; var code: Integer): LongWord;
begin
  Result := ValUInt64Cvt(S, Code, High(Result));
end;

function _ValInt64(const s: string; var code: Integer): Int64;
begin
  Result := ValInt64Cvt(S, Code, Low(Result), High(Result), SizeOf(Result) * 2);
end;

function _ValUInt64(const s: string; var code: Integer): UInt64;
begin
  Result := ValUInt64Cvt(S, Code, High(Result));
end;

function _ValExt(const s: string; var code: Integer): Double;
begin
  Result := ValExtCvt(S, Code);
end;

function __StrPad(S:String; Width:Integer): String;
begin
  if (Width > 0) and (S <> nil) then
    Result := System.String(S).PadLeft(Width)
  else
    Result := S;
end;

function _Str2Ext(Val: Double; Width, Decimals: Integer): string;
begin
  if Decimals >= 0 then
    Result := __StrPad(System.String.Format('{0,' + Width.ToString + ':F' + Decimals.ToString + '}', TObject(Val)), Width)
  else
    Result := __StrPad(System.Double(Val).ToString('0.' + StringOfChar('0', 14) + 'E+' + StringOfChar('0', 4)), Width);
end;
function _StrLong(Val: Integer; Width: Integer): string;
begin
  Result := __StrPad(System.Convert.ToString(Val), Width);
end;
function _StrUInt64(Val: UInt64; Width: Integer): string;
begin
  Result := __StrPad(System.Convert.ToString(Val), Width);
end;
function _StrInt64(Val: Int64; Width: Integer): string;
begin
  Result := __StrPad(System.Convert.ToString(Val), Width);
end;
function _Str0Ext(Val: Double): string;
begin
  Result := _Str2Ext(Val, 23, -1);
end;
function _Str0Long(Val: Integer): string;
begin
  Result := _StrLong(Val, 0);
end;
function _Str0UInt64(Val: UInt64): string;
begin
  Result := _StrUInt64(Val, 0);
end;
function _Str0Int64(Val: Int64): string;
begin
  Result := _StrInt64(Val, 0);
end;

{ Utility functions }

function BytesOf(const Val: AnsiString): TBytes; overload;
begin
  if Assigned(Val) then
  begin
    SetLength(Result, Length(Val));
    System.Array.Copy(Val, 0, Result, 0, Length(Val));
  end
  else
    SetLength(Result, 0);
end;

function BytesOf(const Val: WideString): TBytes; overload;
begin
  if Assigned(Val) then
    Result := AnsiEncoding.GetBytes(Val)
  else
    SetLength(Result, 0);
end;

function BytesOf(const Val: WideChar): TBytes; overload;
begin
  Result := BytesOf(WideString(Val));
end;

function BytesOf(const Val: AnsiChar): TBytes; overload;
begin
  SetLength(Result, 1);
  Result[0] := Byte(Val);
end;

function StringOf(const Bytes: array of Byte): string;
begin
  if Assigned(Bytes) then
    Result := AnsiEncoding.GetString(Bytes, Low(Bytes), High(Bytes) + 1)
  else
    Result := '';
end;

function PlatformBytesOf(const Value: string): TBytes;
begin
  if Assigned(Value) then
  begin
    if Marshal.SystemDefaultCharSize = 1 then
      Result := AnsiEncoding.GetBytes(Value)
    else
      Result := System.Text.Encoding.Unicode.GetBytes(Value);
  end
  else
    SetLength(Result, 0);
end;

function PlatformStringOf(const Value: TBytes): string;
begin
  if Assigned(Value) then
  begin
    if Marshal.SystemDefaultCharSize = 1 then
      Result := AnsiEncoding.GetString(Value)
    else
      Result := System.Text.Encoding.Unicode.GetString(Value);
  end
  else
    Result := '';
end;

function WideStringOf(const Value: TBytes): WideString;
begin
  if Assigned(Value) then
    Result := System.Text.Encoding.Unicode.GetString(Value)
  else
    Result := '';
end;

function WideBytesOf(const Value: WideString): TBytes;
begin
  if Assigned(Value) then
    Result := System.Text.Encoding.Unicode.GetBytes(Value)
  else
    SetLength(Result, 0);
end;

function DoubleToExtendedAsBytes(const Value: Double): TBytes;
var
  Bits: Int64;
  Significand: Int64;
  Sign, Exponent: Integer;
begin
  SetLength(Result, 10);
  if Value <> 0 then
  begin
    Bits := BitConverter.DoubleToInt64Bits(Value);

    Sign := Bits shr 63;
    Exponent := ((Bits shr 52) and not (1 shr 12)) - 1023 + 16383;
    Significand := (Bits and not (1 shr 54)) shl (64 - 53);

    Result[0] := Significand and $FF;
    Result[1] := (Significand shr 8) and $FF;
    Result[2] := (Significand shr 16) and $FF;
    Result[3] := (Significand shr 24) and $FF;
    Result[4] := (Significand shr 32) and $FF;
    Result[5] := (Significand shr 40) and $FF;
    Result[6] := (Significand shr 48) and $FF;
    Result[7] := (Significand shr 56) or $80;
    Result[8] := Exponent and $FF;
    Result[9] := (Exponent shr 8) or (Sign shr 7);
  end;
end;

function ExtendedAsBytesToDouble(const Bytes: array of Byte): Double;
var
  Bits: Int64;
  Significand: Int64;
  Sign, Exponent: Integer;
begin
  Significand :=
    (Int64(Bytes[0]) or
    (Int64(Bytes[1]) shl 8) or
    (Int64(Bytes[2]) shl 16) or
    (Int64(Bytes[3]) shl 24) or
    (Int64(Bytes[4]) shl 32) or
    (Int64(Bytes[5]) shl 40) or
    (Int64(Bytes[6]) shl 48) or
    (Int64(Bytes[7] and (not $80)) shl 56)) shr (64 - 53);
  Exponent := Bytes[8] or (Bytes[9] shl 8);
  if (Significand = 0) and (Exponent = 0) then
    Result := 0
  else
  begin
    Sign := Exponent shr 15;
    Exponent := (Exponent and not $8000) - 16383;
    Bits := (Int64(Sign) shl 63) or (Int64(Exponent + 1023) shl 52) or Significand;
    Result := BitConverter.Int64BitsToDouble(Bits);
  end;
end;

function CmdLine: string;
begin
  Result := System.Environment.CommandLine;
end;

function ParamCount: Integer;
var
  Params: array of string;
begin
  Params := System.Environment.GetCommandLineArgs;
  Result := Length(Params) - 1;
end;

function ParamStr(Index: Integer): string;
var
  Params: array of string;
  LAssembly: System.Reflection.Assembly;
begin
  if Index = 0 then
  begin
    LAssembly := System.Reflection.Assembly.GetEntryAssembly;
    if Assigned(LAssembly) then
      Result := LAssembly.Location
    else
      Result := System.Diagnostics.Process.GetCurrentProcess.MainModule.FileName;
  end
  else
  begin
    Params := System.Environment.GetCommandLineArgs;
    if Index > Length(Params) - 1 then // avoid exception if Index is out of bounds
      Result := '' // for backward compatibility
    else
      Result := Params[Index];
  end;
end;

{ Text file IO }

const
  cCR = Char($0D);
  cLF = Char($0A);
  cEOF = Char($1A);

threadvar
  InOutRes: Integer;

type
  TDefaultTextFactory = class(System.Object, ITextDeviceFactory)
    function Open(t: Text; Mode: Word): Integer;
    function Close(t: Text): Integer;
  end;

{ TDefaultText }

function TDefaultTextFactory.Open(t: Text; Mode: Word): Integer;
begin
  Result := 0;
  if (t.Mode - fmInput) > (fmInOut - fmInput) then Exit;
  if Mode = fmInput then
  begin            // called by Reset
    t.Reader := System.IO.StreamReader.Create(t.Filename, AnsiEncoding, True);
    t.Writer := nil;
  end
  else if (Mode and fmOutput) = fmOutput then
  begin    // Mode = fmInOut --> called by Append
    t.Writer := System.IO.StreamWriter.Create(t.Filename, Mode = fmInOut);
    t.Reader := nil;
  end;

  if Result = 0 then
    t.Mode := Mode;
end;

function TDefaultTextFactory.Close(t: Text): Integer;
begin
  if t.Reader <> nil then
    (t.Reader as System.IO.StreamReader).BaseStream.Close;
  if t.Writer <> nil then
    (t.Writer as System.IO.StreamWriter).BaseStream.Close;
  t.Reader := nil;
  t.Writer := nil;
  t.Mode := fmClosed;
  Result := 0;
end;

{ Text helpers }

function OpenText(t: Text; Mode: Word): Integer;
begin
  if (t.Mode < fmClosed) or (t.Mode > fmInOut) then
    Result := 102
  else
  begin
    if t.Mode <> fmClosed then _Close(t);

    if t.Factory = nil then
      t.Factory := TDefaultTextFactory.Create;

    Result := t.Factory.Open(t, Mode)
  end;
  if Result <> 0 then SetInOutRes(Result);
end;

procedure _Append(t: Text);
begin
  OpenText(t, fmInOut);
end;

procedure _Assign(var t: Text; const Filename: string);
begin
  if not Assigned(t) then
    t := Text.Create;
  t.Mode := fmClosed;
                                              
//  t.Flags := tfCRLF * Ord(DefaultTextLineBreakStyle);
  t.Filename := Filename;
end;

procedure _Close(t: Text);
var
  Result: Integer;
begin
  if (t.Mode >= fmInput) and (t.Mode <= fmInOut) then
  begin
    Result := t.Factory.Close(t);
    if Result <> 0 then
      SetInOutRes(Result);
  end
  else
    SetInOutRes(103);
end;

procedure Text.Flush;
begin
  if Assigned(Writer) then
    Writer.Flush;
end;

procedure __IOTest;
var
  Res: Integer;
begin
  Res := InOutRes;
  if Res <> 0 then
  begin
    InOutRes := 0;
    case Res of
      2: raise EFileNotFound.Create(SFileNotFound);
      3: raise EInvalidFilename.Create(SInvalidFilename);
      4: raise ETooManyOpenFiles.Create(STooManyOpenFiles);
      5: raise EAccessDenied.Create(SAccessDenied);
      100: raise EEndOfFile.Create(SEndOfFile);
      101: raise EDiskFull.Create(SDiskFull);
      104: raise EFileNotOpenForInput.Create(SFileNotOpenForInput);
      105: raise EFileNotOpenForOutput.Create(SFileNotOpenForOutput);
      106: raise EInvalidInput.Create(SInvalidInput);
    else
      raise ERuntimeError.Create(System.String.Format(sRuntimeErrorCode,
        TObject(Res)));
    end;
  end;
end;

procedure Erase(var t: Text);
var
  F: System.IO.FileInfo;
begin
  if (t.Mode < fmClosed) or (t.Mode > fmInput) then
    SetInOutRes(102)  // file not assigned
  else
  try
    F := System.IO.FileInfo.Create(t.FileName);
    F.Delete;
  except
    SetInOutRes(5);  // access denied
  end;
end;

function Text.ReadAnsiChar: AnsiChar;
begin
  Result := AnsiChar(ReadWideChar);
end;

function Text.ReadInteger: Integer;
var
  Buf: StringBuilder;
  NextChar, I, E: Integer;
begin
  if not SeekEof then
  begin
    NextChar := Reader.Peek;
    Reader.Read;
  end
  else
    NextChar := Reader.Read;

  if (Char(NextChar) <> cEOF) and (NextChar <> -1) then
  begin
    Buf := StringBuilder.Create(32);
    Buf.Append(Char(NextChar));
    I := 1;
    while I <= 32 do
    begin
      if Reader.Peek <= Ord(' ') then Break;
      Buf.Append(Char(Reader.Read));
      Inc(I);
    end;
    Val(Buf.ToString, Result, E);
    if E <> 0 then
      SetInOutRes(106);
  end
  else
    Result := 0;
end;

function Text.ReadInt64: Int64;
var
  Buf: StringBuilder;
  NextChar, I, E: Integer;
begin
  if not SeekEof then
  begin
    NextChar := Reader.Peek;
    Reader.Read;
  end
  else
    NextChar := Reader.Read;

  if (Char(NextChar) <> cEOF) and (NextChar <> -1) then
  begin
    Buf := StringBuilder.Create(32);
    Buf.Append(Char(NextChar));
    I := 1;
    while I <= 32 do
    begin
      if Reader.Peek <= Ord(' ') then Break;
      Buf.Append(Char(Reader.Read));
      Inc(I);
    end;
    Val(Buf.ToString, Result, E);
    if E <> 0 then
      SetInOutRes(106);
  end
  else
    Result := 0;
end;

function Text.ReadUInt64: UInt64;
var
  Buf: StringBuilder;
  NextChar, I, E: Integer;
begin
  if not SeekEof then
  begin
    NextChar := Reader.Peek;
    Reader.Read;
  end
  else
    NextChar := Reader.Read;

  if (Char(NextChar) <> cEOF) and (NextChar <> -1) then
  begin
    Buf := StringBuilder.Create(32);
    Buf.Append(Char(NextChar));
    I := 1;
    while I <= 32 do
    begin
      if Reader.Peek <= Ord(' ') then Break;
      Buf.Append(Char(Reader.Read));
      Inc(I);
    end;
    Val(Buf.ToString, Result, E);
    if E <> 0 then
      SetInOutRes(106);
  end
  else
    Result := 0;
end;

                                                          
{
function ReadLine(t: Text; out Buffer: array of AnsiChar): Integer;
var
  Ch: AnsiChar;
  I: Integer;
  E, P: Cardinal;
begin
  if t.Mode <> fmInput then
    if not TryOpenForInput(t) then
    begin
      Result := 0;
      Exit;
    end;

  I := Low(Buffer);
  E := t.BufEnd;
  P := t.BufPos;
  while I < High(Buffer) do
  begin
    if P < E then
    begin
      Ch := AnsiChar(t.Buffer[P]);
      Inc(P);
    end
    else
    begin
      t.BufPos := P;
      Ch := _ReadChar(t);
      P := t.BufPos;
      E := t.BufEnd;
      if P < E then
        Break;
    end;
    case Ch of
      AnsiChar(cLF): Continue;
      AnsiChar(cCR): Break;
      AnsiChar(cEOF):
        if t.Mode and tfCRLF <> 0 then
          Break
        else
        begin
          Buffer[I] := Ch;
          Inc(I);
        end;
    else
      Buffer[I] := Ch;
      Inc(I);
    end;
  end;

  Result := I;
end;
}

function Text.ReadAnsiString: AnsiString;
begin
  Result := ReadWideString;
end;

function Text.ReadShortString(maxLen: Integer): ShortString;
begin
  Result := Copy(ReadAnsiString, 1, maxLen);
end;

function Text.ReadWideChar: WideChar;
var
  NextChar: Integer;
begin
  if (Mode = fmInput) then
  begin
    NextChar := Reader.Read;
    if NextChar = -1 then
      Result := cEOF
    else
      Result := WideChar(NextChar);
  end
  else
  begin
    SetInOutRes(104);
    Result := cEOF;
  end;
end;

function Text.ReadFloat: Double;
var
  Buf: StringBuilder;
  NextChar, I: Integer;
begin
  if not SeekEof then
  begin
    NextChar := Reader.Peek;
    Reader.Read;
  end
  else
    NextChar := Reader.Read;

  if (Char(NextChar) <> cEOF) and (NextChar <> -1) then
  begin
    Buf := StringBuilder.Create(64);
    Buf.Append(Char(NextChar));
    I := 1;
    while I <= 64 do
    begin
      if Reader.Peek <= Ord(' ') then Break;
      Buf.Append(Char(Reader.Read));
      Inc(I);
    end;
    if not System.Double.TryParse(Buf.ToString,
                System.Globalization.NumberStyles.Float,
                System.Globalization.NumberFormatInfo.InvariantInfo as IFormatProvider,
                Result) then
    begin
      SetInOutRes(106);
    end;
  end
  else
    Result := 0;
end;

                                                          
{
procedure _ReadWCString(t: Text; var S: array of WideChar);
var
  I: Integer;
begin
  if t.Mode <> fmInput then
    if not TryOpenForInput(t) then
      Exit;

  I := 0;
  while I <= High(S) do
  begin
    case t.Reader.Peek of
      -1      : Break;
      Ord(cLF): Break;
      Ord(cCR): Break;
    end;
    S[I] := _ReadWChar(t);
    Inc(I);
  end;
end;
}

function Text.ReadWideString: WideString;
var
  NextChar: Integer;
  Buf: StringBuilder;
begin
  if (Mode = fmInput) then
  begin
    Buf := StringBuilder.Create(256);
    NextChar := Reader.Peek;
    while (NextChar <> Ord(cLF)) and (NextChar <> Ord(cCR)) do
    begin
      NextChar := Reader.Read;
      if NextChar = -1 then Break;
      Buf.Append(WideChar(NextChar));
      NextChar := Reader.Peek;
    end;
    Result := Buf.ToString;
  end
  else
  begin
    SetInOutRes(104);
    Result := '';
  end;
end;

procedure Text.ReadLn;
begin
  if (Mode = fmInput) then
    Reader.ReadLine
  else
    SetInOutRes(104);
end;

procedure _ResetText(t: Text);
begin
  OpenText(t, fmInput);
end;

procedure _RewritText(t: Text);
begin
  OpenText(t, fmOutput);
end;

function Text.Eof: Boolean;
begin
  Result := Assigned(Reader) and (Reader.Peek = -1);
end;

function Text.Eoln: Boolean;
var
  NextChar: Integer;
begin
  Result := False;
  if Assigned(Reader) then
  begin
    NextChar := Reader.Peek;
    if NextChar <> -1 then
      case Char(NextChar) of
        cLF, cCR, cEOF: Result := True;
      else
        Result := False;
      end
    else
      Result := True;
  end
end;

function Text.SeekEof: Boolean;
var
  Ch: Char;
  NextChar: Integer;
begin
  NextChar := Reader.Peek;
  Ch := WideChar(NextChar);
  while ((Ch <> cEOF) and (Ch <= ' ') and (NextChar <> -1)) do
  begin
    Reader.Read;
    NextChar := Reader.Peek;
    Ch := WideChar(NextChar);
  end;
  Result := (Ch = cEOF) or (NextChar = -1);
end;

function Text.SeekEoln: Boolean;
var
  Ch: Char;
begin
  Result := False;
  if Mode = fmInput then
  begin
    Ch := WideChar(Reader.Peek);
    while Ch <= ' ' do
    begin
      case Ch of
        cEOF, cLF, cCR:
          begin
            Result := True;
            Break;
          end;
      else
        Reader.Read;
      end;
      Ch := WideChar(Reader.Peek);
    end;
  end
  else
    SetInOutRes(104);
end;

class constructor Text.Create;
begin
  DefaultTextLineBreakStyle := tlbsCRLF;
end;

procedure Text.WriteSpaces(Count: Integer);
begin
  if Count > 0 then
    Writer.Write(System.String.Create(Char(' '), Count));
end;

function Text.WriteWideString(const S: WideString; Width: Integer): Text;
begin
  if (Mode and fmOutput) <> 0 then
  begin
    if Width > 0 then
      WriteSpaces(Width - Length(S));
    Writer.Write(S);
  end
  else
    SetInOutRes(105);
  Result := Self;
end;

function Text.WriteAnsiChar(Ch: AnsiChar; Width: Integer): Text;
begin
  Result := WriteWideChar(WideChar(Ch), Width);
end;

function Text.WriteWideChar(Ch: WideChar; Width: Integer): Text;
begin
  if (Mode and fmOutput) <> 0 then
  begin
    if Width > 1 then
      WriteSpaces(Width - 1);
    Writer.Write(Ch);
  end
  else
    SetInOutRes(105);
  Result := Self;
end;

function Text.WriteBoolean(Val: Boolean; Width: Integer): Text;
begin
  if Val then
    Result := WriteWideString('True', Width)
  else
    Result := WriteWideString('False', Width);
end;

function Text.WriteInteger(Val, Width: Integer): Text;
begin
  Result := WriteWideString(System.Convert.ToString(Val), Width);
end;

function Text.WriteAnsiString(const S: AnsiString; Width: Integer): Text;
begin
  Result := WriteWideString(S, Width);
end;

function Text.WriteShortString(const S: ShortString; Width: Integer): Text;
begin
  Result := WriteWideString(S, Width);
end;

function Text.WriteFloat(Val: Double; Width, Prec: LongInt): Text;
begin
  if Prec > 0 then
    Result := WriteWideString(System.String.Format('{0,' + Width.ToString + ':F' + Prec.ToString + '}', TObject(Val)), Width)
  else
    Result := WriteWideString(System.Double(Val).ToString('0.' + StringOfChar('0', 14) + 'E+' + StringOfChar('0', 4)), Width);
end;

function Text.WriteInt64(Val: Int64; Width: Integer): Text;
begin
  Result := WriteWideString(System.Convert.ToString(Val), Width);
end;

function Text.WriteUInt64(Val: UInt64; Width: Integer): Text;
begin
  Result := WriteWideString(System.Convert.ToString(Val), Width);
end;

procedure Text.WriteLn;
begin
  if (Mode and fmOutput) <> 0 then
  begin
    Writer.WriteLine;
    Writer.Flush;
  end
  else
    SetInOutRes(105);
end;

procedure SetInOutRes(NewValue: Integer);
begin
  InOutRes := NewValue;
end;

class constructor TextOutput.Create;
begin
  Output := Text.Create;
  Output.Writer := System.Console.Out;
  Output.Reader := nil;
  Output.Mode := fmOutput;
end;

class constructor TextInput.Create;
begin
  Input := Text.Create;
  Input.Reader := System.Console.In;
  Input.Writer := nil;
  Input.Mode := fmInput;
end;

class constructor TextErrOutput.Create;
begin
  ErrOutput := Text.Create;
  ErrOutput.Writer := System.Console.Error;
  ErrOutput.Reader := nil;
  ErrOutput.Mode := fmOutput;
end;

function Output: Text;
begin
  Result := TextOutput.Output;
end;

function Input: Text;
begin
  Result := TextInput.Input;
end;

function ErrOutput: Text;
begin
  Result := TextErrOutput.ErrOutput;
end;

{ Dynamic array helpers }

function _DynArrayCopy(Src: System.Array): System.Array;
begin
  Result := nil;
  if Assigned(Src) then
    Result := System.Array(Src.Clone);
end;

function _DynArrayCopyRange(Src: System.Array;
                            ElemTypeHandle: System.RuntimeTypeHandle;
                            Index, Count: Integer): System.Array;
var
  L: Integer;
begin
  Result := nil;
  if Assigned(Src) and (Count > 0) then
  begin
    // Limit index and count to values within the array
    if Index < 0 then
    begin
      Inc(Count, Index);
      Index := 0;
    end;
    L := Src.Length;
    if Index > L then
      Index := L;
    if Count > L - Index then
      Count := L - Index;
    if Count > 0 then
    begin
      Result := System.Array.CreateInstance(
                  System.Type.GetTypeFromHandle(ElemTypeHandle), Count);
      System.Array.Copy(Src, Index, Result, 0, Count);
    end;
  end;
end;

function _DynArrayHigh(A: System.Array): Integer;
begin
  Result := A.Length - 1;
end;

function _DynArrayLength(A: System.Array): Integer;
begin
  Result := A.Length;
end;

function Pos(const substr, str: AnsiString): Integer;
var
  ch: AnsiChar;
  i, j: Integer;
  LSubStrLen, LStrLen: Integer;
begin
  Result := 0;
  LSubStrLen := Length(substr);
  LStrLen := Length(str);

  if (LStrLen = 0) or (LSubStrLen = 0) then
    Exit;

  ch := substr[1];
  for i := 1 to LStrLen - LSubStrLen do
    if str[i] = ch then
      for j := 2 to LSubStrLen do
        if str[i + j - 1] <> substr[j] then
          break
        else if j = LSubStrLen then
        begin
          Result := i;
          Exit;
        end;
end;

function Pos(const substr, str: WideString): Integer;
begin
  if (Length(str) = 0) or (Length(substr) = 0) then
    Result := 0
  else
    Result := System.String(str).IndexOf(substr) + 1;
end;

procedure ChDir(const S: string);
begin
  System.IO.Directory.SetCurrentDirectory(S);
end;

procedure _LGetDir(D: Byte; var S: AnsiString);
var
  Temp: WideString;
begin
  _WGetDir(D, Temp);
  S := Temp;
end;

procedure _SGetDir(D: Byte; var S: ShortString);
var
  Temp: WideString;
begin
  _WGetDir(D, Temp);
  S := Temp;
end;

procedure _WGetDir(D: Byte; var S: WideString);
begin
                                                                                  
  S := System.IO.Directory.GetCurrentDirectory;
end;

function IOResult: Integer;
begin
  Result := InOutRes;
  InOutRes := 0;
end;

procedure MkDir(const S: string);
begin
  System.IO.Directory.CreateDirectory(S);
end;

procedure RmDir(const S: string);
begin
  System.IO.Directory.Delete(S);
end;

function StringOfChar(ch: AnsiChar; Count: Integer): AnsiString;
var
  temp: array of Byte;
  i: Integer;
begin
  SetLength(temp, Count);
  for i := 0 to Count-1 do
    temp[i] := Byte(ch);
  Result := AnsiString(temp);
end;

function StringOfChar(ch: WideChar; Count: Integer): WideString;
begin
  Result := System.String.Create(ch, Count);
end;

function GetLastError: Integer;
begin
  Result := System.Runtime.InteropServices.Marshal.GetLastWin32Error;
end;

                                                         

function _GetHelperIntf(Instance: TObject; HelperType: System.Type): TObject;
var
  IntfType: System.Type;
begin
  IntfType := HelperType.GetInterfaces()[0];
  if IntfType.IsInstanceOfType(Instance) then
    Result := Instance
  else
    Result := _GetHelperDelegate(Instance, HelperType);
end;

function _GetHelperDelegate(Instance: TObject; HelperType: System.Type): TObject;
var
  Params: array of TObject;
begin
  SetLength(Params, 0);
  Result := System.Activator.CreateInstance(HelperType, Params);
  TClassHelperBase(Result).FInstance := Instance;
end;

function _GetHelperCtorIntf(cls: _TClass; HelperType: System.Type): TObject;
var
  IntfType: System.Type;
begin
  IntfType := HelperType.GetInterfaces()[0];
  if IntfType.IsInstanceOfType(cls) then
    Result := cls
  else
    Result := _GetHelperDelegate(cls, HelperType);
end;

function _GetHelperCtorDelegate(cls: _TClass; HelperType: System.Type): TObject;
var
  Params: array of TObject;
begin
  SetLength(Params, 0);
  Result := System.Activator.CreateInstance(HelperType, Params);
  TClassHelperBase(Result).FInstance := cls;
end;

{ _TClass }

var
  MetaTypeMap: Hashtable;

procedure InitMetaTypeMap;
begin
  if not Assigned(MetaTypeMap) then
    MetaTypeMap := Hashtable.Create;
end;

function _GetMetaFromHandle(ATypeHandle: System.RuntimeTypeHandle): _TClass;
var
  t, save: System.Type;
  ancestor: _TClass;
  ctorInfo: System.Reflection.ConstructorInfo;
begin
  InitMetaTypeMap;

  Result := _TClass(MetaTypeMap[ATypeHandle]);
  if not Assigned(Result) then
  begin
    save := System.Type.GetTypeFromHandle(ATypeHandle);
    t := save;
    if not t.IsSubClassOf(TypeOf(_TClass)) then
    begin
      t := t.GetNestedType('@Meta' + t.name,
        BindingFlags.Public or BindingFlags.NonPublic);
    end;
    if Assigned(t) then
      Result := _TClass(t.GetField('@Instance').GetValue(nil))
    else
    begin                  // Requested type is not a Delphi class
      t := save.BaseType;
      if Assigned(t) then
      begin                // Is it a descendent of a Delphi class?
        ancestor := _GetMetaFromHandle(t.TypeHandle);
        t := System.Object(ancestor).GetType;
        if t.IsSubClassOf(TypeOf(_TClass)) then
        begin              // yes! descendent of a Delphi class
          ctorInfo := t.GetConstructor(System.Type.EmptyTypes);
          if Assigned(ctorInfo) then
          begin            // construct an instance of the Delphi classref
                           // but set its instancetypehandle to this non-Delphi type
            Result := _TClass(ctorInfo.Invoke(nil));
            Result.SetInstanceType(ATypeHandle);
          end;
        end;
      end;
      if not Assigned(Result) then
        Result := _TClass.Create(ATypeHandle);
    end;
    MetaTypeMap.Add(ATypeHandle, Result);
  end;
end;

function _GetMetaFromObject(Obj: TObject): _TClass;
begin
  if Obj = nil then
    Result := nil
  else if Obj is _TClass then
    Result := _TClass(Obj)
  else
    Result := _GetMetaFromHandle(System.Type.GetTypeHandle(Obj));
end;

constructor _TClass.Create;
begin
  inherited Create;
end;

constructor _TClass.Create(ATypeHandle: System.RuntimeTypeHandle);
begin
  inherited Create;
  FInstanceTypeHandle := ATypeHandle;
end;

constructor _TClass.Create(AType: System.Type);
begin
  Create(AType.TypeHandle);
end;

function _TClass.ClassParent: TClass;
var
  t: System.Type;
begin
  if not Assigned(FClassParent) then
  begin
    t := InstanceType.BaseType;
    if Assigned(t) then
      FClassParent := _GetMetaFromHandle(t.TypeHandle);
  end;
  Result := FClassParent;
end;

procedure _TClass.SetInstanceType(ATypeHandle: System.RuntimeTypeHandle);
begin
  if not TObject(FInstanceTypeHandle).Equals(ATypeHandle) then
  begin
    FInstanceTypeHandle := ATypeHandle;
    FClassParent := nil;
  end;
end;

procedure _TClass.SetDelegator(ATypeDelegator: System.Type);
begin
  FClassParent := nil; // resets the ClassParent logic
  FInstanceType := ATypeDelegator;
end;

function _TClass.InstanceTypeHandle: System.RuntimeTypeHandle;
begin
  if FInstanceType <> nil then
    Result := FInstanceType.TypeHandle
  else
    Result := FInstanceTypeHandle;
end;

function _TClass.InstanceType: System.Type;
begin
  if FInstanceType <> nil then
    Result := FInstanceType
  else
    Result := System.Type.GetTypeFromHandle(FInstanceTypeHandle);
end;

function _TClass.Equals(AObj: TObject): Boolean;
var
  AClass: _TClass;
begin
  Result := False;
  if AObj <> nil then
  begin
    AClass := _TClass(AObj);
    if AClass <> nil then
    begin
      if FInstanceTypeHandle.Equals(AClass.FInstanceTypeHandle) then
        Result := True;
    end;
  end;
end;

function _TClass.GetHashCode: Integer;
begin
  Result := FInstanceTypeHandle.GetHashCode;
end;

procedure InternalSetClassDelegator(ATypeDelegator: System.Type; AMetaClass: TObject);
begin
  if not Assigned(MetaTypeMap[ATypeDelegator.TypeHandle]) and (AMetaClass <> nil) then
    MetaTypeMap.Add(ATypeDelegator.TypeHandle, AMetaClass);

  _TClass(MetaTypeMap[ATypeDelegator.TypeHandle]).SetDelegator(ATypeDelegator);
end;

procedure SetClassDelegator(ATypeDelegator: System.Type);
begin
  InitMetaTypeMap;

  if not MetaTypeMap.ContainsKey(ATypeDelegator.TypeHandle) then
    raise EClassDelegatorError.Create(SClassDelegatorNotFound);

  InternalSetClassDelegator(ATypeDelegator, nil);
end;

procedure SetClassDelegator(ATypeDelegator: System.Type; AMetaClass: TObject);
begin
  InitMetaTypeMap;

  if AMetaClass = nil then
    raise EClassDelegatorError.Create(SClassDelegatorMetaNil);

  if MetaTypeMap.ContainsKey(ATypeDelegator.TypeHandle) and
     not (AMetaClass <> MetaTypeMap[ATypeDelegator.TypeHandle]) then
    raise EClassDelegatorError.Create(SClassDelegatorMetaMismatch);

  InternalSetClassDelegator(ATypeDelegator, AMetaClass);
end;

procedure RemoveClassDelegator(AType: System.Type);
begin
  if Assigned(MetaTypeMap) then
  begin
    if not MetaTypeMap.ContainsKey(AType.TypeHandle) then
      raise EClassDelegatorError.Create(SClassDelegatorNotFound);

    _TClass(MetaTypeMap[AType.TypeHandle]).SetDelegator(nil);
  end;
end;


{ MessageMethodAttribute }

constructor MessageMethodAttribute.Create(AID: Integer);
begin
  inherited Create;
  FID := AID;
end;

{ RuntimeRequiredAttribute }

constructor RuntimeRequiredAttribute.Create;
begin
  inherited Create;
end;

{ TMethodMap }

function GetMessageID(Obj: TObject): Integer;
var
  Field: FieldInfo;
begin
  Field := Obj.GetType.GetFields[0];
  Result := Integer(Field.GetValue(Obj));
end;

var
  MethodMaps: Hashtable;

type
  TMethodMap = class
  private
    FMethods: Hashtable;
    FDefault: MethodInfo;
    function GetItems(Index: Integer): MethodInfo;
  public
    constructor Create(ClassType: System.Type);
    property Items[Index: Integer]: MethodInfo read GetItems; default;
    property Default: MethodInfo read FDefault;
  end;

constructor TMethodMap.Create(ClassType: System.Type);
var
  MethodInfos: array of MethodInfo;
  MethodInfoIndex: Integer;
  MethodInfo: System.Reflection.MethodInfo;
  Attributes: array of TObject;
  AttributeIndex: Integer;
  Attribute: TObject;
  Params: array of ParameterInfo;
begin
  inherited Create;
  FMethods := Hashtable.Create;
  MethodInfos := ClassType.GetMethods(BindingFlags.Public or
    BindingFlags.NonPublic or BindingFlags.Instance or BindingFlags.DeclaredOnly);
  for MethodInfoIndex := Low(MethodInfos) to High(MethodInfos) do
  begin
    MethodInfo := MethodInfos[MethodInfoIndex];
    Attributes := MethodInfo.GetCustomAttributes(TypeOf(MessageMethodAttribute), False);
    if Length(Attributes) > 0 then
    begin
      Params := MethodInfo.GetParameters;
      if Length(Params) = 1 then
        for AttributeIndex := Low(Attributes) to High(Attributes) do
        begin
          Attribute := Attributes[AttributeIndex];
          FMethods[TObject((Attribute as MessageMethodAttribute).ID)] := MethodInfo;
        end;
    end;
  end;
  FDefault := ClassType.GetMethod('DefaultHandler', BindingFlags.Public or
    BindingFlags.Instance or BindingFlags.DeclaredOnly);
  if Assigned(FDefault) and (Length(FDefault.GetParameters) <> 1) then
    FDefault := nil;
end;

function TMethodMap.GetItems(Index: Integer): MethodInfo;
begin
  Result := FMethods[TObject(Index)] as MethodInfo;
end;

{ TObjectHelper }

procedure TObjectHelper.Free;
begin
  if (Self <> nil) and (Self is IDisposable) then
  begin
    if Assigned(VCLFreeNotify) then
      VCLFreeNotify(Self);
    (Self as IDisposable).Dispose;
  end;
end;

function TObjectHelper.ClassType: TClass;
begin
  Result := TClass(ClassInfo);
end;

class function TObjectHelper.ClassName: string;
var
  LType: System.Type;
begin
  // get the real type name
  LType := _TClass(Self).InstanceType;
  Result := LType.Name;

  // traditional classnames?
  if TraditionalClassNames then
  begin
    if LType.Equals(TypeOf(TObject)) then
      Result := 'TObject' // DO NOT LOCALIZE
    else if LType.Equals(TypeOf(TGUID)) then
      Result := 'TGUID';
    // Can't do TInterfacedObject = TObject
    // Don't need to do Exception = System.Exception
    // Anything else?

    // see if VCL wants to take a pass at it
    if Assigned(VCLGetClassName) then
      Result := VCLGetClassName(LType, Result)
  end;
end;

class function TObjectHelper.ClassNameIs(const Name: string): Boolean;
begin
  Result := System.String.Compare(ClassName, Name, True) = 0; 
end;

class function TObjectHelper.ClassParent: TClass;
begin
  Result := _TClass(Self).ClassParent;
end;

class function TObjectHelper.ClassInfo: System.Type;
begin
  Result := _TClass(Self).InstanceType;
end;

class function TObjectHelper.InheritsFrom(AClass: TClass): Boolean;
var
  SelfType: System.Type;
  AClassType: System.Type;
begin
  Result := False;
  if not Assigned(Self) or not Assigned(AClass) then Exit;
  SelfType := Self.ClassInfo;
  AClassType := AClass.ClassInfo;
  Result := AClassType.IsAssignableFrom(SelfType);
end;

class function TObjectHelper.MethodAddress(const AName: string): TMethodCode;
begin
  if not Assigned(ProxySystemSupport) or
     not ProxySystemSupport.GetMethodAddress(Self, AName, Result) then
  begin
    if Length(AName) > 0 then
                                                               
      Result := _TClass(Self).InstanceType.GetMethod(AName,
        BindingFlags.Public or BindingFlags.NonPublic or
        BindingFlags.InvokeMethod or BindingFlags.Instance)
                                                   
    else
      Result := nil;
  end;
end;

class function TObjectHelper.MethodName(ACode: TMethodCode): string;
begin
  if (ACode = nil) or (ACode.Name = '') or (ACode.DeclaringType = nil) or 
     (not ACode.DeclaringType.Equals(ClassInfo)) then
    Result := ''
  else
    Result := ACode.Name;
end;

function TObjectHelper.FieldAddress(const AName: string): TObject;
begin
  if Length(AName) > 0 then
    Result := TypeOf(Self).GetField(AName)
  else
    Result := nil;
end;

procedure TObjectHelper.Dispatch(var Message);
var
  BoxedMsg: TObject;
  ID: Integer;
  InstanceType: System.Type;
  MethodMap: TMethodMap;
  Method: MethodInfo;
  DefaultMethod: MethodInfo;
  ParamType: System.Type;
  Params: array of TObject;
  TypeChanged: Boolean;
begin
  BoxedMsg := TObject(Message);
  ID := GetMessageID(BoxedMsg);
  InstanceType := Self.GetType;
  SetLength(Params, 1);
  DefaultMethod := nil;
  while InstanceType <> nil do
  begin
    if MethodMaps = nil then
      MethodMaps := Hashtable.Create;
    MethodMap := MethodMaps[TObject(InstanceType.TypeHandle)] as TMethodMap;
    if not Assigned(MethodMap) then
    begin
      // MethodMap not found, create one.
      MethodMap := TMethodMap.Create(InstanceType);
      MethodMaps[TObject(InstanceType.TypeHandle)] := MethodMap;
    end;
    Method := MethodMap[ID];
    if Assigned(Method) then
    begin
      ParamType := Method.GetParameters[0].ParameterType;
      if ParamType.IsByRef then
        ParamType := ParamType.GetElementType;
      TypeChanged := False;
      if ParamType.IsInstanceOfType(BoxedMsg) then
        Params[0] := BoxedMsg
      else
      begin
        TypeChanged := True;
        Params[0] := Convert.ChangeType(BoxedMsg, ParamType);
      end;
      try
        Method.Invoke(Self, Params);
      except
        on E: Exception do
        begin
          while (E is TargetInvocationException) and
            (TargetInvocationException(E).InnerException <> nil) do
            E := TargetInvocationException(E).InnerException;
          raise E;
        end;
      end;
      if not TypeChanged then
        Message := Params[0];
      Exit;
    end
    else
    begin
      if not Assigned(DefaultMethod) then
        DefaultMethod := MethodMap.Default;
      InstanceType := InstanceType.BaseType;
    end;
  end;
  if Assigned(DefaultMethod) then
  begin
    Params[0] := BoxedMsg;
    try
      DefaultMethod.Invoke(Self, Params);
    except
      on E: Exception do
      begin
        while (E is TargetInvocationException) and
          (TargetInvocationException(E).InnerException <> nil) do
          E := TargetInvocationException(E).InnerException;
        raise E;
      end;
    end;
    Message := Params[0];
  end;
end;

constructor TMethod.Create(AData: TObject; ACode: TMethodCode);
begin
  inherited Create;
  Data := AData;
  Code := ACode;
end;

constructor TMethod.Create(AData: TObject; const AName: string);
begin
  inherited Create;
  Data := AData;
  Code := AData.MethodAddress(AName);
end;

function TMethod.Clone: TMethod;
begin
  Result := TMethod.Create(Data, Code);
end;

function TMethod.CanInvoke: Boolean;
begin
  Result := not IsEmpty and (Code is MethodInfo);
end;

function TMethod.Invoke(AParams: array of TObject): TObject;
begin
  if CanInvoke then
    Result := MethodInfo(Code).Invoke(Data, AParams)
  else
    raise EMethodInvokeError.Create(SMethodInvokeError);
end;

function TMethod.ToString: string;
begin
  if Data = nil then
    if Code = nil then
      Result := '{Empty}'
    else
    begin
      Result := TObject.MethodName(Code);
      if Result = '' then
        Result := '{NIL}';         // DO NOT LOCALIZE
      Result := '{NIL}.' + Result; // DO NOT LOCALIZE
    end
  else
    Result := Data.ClassInfo.FullName + TObject.MethodName(Code);
end;

function TMethod.IsEmpty: Boolean;
begin
  Result := (Data = nil) and (Code = nil);
end;

class function TMethod.Empty: TMethod;
begin
  Result := TMethod.Create(nil, nil);
end;

class operator TMethod.Implicit(ADelegate: Delegate): TMethod;
var
  LDelegates: array of Delegate;
begin
  if ADelegate = nil then
    Result := TMethod.Empty
  else
  begin
    LDelegates := ADelegate.GetInvocationList;
    case Length(LDelegates) of
      0: Result := TMethod.Empty;
      1: Result := TMethod.Create(LDelegates[0].Target, LDelegates[0].Method);
    else
      raise EMethodMultiError.Create(SMethodMultiError);
    end;
  end;
end;

class operator TMethod.Equal(const ALeft, ARight: TMethod): Boolean;
begin
  Result := (ALeft.Data = ARight.Data) and (ALeft.Code = ARight.Code);
end;

class operator TMethod.NotEqual(const ALeft, ARight: TMethod): Boolean;
begin
  Result := not ((ALeft.Data = ARight.Data) and (ALeft.Code = ARight.Code));
end;


function _CreateCastException(Obj:TObject; CastType: System.Type): TObject;
begin
  Result := EInvalidCast.Create(SInvalidCast);
end;

function _CreateRangeException: TObject;
begin
  Result := ERangeError.Create(SRangeError);
end;

function _ClassCreate(Cls: TClass; Params: Array of TObject): TObject;
begin
  Result := System.Activator.CreateInstance(Cls.ClassInfo, Params);
end;

{ TSetElementTypeAttribute Attribute }

constructor TSetElementTypeAttribute.Create(AElementType:System.Type);
begin
  inherited Create;
  FElementType := AElementType;
end;

{constructor TTypeCopyAttribute.Create(ABaseType: System.Type);
begin
  inherited Create;
  FBaseType := ABaseType;
end;
}

{ TSignedSubrangeAttribute Attribute }

constructor TSignedSubrangeAttribute.Create(AMinValue, AMaxValue: Integer;
                                            ABaseType: System.Type);
begin
  inherited Create;
  FMinValue := AMinValue;
  FMaxValue := AMaxValue;
  FBaseType := ABaseType;
end;

constructor TSignedSubrangeAttribute.Create(AMinValue, AMaxValue: Int64;
                                            ABaseType: System.Type);
begin
  inherited Create;
  FMinValue := AMinValue;
  FMaxValue := AMaxValue;
  FBaseType := ABaseType;
end;

{ TUnsignedSubrangeAttribute Attribute }

constructor TUnsignedSubrangeAttribute.Create(AMinValue, AMaxValue: Cardinal;
                                              ABaseType: System.Type);
begin
  inherited Create;
  FMinValue := AMinValue;
  FMaxValue := AMaxValue;
  FBaseType := ABaseType;
end;

constructor TUnsignedSubrangeAttribute.Create(AMinValue, AMaxValue: UInt64;
                                              ABaseType: System.Type);
begin
  inherited Create;
  FMinValue := AMinValue;
  FMaxValue := AMaxValue;
  FBaseType := ABaseType;
end;

{ TAliasTypeAttribute Attribute }

constructor TAliasTypeAttribute.Create(AAliasType: System.Type);
begin
  inherited Create;
  FAliasType := AAliasType;
end;

{ TShortStringAttribute Attribute }

constructor TShortStringAttribute.Create(Size:Byte);
begin
  inherited Create;
  FSize := Size;
end;

{ TPackageAttribute Attribute }

constructor TPackageAttribute.Create(flags: Integer; const dcpFileName: string);
begin
  inherited Create;
  FFlags := TPackageFlags(flags);
  FDcpFileName := dcpFileName;
end;

procedure _Halt(Code: Integer);
begin
  System.Environment.Exit(Code);
end;

procedure _Halt0;
begin
  _Halt(0);
end;

{ Set helper functions }

function _SetNew(Size:Integer): _TSet;
begin
  // SetLength(Result, Size);
  Result := New(_TSet, Size);
end;

function _SetElem(Elem,Size:Integer): _TSet;
begin
  Result := _SetNew(Size);
  if (Elem >= 0) and (Elem < Size * 8) then
    Result[Elem DIV 8] := 1 SHL (Elem MOD 8);
end;

function _SetRange(aLo,aHi,aSize:Integer): _TSet;
var
  D: _TSet;
  I: Integer;
  loIndex, hiIndex: Integer;
  loMask, hiMask: Byte;
begin
  Result := _SetNew(aSize);
  D := Result;
  if aHi >= aSize * 8 then
    aHi := aSize * 8 - 1;
  if aLo < 0 then
    aLo := 0;
  if aLo <= aHi then
  begin
    loMask := $FF SHL (aLo MOD 8);
    loIndex := aLo DIV 8;
    hiMask := Longword($FF) SHR (7 - (aHi MOD 8));
    hiIndex := aHi DIV 8;
    for I := loIndex to hiIndex do
      D[I] := $FF;
    D[loIndex] := D[loIndex] and loMask;
    D[hiIndex] := D[hiIndex] and hiMask;
  end;
end;

function _SetRangeUInt64(aLo,aHi,aSize:Integer): UInt64;
var
  loMask, hiMask: UInt64;
begin
  if aHi >= aSize * 8 then
    aHi := aSize * 8 - 1;
  if aLo < 0 then
    aLo := 0;
  Result := 0;
  if aLo <= aHi then
  begin
    loMask := NOT(UInt64(0)) SHL aLo;
    hiMask := NOT(UInt64(0)) SHR (63 - aHi);
    Result := loMask and hiMask;
  end;
end;


// dHi := destination_high_bound / 8 + 1
// dLo := destination_low_bound / 8
// sHi := source_high_bound / 8 + 1
// sLo := source_low_bound / 8
function _SetExpand(const Src:_TSet; dHi,dLo,sHi,sLo:Integer): _TSet;
var
  I: Integer;
begin
  if not Assigned(Src) then
    Result := Src
  else
  begin
    Result := _SetNew(dHi - dLo);
    for I := 0 to sHi-sLo-1 do
      Result[I+sLo-dLo] := Src[I];
  end;
end;

function _SetExpandFromUInt64(Src:UInt64; dHi,dLo,sHi,sLo:Integer): _TSet;
var
  I: Integer;
begin
  Result := _SetNew(dHi - dLo);
  for I := 0 to sHi-sLo-1 do
    Result[I+sLo-dLo] := Byte(Src SHR (I * 8));
end;

function _SetExpandToUInt64(const Src:_TSet; dHi,dLo,sHi,sLo:Integer): UInt64;
var
  I: Integer;
begin
  Result := 0;
  if Assigned(Src) then
  begin
    for I := 0 to dHi-dLo-1 do
      Result := Result or (UInt64(Src[I+dLo-sLo]) SHL (I * 8));
  end;
end;

function _SetExpandUInt64(Src:UInt64; dHi,dLo,sHi,sLo:Integer): UInt64;
begin
  Result := Src and not ((not UInt64(0)) SHL ((sHi - sLo) * 8));
  if sLo >= dLo then
    Result := Result SHL ((sLo - dLo) * 8)
  else
    Result := Result SHR ((dLo - sLo) * 8);
  Result := Result and not ((not UInt64(0)) SHL ((dHi - dLo) * 8));
end;

function _SetClone(const Src:_TSet; Size:Integer): _TSet;
var
  I: Integer;
begin
  if not Assigned(Src) then
    Result := Src
  else
  begin
    Result := _SetNew(Size);
    for I := 0 to Size-1 do
      Result[I] := Src[i];
  end;
end;

function _SetEq(const L, R:_TSet; Size:Integer): Boolean;
var
  I: Integer;
begin
  Result := False;
  if Assigned(L) or Assigned(R) then
  begin
    for I := 0 to Size-1 do
      if L[I] <> R[I] then Exit;
  end;
  Result := True;
end;

function _SetLe(const L, R:_TSet; Size:Integer): Boolean;
var
  I: Integer;
begin
  Result := False;
  if Assigned(L) then
  begin
    if not Assigned(R) then
    begin
      for I := 0 to size-1 do
        if L[I] <> 0 then Exit;
    end
    else
    begin
      for I := 0 to size-1 do
        if (L[I] and not R[I]) <> 0 then Exit;
    end;
  end;
  Result := True;
end;

function  _SetTest(const Src:_TSet; Elem,Size:Integer): Boolean;
begin
  Result := False;
  if Assigned(Src) and (Elem >= 0) and (Elem < Size * 8) then
    Result := (Src[Elem DIV 8] AND (1 SHL (Elem MOD 8))) <> 0;
end;

procedure _SetAsg(var Dest:_TSet; const Src:_TSet; Size:Integer);
begin
  Dest := _SetClone(Src, Size);
end;

procedure _SetIntersect(var Dest:_TSet; const Src:_TSet; Size:Integer);
var
  I: Integer;
begin
  if Assigned(Src) then
  begin
    if not Assigned(Dest) then
      Dest := _SetNew(Size)
    else
      for I := 0 to Size-1 do
        Dest[I] := Dest[I] and Src[I];
  end;
end;

procedure _SetUnion(var Dest:_TSet; const Src:_TSet; Size:Integer);
var
  I: Integer;
begin
  if Assigned(Src) then
  begin
    if not Assigned(Dest) then
      Dest := _SetNew(Size);
    for I := 0 to size-1 do
      Dest[I] := Dest[I] or Src[I];
  end;
end;

procedure _SetSub(var Dest:_TSet; const Src:_TSet; Size:Integer);
var
  I: Integer;
begin
  if Assigned(Src) then
  begin
    if not Assigned(Dest) then
      Dest := _SetNew(Size)
    else
      for I := 0 to Size-1 do
        Dest[I] := Dest[I] and not Src[I];
  end;
end;

procedure _SetInclude(var Dest:_TSet; Elem,Size:Integer);
begin
  if not Assigned(Dest) then
    Dest := _SetNew(Size);
  if (Elem >= 0) and (Elem < Size * 8) then
    Dest[Elem DIV 8] := Dest[Elem DIV 8] OR (1 SHL (Elem MOD 8));
end;

procedure _SetExclude(var Dest:_TSet; Elem,Size:Integer);
begin
  if Assigned(Dest) and (Elem >= 0) and (Elem < Size * 8) then
    Dest[elem DIV 8] := Dest[Elem DIV 8] AND NOT(1 SHL (Elem MOD 8));
end;

{ String helper functions }

function _PStrNew(Size:Integer): _TShortString;
begin
  // SetLength(Result, Size);
  Result := New(_TShortString, Size);
end;

function _PStrLen(const Dest:_TShortString): Integer;
begin
  Result := 0;
  if Assigned(Dest) then
    Result := Byte(Dest[0]);
end;

function _LStrLen(const Dest:_TAnsiString): Integer;
begin
  Result := 0;
  if Assigned(Dest) then
    Result := Length(Dest);
end;

function _WStrLen(const Dest:_TWideString): Integer;
begin
  Result := 0;
  if Assigned(Dest) then
    Result := Length(Dest);
end;

procedure _PStrSetLen(var Dest:_TShortString; Len:Integer);
begin
  if Assigned(Dest) then
    TBytes(Dest)[0] := Byte(Len);
end;

procedure _LStrSetLen(var Dest:_TAnsiString; Len:Integer);
begin
  // SetLength(Dest, Len);
  Dest := New(_TAnsiString, Len);
end;

procedure _LStrAsg(var Dest:_TAnsiString; Src:_TAnsiString);
begin
  Dest := Src;
end;

procedure _PStrClear(out Dest:_TShortString);
begin
  Dest := _TShortString(System.Array(nil));
end;

procedure _LStrClear(var Dest:_TAnsiString);
begin
  Dest := _TAnsiString(System.Array(nil));
end;

procedure _WStrClear(var Dest:_TWideString);
begin
  Dest := _TWideString(System.String(nil));
end;

function _AStrCmp(const L, R:Array of Byte; Size:Integer): Integer;
var
  I, NL, NR: Integer;
  CL, CR: Byte;
begin
  NL := Length(L);
  NR := Length(R);
  I := 0;
  while (I < NL) and (I < NR) and (I < Size) do
  begin
    CL := L[I];
    CR := R[I];
    if CL <> CR then
    begin
      if Ord(CL) < Ord(CR) then
        Result := -1
      else
        Result := 1;
      Exit;
    end;
    Inc(I);
  end;
  if I <= NL then
    Result := 1
  else if I <= NR then
    Result := -1
  else
    Result := 0;
end;

function _PStrCmp(const L, R:_TShortString): Integer;
var
  I, NL, NR: Integer;
  CL, CR: _TShortStringElem;
begin
  NL := _PStrLen(L);
  NR := _PStrLen(R);
  I := 1;
  while (I <= NL) and (I <= NR) do
  begin
    CL := L[I];
    CR := R[I];
    if CL <> CR then
    begin
      if Ord(CL) < Ord(CR) then
        Result := -1
      else
        Result := 1;
      Exit;
    end;
    Inc(I);
  end;
  if I <= NL then
    Result := 1
  else if I <= NR then
    Result := -1
  else
    Result := 0;
end;

function _LStrCmp(const L, R:_TAnsiString): Integer;
var
  I, NL, NR: Integer;
  CL, CR: _TAnsiStringElem;
begin
  NL := _LStrLen(L);
  NR := _LStrLen(R);
  I := 0;
  while (I < NL) and (I < NR) do
  begin
    CL := L[I];
    CR := R[I];
    if CL <> CR then
    begin
      if Ord(CL) < Ord(CR) then
        Result := -1
      else
        Result := 1;
      Exit;
    end;
    Inc(I);
  end;
  if I < NL then
    Result := 1
  else if I < NR then
    Result := -1
  else
    Result := 0;
end;

function _WStrCmp(const L, R:_TWideString): Integer;
var
  I, NL, NR: Integer;
  CL, CR: WideChar;
begin
  NL := _WStrLen(L);
  NR := _WStrLen(R);
  I := 1;
  while (I <= NL) and (I <= NR) do
  begin
    CL := L[I];
    CR := R[I];
    if CL <> CR then
    begin
      if Ord(CL) < Ord(CR) then
        Result := -1
      else
        Result := 1;
      Exit;
    end;
    Inc(I);
  end;
  if I <= NL then
    Result := 1
  else if I <= NR then
    Result := -1
  else
    Result := 0;
end;

procedure _PStrNCat(var Dest:_TShortString; Src:_TShortString; Size:Integer);
var
  I, N: Integer;
begin
  N := _PStrLen(Src);
  if N > 0 then
  begin
    if not Assigned(Dest) then
      Dest := _PStrNew(Size);
    I := Integer(Byte(Dest[0]));
    if I + N <= Size then
      Size := I + N
    else
      N := Size - I;
    if N > 0 then
    begin
      Dest[0] := _TShortStringElem(Size);
      System.Array.Copy(Src, 1, Dest, 1 + I, N);
    end;
  end;
end;

procedure _PStrCat(var Dest:_TShortString; Src:_TShortString);
begin
  _PStrNCat(Dest, Src, 255);
end;

procedure _PStrNCpy(var Dest:_TShortString; Src:_TShortString; Size:Integer);
var
  N: Integer;
begin
  N := _PStrLen(Src);
  if N > Size then
    N := Size;
  if N > 0 then
  begin
    if not Assigned(Dest) then
      Dest := _PStrNew(Size);
    System.Array.Copy(Src, 1, Dest, 1, N);
  end;
  _PStrSetLen(Dest, N);
end;

procedure _PStrCpy(var Dest:_TShortString; Src:_TShortString);
begin
  _PStrNCpy(Dest, Src, 255);
end;

procedure _PStrAsg(var Dest:_TShortString; Src:_TShortString; Size:Integer);
begin
  _PStrNCpy(Dest, Src, Size);
end;

function _LStrConcat2(const L, R:_TAnsiString): _TAnsiString;
var
  NL, NR: Integer;
begin
  _LStrClear(Result);
  NL := _LStrLen(L);
  NR := _LStrLen(R);
  if NL + NR > 0 then
  begin
    _LStrSetLen(Result, NL + NR);
    if NL > 0 then
      System.Array.Copy(TBytes(L), 0, TBytes(Result), 0, NL);
    if NR > 0 then
      System.Array.Copy(TBytes(R), 0, TBytes(Result), NL, NR);
  end;
end;

function _WStrConcat2(const L, R:_TWideString): _TWideString;
begin
  Result := System.String.Concat(L, R);
end;

function _LStrConcatN(Strs:array of _TAnsiString): _TAnsiString;
var
  I, N, L: Integer;
begin
  _LStrClear(Result);
  L := 0;
  for I := Low(Strs) to High(Strs) do
    Inc(L, _LStrLen(Strs[I]));
  if L > 0 then
  begin
    _LStrSetLen(Result, L);
    L := 0;
    for I := Low(Strs) to High(Strs) do
    begin
      N := _LStrLen(Strs[I]);
      if N > 0 then
      begin
        System.Array.Copy(TBytes(Strs[I]), 0, TBytes(Result), L, N);
        Inc(L, N);
      end;
    end;
  end;
end;

function _WStrConcatN(Strs:array of _TWideString): _TWideString;
begin
  Result := System.String.Concat(Strs);
end;

procedure _PStrSubstring(var Dest:_TShortString; Size: Integer;
                         const Src:_TShortString;
                         Index1, Count:Integer);
var
  L: Integer;
begin
  L := _PStrLen(Src);
  if L <= 0 then
    Count := 0;
  if Index1 <= 0 then
    Index1 := 1
  else if Index1 > L then
    Count := 0; // I := L;
  if Count <= 0 then
    Count := 0
  else if Count > L - (Index1 - 1) then
    Count := L - (Index1 - 1);
  if Count > Size - 1 then
    Count := Size - 1;
  if Count > 0 then
  begin
    if not Assigned(Dest) then
      Dest := _PStrNew(Size);
    System.Array.Copy(TBytes(Src), Index1, TBytes(Dest), 1, Count);
  end;
  _PStrSetLen(Dest, Count);
end;

function _LStrCopy(const S:_TAnsiString; Index1, Count:Integer): _TAnsiString;
var
  I, L: Integer;
begin
  Result := nil;
  if Count > 0 then
  begin
    L := _LStrLen(S);
    if (L > 0) and (Index1 <= L) then
    begin
      if Index1 <= 0 then
        I := 0
      else
        I := Index1 - 1;
      if Count > L - I then
        Count := L - I;
      if Count > 0 then
      begin
        SetLength(Result, Count);
        System.Array.Copy(TBytes(S), I, TBytes(Result), 0, Count);
      end;
    end;
  end;
end;

function _WStrCopy(const S:_TWideString; Index1, Count:Integer): _TWideString;
var
  I, L: Integer;
begin
  Result := '';
  if Count > 0 then
  begin
    L := _WStrLen(S);
    if (L > 0) and (Index1 <= L) then
    begin
      if Index1 <= 0 then
        I := 0
      else
        I := Index1 - 1;
      if Count > L - I then
        Count := L - I;
      if Count > 0 then
        Result := System.String(S).Substring(I, Count);
    end;
  end;
end;

procedure _PStrDelete(var Dest:_TShortString; Index1, Count:Integer);
var
  I, L: Integer;
begin
  if Count > 0 then
  begin
    L := _PStrLen(Dest);
    if (L > 0) and (Index1 <= L) then
    begin
      if Index1 <= 0 then
        I := 0
      else
        I := Index1 - 1;
      if Count > L - I then
        Count := L - I;
      if Count > 0 then
      begin
        if I + Count < L then
          System.Array.Copy(TBytes(Dest), I + Count + 1,
                            TBytes(Dest), I + 1, L - Count - I);
        _PStrSetLen(Dest, L - Count);
      end;
    end
  end;
end;

procedure _LStrDelete(var Dest:_TAnsiString; Index1, Count:Integer);
var
  I, L: Integer;
  B: TBytes;
begin
  if Count > 0 then
  begin
    L := _LStrLen(Dest);
    if (L > 0) and (Index1 <= L) then
    begin
      if Index1 <= 0 then
        I := 0
      else
        I := Index1 - 1;
      if Count > L - I then
        Count := L - I;
      if Count > 0 then
      begin
        SetLength(B, L - Count);
        if I > 0 then
          System.Array.Copy(TBytes(Dest), 0, B, 0, I);
        if I + Count < L then
          System.Array.Copy(TBytes(Dest), I + Count, B, I, L - Count - I);
        Dest := _TAnsiString(B);
      end;
    end
  end;
end;

procedure _WStrDelete(var Dest:_TWideString; Index1, Count:Integer);
var
  I, L: Integer;
begin
  if Count > 0 then
  begin
    L := _WStrLen(Dest);
    if (L > 0) and (Index1 <= L) then
    begin
      if Index1 <= 0 then
        I := 0
      else
        I := Index1 - 1;
      if Count > L - I then
        Count := L - I;
      if Count > 0 then
        Dest := System.String(Dest).Remove(I, Count)
    end
  end;
end;

procedure _LStrSetElem(var Dest:_TAnsiString; Index:Integer; Val:AnsiChar);
begin
  if Assigned(Dest) then
  begin
    Dest := _TAnsiString(System.Array(Dest).Clone);
    Dest[Index] := _TAnsiStringElem(Val);
  end;
end;

procedure _WStrSetElem(var Dest:_TWideString; Index:Integer; Val:WideChar);
begin
  Dest := System.String.Concat(
                System.String(Dest).Substring(0, Index),
                System.String.Create(Val, 1),
                System.String(Dest).Substring(Index + 1));
end;

procedure _PStrInsert(Src:_TShortString;
                      var Dest:_TShortString; Size: Integer; Index1:Integer);
var
  SL, DL, I: Integer;
begin
  SL := _PStrLen(Src);
  if SL > 0 then
  begin
    DL := _PStrLen(Dest);
    if Index1 <= 1 then
      I := 0
    else
    begin
      I := Index1 - 1;
      if I > DL then
        I := DL;
    end;
    if I + SL + 1 > Size then
      SL := Size - I - 1;
    if SL + DL + 1 > Size then
      DL := Size - SL - 1;
    if not Assigned(Dest) then
      Dest := _PStrNew(Size);
    _PStrSetLen(Dest, SL + DL);
    if I < DL then
      System.Array.Copy(TBytes(Dest), 1+I, TBytes(Dest), 1+I+SL, DL-I);
    System.Array.Copy(TBytes(Src), 1, TBytes(Dest), 1+I, SL);
  end;
end;

procedure _LStrInsert(Src:_TAnsiString;var Dest:_TAnsiString; Index1:Integer);
var
  SL, DL, I: Integer;
  B: TBytes;
begin
  SL := _PStrLen(Src);
  if SL > 0 then
  begin
    DL := _PStrLen(Dest);
    if Index1 <= 1 then
      I := 0
    else
    begin
      I := Index1 - 1;
      if I > DL then
        I := DL;
    end;
    B := TBytes(Dest);
    SetLength(Dest, SL + DL);
    if I > 0 then
      System.Array.Copy(B, 0, TBytes(Dest), 0, I);
    System.Array.Copy(TBytes(Src), 0, TBytes(Dest), I, SL);
    if I < DL then
      System.Array.Copy(B, I, TBytes(Dest), I + SL, DL - I);
  end;
end;

procedure _WStrInsert(Src:_TWideString;var Dest:_TWideString;Index1:Integer);
var
  SL, DL, I: Integer;
  S1, S2: _TWideString;
begin
  SL := _WStrLen(Src);
  if SL > 0 then
  begin
    DL := _WStrLen(Dest);
    if Index1 <= 1 then
      I := 0
    else
    begin
      I := Index1 - 1;
      if I > DL then
        I := DL;
      if I > 0 then
        S1 := System.String(Dest).Substring(0, I);
    end;
    if I < DL then
      S2 := System.String(Dest).Substring(I);
    Dest := System.String.Concat(S1, Src, S2);
  end;
end;


function _LStrFromChar(Val:AnsiChar): _TAnsiString;
begin
  _LStrSetLen(Result, 1);
  Result[0] := _TAnsiStringElem(Val);
end;

function _WStrFromChar(Val:AnsiChar): _TWideString;
begin
  Result := System.String.Create(WideChar(Val), 1);
end;

function _LStrFromWChar(Val:WideChar): _TAnsiString;
begin
  Result := AnsiEncoding.GetBytes(System.String.Create(Val, 1));
end;

function _WStrFromWChar(Val:WideChar): _TWideString;
begin
  Result := System.String.Create(Val, 1);
end;

function _LStrFromPStr(const Val:_TShortString): _TAnsiString;
var
  N: Integer;
begin
  _LStrClear(Result);
  N := _PStrLen(Val);
  if N > 0 then
  begin
    SetLength(Result, N);
    System.Array.Copy(TBytes(Val), 1, TBytes(Result), 0, N);
  end;
end;

function _WStrFromPStr(const Val:_TShortString): _TWideString;
var
  N: Integer;
begin
  _WStrClear(Result);
  N := _PStrLen(Val);
  if N > 0 then
    Result := AnsiEncoding.GetString(TBytes(Val), 1, N);
end;

function _LStrFromWStr(const Val:_TWideString): _TAnsiString;
begin
  _LStrClear(Result);
  if Assigned(Val) then
    Result := _TAnsiString(AnsiEncoding.GetBytes(Val));
end;

function _WStrFromLStr(const Val:_TAnsiString): _TWideString;
begin
  _WStrClear(Result);
  if Assigned(Val) then
    Result := AnsiEncoding.GetString(TBytes(Val));
end;

function _LStrFromLArray(Val:Array of Byte): _TAnsiString;
var
  L: Integer;
begin
  _LStrClear(Result);
  L := Length(Val);
  if L > 0 then
  begin
    SetLength(Result, L);
    System.Array.Copy(Val, TBytes(Result), L);
  end;
end;

function _WStrFromLArray(Val:Array of Byte): _TWideString;
begin
  _WStrClear(Result);
  if Assigned(Val) then
    Result := AnsiEncoding.GetString(TBytes(Val));
end;


function _LStrFromWArray(Val:Array of WideChar): _TAnsiString;
begin
  _LStrClear(Result);
  if Assigned(Val) then
    Result := AnsiEncoding.GetBytes(Val);
end;

function _WStrFromWArray(Val:Array of WideChar): _TWideString;
begin
  _WStrClear(Result);
  if Assigned(Val) then
    Result := System.String.Create(Val);
end;

function _LStrFromLArrayLen(A:Array of Byte; S, N:Integer): _TAnsiString;
var
  L: Integer;
begin
  _LStrClear(Result);
  L := Length(A);
  if L > 0 then
  begin
    if S + N > L then
      N := L - S;
    if S < L then
    begin
      SetLength(Result, N);
      System.Array.Copy(TBytes(A), TBytes(Result), N);
    end;
  end;
end;

function _WStrFromLArrayLen(A:Array of Byte; S, N:Integer): _TWideString;
var
  L: Integer;
begin
  _WStrClear(Result);
  L := Length(A);
  if L > 0 then
  begin
    if S + N > L then
      N := L - S;
    if S < L then
      Result := AnsiEncoding.GetString(TBytes(A), S, N);
  end;
end;


function _LStrFromWArrayLen(A:Array of WideChar; S, N:Integer): _TAnsiString;
var
  L: Integer;
begin
  _LStrClear(Result);
  L := Length(A);
  if L > 0 then
  begin
    if S + N > L then
      N := L - S;
    if S < L then
      Result := AnsiEncoding.GetBytes(A, S, N);
  end;
end;

function _WStrFromWArrayLen(A:Array of WideChar; S, N:Integer): _TWideString;
var
  L: Integer;
begin
  _WStrClear(Result);
  L := Length(A);
  if L > 0 then
  begin
    if S + N > L then
      N := L - S;
    if S < L then
      Result := System.String.Create(A, S, N);
  end;
end;

function __LArrayZLen(A:Array of Byte; S, N:Integer): Integer;
var
  I: Integer;
begin
  Result := Length(A);
  if Result > 0 then
  begin
    if S + N > Result then
      N := Result - S;
    if S > Result then
      Result := 0
    else
    begin
      for I := S to N-1 do
      begin
        if A[I] = _TAnsiStringElem(0) then
        begin
          Result := I - S;
          break;
        end;
      end;
    end;
  end;
end;

function __WArrayZLen(A:Array of WideChar; S, N:Integer): Integer;
var
  I: Integer;
begin
  Result := Length(A);
  if Result > 0 then
  begin
    if S + N > Result then
      N := Result - S;
    if S > Result then
      Result := 0
    else
    begin
      for I := S to N-1 do
      begin
        if A[I] = WideChar(0) then
        begin
          Result := I - S;
          break;
        end;
      end;
    end;
  end;
end;

function _LStrFromLArrayZLen(A:Array of Byte; S, N:Integer): _TAnsiString;
begin
  Result := _LStrFromLArrayLen(A, S, __LArrayZLen(A, S, N));
end;

function _WStrFromLArrayZLen(A:Array of Byte; S, N:Integer): _TWideString;
begin
  Result := _WStrFromLArrayLen(A, S, __LArrayZLen(A, S, N));
end;

function _LStrFromWArrayZLen(A:Array of WideChar; S, N:Integer): _TAnsiString;
begin
  Result := _LStrFromWArrayLen(A, S, __WArrayZLen(A, S, N));
end;

function _WStrFromWArrayZLen(A:Array of WideChar; S, N:Integer): _TWideString;
begin
  Result := _WStrFromWArrayLen(A, S, __WArrayZLen(A, S, N));
end;

procedure __PStrFromBytes(var Dest:_TShortString; MaxLen:Integer;
                          const Src:TBytes);
var
  N: Integer;
begin
  N := Length(Src);
  if N > MaxLen then
    N := MaxLen;
  if N > 0 then
  begin
    if not Assigned(Dest) then
      Dest := _PStrNew(MaxLen + 1);
    System.Array.Copy(Src, 0, Dest, 1, N);
  end;
  _PStrSetLen(Dest, N);
end;

procedure _PStrFromWChar(var Dest:_TShortString; MaxLen:Integer;
                         Src:WideChar);
var
  B: TBytes;
  S: String;
begin
  S := System.String.Create(Src, 1);
  B := TBytes(AnsiEncoding.GetBytes(S));
  __PStrFromBytes(Dest, MaxLen, B);
end;

procedure _PStrFromLStr(var Dest:_TShortString; MaxLen:Integer;
                        Src:_TAnsiString);
begin
  __PStrFromBytes(Dest, MaxLen, TBytes(Src));
end;

procedure _PStrFromWStr(var Dest:_TShortString; MaxLen:Integer;
                        Src:_TWideString);
var
  B: TBytes;
begin
  B := nil;
  if Assigned(Src) then
    B := TBytes(AnsiEncoding.GetBytes(Src));
  __PStrFromBytes(Dest, MaxLen, B);
end;

procedure _PStrFromLArray(var Dest:_TShortString; MaxLen:Integer;
                          Src:Array of Byte);
begin
  __PStrFromBytes(Dest, MaxLen, TBytes(Src))
end;

procedure _PStrFromWArray(var Dest:_TShortString; MaxLen:Integer;
                          Src:Array of WideChar);
var
  B: TBytes;
begin
  B := nil;
  if Assigned(Src) then
    B := TBytes(AnsiEncoding.GetBytes(Src));
  __PStrFromBytes(Dest, MaxLen, B);
end;

procedure _PStrFromLArrayLen(var Dest:_TShortString; MaxLen:Integer;
                             Src:Array of Byte; S, N:Integer);
var
  B: TBytes;
begin
  B := nil;
  if Assigned(Src) then
  begin
    B := New(TBytes, N);
    System.Array.Copy(TBytes(Src), S, B, 0, N);
  end;
  __PStrFromBytes(Dest, MaxLen, B);
end;

procedure _PStrFromWArrayLen(var Dest:_TShortString; MaxLen:Integer;
                             Src:Array of WideChar; S, N:Integer);
var
  B: TBytes;
begin
  B := nil;
  if Assigned(Src) then
    B := TBytes(AnsiEncoding.GetBytes(Src, S, N));
  __PStrFromBytes(Dest, MaxLen, B);
end;

procedure _PStrFromLArrayZLen(var Dest:_TShortString; MaxLen:Integer;
                              Src:Array of Byte; S, N:Integer);
begin
  _PStrFromLArrayLen(Dest, MaxLen, Src, S, __LArrayZLen(Src, S, N));
end;

procedure _PStrFromWArrayZLen(var Dest:_TShortString; MaxLen:Integer;
                              Src:Array of WideChar; S, N:Integer);
begin
  _PStrFromWArrayLen(Dest, MaxLen, Src, S, __WArrayZLen(Src, S, N));
end;

function _PStrToString(S:_TShortString; AFormat: String;
                       AProvider: IFormatProvider): String;
begin
  Result := _WStrFromPStr(S);
  if Assigned(AFormat) then
    Result := System.String.Format(AProvider, AFormat, [Result]);
end;


{ _AnsiString }

class operator _AnsiString.Add(const Left, Right: _AnsiString): _AnsiString;
begin
  Result.Data := _LStrConcat2(Left.Data, Right.Data);
end;

function _AnsiString.CompareTo(AValue: TObject): Integer;
begin
  if AValue is _AnsiString then
    Result := _LStrCmp(Data, _AnsiString(AValue).Data)
  else
  begin
                                                                              
    InvalidCastError(SInvalidCastString);
    Result := 0;
  end;
end;

constructor _AnsiString.Create(AData: _TAnsiString);
begin
  Data := AData;
end;

class operator _AnsiString.Equal(const Left, Right: _AnsiString): Boolean;
begin
  Result := _LStrCmp(Left, Right) = 0;
end;

function _AnsiString.get_Chars(At: Integer): AnsiChar;
begin
  Result := AnsiChar(Data[At - 1]);
end;

function _AnsiString.GetTypeCode: TypeCode;
begin
  Result := TypeCode.Object;
end;

class operator _AnsiString.GreaterThan(const Left, Right: _AnsiString): Boolean;
begin
  Result := _LStrCmp(Left, Right) > 0;
end;

class operator _AnsiString.GreaterThanOrEqual(const Left,
  Right: _AnsiString): Boolean;
begin
  Result := _LStrCmp(Left, Right) >= 0;
end;

class operator _AnsiString.Implicit(Value: _TAnsiString): _AnsiString;
begin
  Result.Data := Value;
end;

class operator _AnsiString.Implicit(Value: string): _AnsiString;
begin
  Result.Data := _LStrFromWStr(Value);
end;

class operator _AnsiString.Implicit(Value: WideChar): _AnsiString;
begin
  Result.Data := _LStrFromWChar(Value);
end;

class operator _AnsiString.Implicit(Value: _AnsiString): string;
begin
  Result := _WStrFromLStr(Value.Data);
end;

class operator _AnsiString.Implicit(Value: _AnsiString): _TAnsiString;
begin
  Result := Value.Data;
end;

class operator _AnsiString.Implicit(Value: AnsiChar): _AnsiString;
begin
  Result.Data := _LStrFromChar(Value);
end;

function _AnsiString.Length: Integer;
begin
  Result := _LStrLen(Data);
end;

class operator _AnsiString.LessThan(const Left, Right: _AnsiString): Boolean;
begin
  Result := _LStrCmp(Left, Right) < 0;
end;

class operator _AnsiString.LessThanOrEqual(const Left, Right: _AnsiString): Boolean;
begin
  Result := _LStrCmp(Left, Right) <= 0;
end;

class operator _AnsiString.NotEqual(const Left, Right: _AnsiString): Boolean;
begin
  Result := _LStrCmp(Left, Right) <> 0;
end;

procedure _AnsiString.set_Chars(At: Integer; AChar: AnsiChar);
begin
  _LStrSetElem(Data, At, AChar);
end;

function _AnsiString.ToBoolean(AProvider: IFormatProvider): Boolean;
begin
  Result := Convert.ToBoolean(ToString(AProvider));
end;

function _AnsiString.ToByte(AProvider: IFormatProvider): Byte;
begin
  Result := Convert.ToByte(ToString(AProvider));
end;

function _AnsiString.ToChar(AProvider: IFormatProvider): Char;
begin
  Result := Convert.ToChar(ToString(AProvider));
end;

function _AnsiString.ToDateTime(AProvider: IFormatProvider): DateTime;
begin
  Result := Convert.ToDateTime(ToString(AProvider));
end;

function _AnsiString.ToDecimal(AProvider: IFormatProvider): Decimal;
begin
  Result := Convert.ToDecimal(ToString(AProvider));
end;

function _AnsiString.ToDouble(AProvider: IFormatProvider): Double;
begin
  Result := Convert.ToDouble(ToString(AProvider));
end;

function _AnsiString.ToInt16(AProvider: IFormatProvider): SmallInt;
begin
  Result := Convert.ToInt16(ToString(AProvider));
end;

function _AnsiString.ToInt32(AProvider: IFormatProvider): Integer;
begin
  Result := Convert.ToInt32(ToString(AProvider));
end;

function _AnsiString.ToInt64(AProvider: IFormatProvider): Int64;
begin
  Result := Convert.ToInt64(ToString(AProvider));
end;

function _AnsiString.ToSByte(AProvider: IFormatProvider): ShortInt;
begin
  Result := Convert.ToSByte(ToString(AProvider));
end;

function _AnsiString.ToSingle(AProvider: IFormatProvider): Single;
begin
  Result := Convert.ToSingle(ToString(AProvider));
end;

function _AnsiString.ToString: string;
begin
  Result := _WStrFromLStr(Data);
end;

function _AnsiString.ToString(AProvider: IFormatProvider): string;
begin
  Result := System.String(ToString).ToString(AProvider);
end;

function _AnsiString.ToString(AFormat: String;
                              AProvider: IFormatProvider): String;
begin
  Result := ToString;
  if Assigned(AFormat) then
    Result := System.String.Format(AProvider, AFormat, [Result]);
end;

function _AnsiString.ToType(AType: System.Type;
  AProvider: IFormatProvider): TObject;
begin
  Result := Convert.ChangeType(ToString(AProvider), AType, AProvider);
end;

function _AnsiString.ToUInt16(AProvider: IFormatProvider): Word;
begin
  Result := Convert.ToUInt16(ToString(AProvider));
end;

function _AnsiString.ToUInt32(AProvider: IFormatProvider): LongWord;
begin
  Result := Convert.ToUInt32(ToString(AProvider));
end;

function _AnsiString.ToUInt64(AProvider: IFormatProvider): UInt64;
begin
  Result := Convert.ToUInt64(ToString(AProvider));
end;

{ Unit finalization helper functions }
var
  OnProcessExit: _FinalizeHandler;

procedure _AddFinalization(f: _FinalizeHandler);
begin
//  Include(OnProcessExit, @f);
 OnProcessExit := _FinalizeHandler(System.Delegate.Combine(
                System.Delegate(@f), System.Delegate(@OnProcessExit)));
end;

type
  TFinalObject = class
  public
    procedure Finalize; override;
  end;

procedure TFinalObject.Finalize;
begin
  if Assigned(OnProcessExit) then
    OnProcessExit;
  inherited;
end;

procedure ProcessExitHook(sender: System.Object; eventArgs: System.EventArgs);
begin
  if Assigned(OnProcessExit) then
  begin
    OnProcessExit;
    OnProcessExit := nil;
  end;
end;

function IsLibrary: Boolean;
begin
  Result := Assembly.GetCallingAssembly.EntryPoint = nil;
end;

initialization
                                                           
{ $IF SimpleFinalizer}
  { $MESSAGE WARN 'Using simple finalizer'}
  _GlobalFinalizerObject := TFinalObject.Create;
{ $ELSE}
//  Include(System.AppDomain.CurrentDomain.ProcessExit, ProcessExitHook);
{ $IFEND}

  AnsiEncoding := System.Text.Encoding.Default;
  LMainThread := System.Threading.Thread.CurrentThread;
end.
