{ *********************************************************************** }
{                                                                         }
{ Delphi Visual Component Library                                         }
{                                                                         }
{ Copyright (c) 1995-2004 Borland Software Corporation                    }
{                                                                         }
{ *********************************************************************** }

unit Borland.Vcl.SysUtils;

interface

uses
  System.Threading, System.Text, System.IO, Windows;

const

{ File open modes }

  fmOpenRead       = $0000;
  fmOpenWrite      = $0001;
  fmOpenReadWrite  = $0002;

  fmShareCompat    = $0000 platform; // DOS compatibility mode is not portable
  fmShareExclusive = $0010;
  fmShareDenyWrite = $0020;
  fmShareDenyRead  = $0030 platform; // write-only not supported on all platforms
  fmShareDenyNone  = $0040;

{ File attribute constants }

  faReadOnly  = $00000001 platform;
  faHidden    = $00000002 platform;
  faSysFile   = $00000004 platform;
  faVolumeID  = $00000008 platform;
  faDirectory = $00000010;
  faArchive   = $00000020 platform;
  faAnyFile   = $0000003F;

type
{ Standard Character set type }

  TSysCharSet = set of AnsiChar;
  
  SeparatorType = string;

{ MultiByte Character Set (MBCS) byte type }
  TMbcsByteType = (mbSingleByte, mbLeadByte, mbTrailByte);

{ System Locale information record }
  TSysLocale = packed record
    DefaultLCID: Integer;
    PriLangID: Integer;
    SubLangID: Integer;
    FarEast: Boolean;
    MiddleEast: Boolean;
  end;

{ This is used by TLanguages }
  TLangRec = packed record
    FName: string;
    FLCID: LCID;
    FExt: string;
  end;

{ This stores the languages that the system supports }
  TLanguages = class
  private
    FSysLangs: array of TLangRec;
    FLocalesCallbackDelegate: TFNLocaleEnumProc;
    function LocalesCallback(LocaleID: IntPtr): Integer;
    function GetExt(Index: Integer): string;
    function GetID(Index: Integer): string;
    function GetLCID(Index: Integer): LCID;
    function GetName(Index: Integer): string;
    function GetNameFromLocaleID(ID: LCID): string;
    function GetNameFromLCID(const ID: string): string;
    function GetCount: Integer;
  public
    constructor Create;
    function IndexOf(ID: LCID): Integer;
    property Count: Integer read GetCount;
    property Name[Index: Integer]: string read GetName;
    property NameFromLocaleID[ID: LCID]: string read GetNameFromLocaleID;
    property NameFromLCID[const ID: string]: string read GetNameFromLCID;
    property ID[Index: Integer]: string read GetID;
    property LocaleID[Index: Integer]: LCID read GetLCID;
    property Ext[Index: Integer]: string read GetExt;
  end platform;

{ Currency and date/time formatting options

  The initial values of these variables are fetched from the system registry
  using the GetLocaleInfo function in the Win32 API. The description of each
  variable specifies the LOCALE_XXXX constant used to fetch the initial
  value.

  CurrencyString - Defines the currency symbol used in floating-point to
  decimal conversions. The initial value is fetched from LOCALE_SCURRENCY.

  CurrencyFormat - Defines the currency symbol placement and separation
  used in floating-point to decimal conversions. Possible values are:

    0 = '$1'
    1 = '1$'
    2 = '$ 1'
    3 = '1 $'

  The initial value is fetched from LOCALE_ICURRENCY.

  NegCurrFormat - Defines the currency format for used in floating-point to
  decimal conversions of negative numbers. Possible values are:

    0 = '($1)'      4 = '(1$)'      8 = '-1 $'      12 = '$ -1'
    1 = '-$1'       5 = '-1$'       9 = '-$ 1'      13 = '1- $'
    2 = '$-1'       6 = '1-$'      10 = '1 $-'      14 = '($ 1)'
    3 = '$1-'       7 = '1$-'      11 = '$ 1-'      15 = '(1 $)'

  The initial value is fetched from LOCALE_INEGCURR.

  ThousandSeparator - The character used to separate thousands in numbers
  with more than three digits to the left of the decimal separator. The
  initial value is fetched from LOCALE_STHOUSAND.  A value of #0 indicates
  no thousand separator character should be output even if the format string
  specifies thousand separators.

  DecimalSeparator - The character used to separate the integer part from
  the fractional part of a number. The initial value is fetched from
  LOCALE_SDECIMAL.  DecimalSeparator must be a non-zero value.

  CurrencyDecimals - The number of digits to the right of the decimal point
  in a currency amount. The initial value is fetched from LOCALE_ICURRDIGITS.

  DateSeparator - The character used to separate the year, month, and day
  parts of a date value. The initial value is fetched from LOCATE_SDATE.

  ShortDateFormat - The format string used to convert a date value to a
  short string suitable for editing. For a complete description of date and
  time format strings, refer to the documentation for the FormatDate
  function. The short date format should only use the date separator
  character and the  m, mm, d, dd, yy, and yyyy format specifiers. The
  initial value is fetched from LOCALE_SSHORTDATE.

  LongDateFormat - The format string used to convert a date value to a long
  string suitable for display but not for editing. For a complete description
  of date and time format strings, refer to the documentation for the
  FormatDate function. The initial value is fetched from LOCALE_SLONGDATE.

  TimeSeparator - The character used to separate the hour, minute, and
  second parts of a time value. The initial value is fetched from
  LOCALE_STIME.

  TimeAMString - The suffix string used for time values between 00:00 and
  11:59 in 12-hour clock format. The initial value is fetched from
  LOCALE_S1159.

  TimePMString - The suffix string used for time values between 12:00 and
  23:59 in 12-hour clock format. The initial value is fetched from
  LOCALE_S2359.

  ShortTimeFormat - The format string used to convert a time value to a
  short string with only hours and minutes. The default value is computed
  from LOCALE_ITIME and LOCALE_ITLZERO.

  LongTimeFormat - The format string used to convert a time value to a long
  string with hours, minutes, and seconds. The default value is computed
  from LOCALE_ITIME and LOCALE_ITLZERO.

  ShortMonthNames - Array of strings containing short month names. The mmm
  format specifier in a format string passed to FormatDate causes a short
  month name to be substituted. The default values are fecthed from the
  LOCALE_SABBREVMONTHNAME system locale entries.

  LongMonthNames - Array of strings containing long month names. The mmmm
  format specifier in a format string passed to FormatDate causes a long
  month name to be substituted. The default values are fecthed from the
  LOCALE_SMONTHNAME system locale entries.

  ShortDayNames - Array of strings containing short day names. The ddd
  format specifier in a format string passed to FormatDate causes a short
  day name to be substituted. The default values are fecthed from the
  LOCALE_SABBREVDAYNAME system locale entries.

  LongDayNames - Array of strings containing long day names. The dddd
  format specifier in a format string passed to FormatDate causes a long
  day name to be substituted. The default values are fecthed from the
  LOCALE_SDAYNAME system locale entries.

  ListSeparator - The character used to separate items in a list.  The
  initial value is fetched from LOCALE_SLIST.

  TwoDigitYearCenturyWindow - Determines what century is added to two
  digit years when converting string dates to numeric dates.  This value
  is subtracted from the current year before extracting the century.
  This can be used to extend the lifetime of existing applications that
  are inextricably tied to 2 digit year data entry.  The best solution
  to Year 2000 (Y2k) issues is not to accept 2 digit years at all - require
  4 digit years in data entry to eliminate century ambiguities.

  Examples:

  Current TwoDigitCenturyWindow  Century  StrToDate() of:
  Year    Value                  Pivot    '01/01/03' '01/01/68' '01/01/50'
  -------------------------------------------------------------------------
  1998    0                      1900     1903       1968       1950
  2002    0                      2000     2003       2068       2050
  1998    50 (default)           1948     2003       1968       1950
  2002    50 (default)           1952     2003       1968       2050
  2020    50 (default)           1970     2003       2068       2050
 }

var
  CurrencyString: string;
  CurrencyFormat: Byte;
  NegCurrFormat: Byte;
  ThousandSeparator: SeparatorType;
  DecimalSeparator: SeparatorType;
  CurrencyDecimals: Byte;
  DateSeparator: SeparatorType;
  ShortDateFormat: string;
  LongDateFormat: string;
  TimeSeparator: SeparatorType;
  TimeAMString: string;
  TimePMString: string;
  ShortTimeFormat: string;
  LongTimeFormat: string;
  ShortMonthNames: array[1..12] of string;
  LongMonthNames: array[1..12] of string;
  ShortDayNames: array[1..7] of string;
  LongDayNames: array[1..7] of string;
  SysLocale: TSysLocale;
  TwoDigitYearCenturyWindow: Word = 50;
  ListSeparator: SeparatorType;

{ Thread safe currency and date/time formatting

  The TFormatSettings record is designed to allow thread safe formatting,
  equivalent to the gloabal variables described above. Each of the
  formatting routines that use the gloabal variables have overloaded
  equivalents, requiring an additional parameter of type TFormatSettings.

  A TFormatSettings record must be populated before use. This can be done
  using the GetLocaleFormatSettings function, which will populate the
  record with values based on the given locale. Note that some format
  specifiers still require specific thread locale settings
  (such as period/era names).  }

type
  TFormatSettings = record
    CurrencyFormat: Byte;
    NegCurrFormat: Byte;
    ThousandSeparator: SeparatorType;
    DecimalSeparator: SeparatorType;
    CurrencyDecimals: Byte;
    DateSeparator: SeparatorType;
    TimeSeparator: SeparatorType;
    ListSeparator: SeparatorType;
    CurrencyString: string;
    ShortDateFormat: string;
    LongDateFormat: string;
    TimeAMString: string;
    TimePMString: string;
    ShortTimeFormat: string;
    LongTimeFormat: string;
    ShortMonthNames: array[1..12] of string;
    LongMonthNames: array[1..12] of string;
    ShortDayNames: array[1..7] of string;
    LongDayNames: array[1..7] of string;
    TwoDigitYearCenturyWindow: Word;
  end;

{ UpperCase converts all characters in the given string to upper case. }

function UpperCase(const S: string): string;

{ LowerCase converts all characters in the given string to lower case. }

function LowerCase(const S: string): string;

{ CompareStr compares S1 to S2, with case-sensitivity. The return value is
  less than 0 if S1 < S2, 0 if S1 = S2, or greater than 0 if S1 > S2. The
  compare operation is based on the ordinal value of each character
  and is not affected by the current user locale. }

function CompareStr(const S1, S2: string): Integer;

{ SameStr compares S1 to S2, with case-sensitivity. Returns true if
  S1 and S2 are the equal, that is, if CompareStr would return 0. }

function SameStr(const S1, S2: string): Boolean;

{ CompareText compares S1 to S2, without case-sensitivity. The return value
  is the same as for CompareStr. The compare operation is based on the
  ordinal value of each character, after converting 'a'..'z' to 'A'..'Z',
  and is not affected by the current user locale. }

function CompareText(const S1, S2: string): Integer;

{ SameText compares S1 to S2, without case-sensitivity. Returns true if
  S1 and S2 are the equal, that is, if CompareText would return 0. }

function SameText(const S1, S2: string): Boolean;

{ AnsiUpperCase converts all characters in the given string to upper case.
  The conversion uses the current user locale. }

function AnsiUpperCase(const S: AnsiString): AnsiString; overload;
function AnsiUpperCase(const S: WideString): WideString; overload; deprecated;

{ AnsiLowerCase converts all characters in the given string to lower case.
  The conversion uses the current user locale. }

function AnsiLowerCase(const S: AnsiString): AnsiString; overload;
function AnsiLowerCase(const S: WideString): WideString; overload; deprecated;

{ AnsiCompareStr compares S1 to S2, with case-sensitivity. The compare
  operation is controlled by the current user locale. The return value
  is the same as for CompareStr. }

function AnsiCompareStr(const S1, S2: AnsiString): Integer; overload;
function AnsiCompareStr(const S1, S2: WideString): Integer; overload; deprecated;

{ AnsiSameStr compares S1 to S2, with case-sensitivity. The compare
  operation is controlled by the current user locale. The return value
  is True if AnsiCompareStr would have returned 0. }

function AnsiSameStr(const S1, S2: AnsiString): Boolean; overload;
function AnsiSameStr(const S1, S2: WideString): Boolean; overload; deprecated;

{ AnsiCompareText compares S1 to S2, without case-sensitivity. The compare
  operation is controlled by the current user locale. The return value
  is the same as for CompareStr. }

function AnsiCompareText(const S1, S2: AnsiString): Integer; overload;
function AnsiCompareText(const S1, S2: WideString): Integer; overload; deprecated;

{ AnsiSameText compares S1 to S2, without case-sensitivity. The compare
  operation is controlled by the current user locale. The return value
  is True if AnsiCompareText would have returned 0. }

function AnsiSameText(const S1, S2: AnsiString): Boolean; overload;
function AnsiSameText(const S1, S2: WideString): Boolean; overload; deprecated;

{ WideUpperCase converts all characters in the given string to upper case. }

function WideUpperCase(const S: WideString): WideString;

{ WideLowerCase converts all characters in the given string to lower case. }

function WideLowerCase(const S: WideString): WideString;

{ WideCompareStr compares S1 to S2, with case-sensitivity. The return value
  is the same as for CompareStr. }

function WideCompareStr(const S1, S2: WideString): Integer;

{ WideSameStr compares S1 to S2, with case-sensitivity. The return value
  is True if WideCompareStr would have returned 0. }

function WideSameStr(const S1, S2: WideString): Boolean;

{ WideCompareText compares S1 to S2, without case-sensitivity. The return value
  is the same as for CompareStr. }

function WideCompareText(const S1, S2: WideString): Integer;

{ WideSameText compares S1 to S2, without case-sensitivity. The return value
  is True if WideCompareText would have returned 0. }

function WideSameText(const S1, S2: WideString): Boolean;

{ Trim trims leading and trailing spaces and control characters from the
  given string. }

function Trim(const S: string): string;

{ TrimLeft trims leading spaces and control characters from the given
  string. }

function TrimLeft(const S: string): string;

{ TrimRight trims trailing spaces and control characters from the given
  string. }

function TrimRight(const S: string): string;

function AnsiPos(const Substr, S: AnsiString): Integer; overload;
function AnsiPos(const Substr, S: WideString): Integer; overload; deprecated;

{ QuotedStr returns the given string as a quoted string. A single quote
  character is inserted at the beginning and the end of the string, and
  for each single quote character in the string, another one is added.
  The default QuoteChar is ' }

function QuotedStr(const S: string): string; overload;
function QuotedStr(const S: string; QuoteChar: Char): string; overload;

{ AnsiQuotedStr returns the given string as a quoted string, using the
  provided Quote character.  A Quote character is inserted at the beginning
  and end of the string, and each Quote character in the string is doubled.  }

function AnsiQuotedStr(const S: AnsiString; Quote: AnsiChar): AnsiString; overload;
function AnsiQuotedStr(const S: WideString; Quote: WideChar): WideString; overload; deprecated;

{ DequotedStr removes the Quote characters from the beginning and end
  of a quoted string, and reduces pairs of Quote characters within the quoted
  string to a single character. If the first character in Src is not the Quote
  character, the function returns an empty string. The default QuoteChar is ' }

function DequotedStr(const S: string): string; overload;
function DequotedStr(const S: string; QuoteChar: WideChar): string; overload;
function DequotedStr(const S: string; QuoteChar: Char; var p: integer): string; overload;

{ AnsiDequotedStr is the same as DequotedStr, except that the quote character
  is an AnsiChar, and if the first character is S is not the Quote character,
  the return value is S }

function AnsiDequotedStr(const S: AnsiString; AQuote: AnsiChar): AnsiString; overload;
function AnsiDequotedStr(const S: WideString; AQuote: WideChar): WideString; overload; deprecated;

{ AdjustLineBreaks adjusts all line breaks in the given string to the
  indicated style.
  When Style is tlbsCRLF, the function changes all
  CR characters not followed by LF and all LF characters not preceded
  by a CR into CR/LF pairs.
  When Style is tlbsLF, the function changes all CR/LF pairs and CR characters
  not followed by LF to LF characters. }

function AdjustLineBreaks(const S: string; Style: TTextLineBreakStyle =
         tlbsCRLF ): string;

{ IsValidIdent returns true if the given string is a valid identifier. An
  identifier is defined as a character from the set ['A'..'Z', 'a'..'z', '_']
  followed by zero or more characters from the set ['A'..'Z', 'a'..'z',
  '0..'9', '_']. }

function IsValidIdent(const Ident: string; AllowDots: Boolean = False): Boolean;

{ IntToStr converts the given value to its decimal string representation. }

function IntToStr(Value: Integer): string; overload;
function IntToStr(Value: Int64): string; overload;
function UIntToStr(Value: LongWord): string; overload;
function UIntToStr(Value: UInt64): string; overload;

{ IntToHex converts the given value to a hexadecimal string representation
  with the minimum number of digits specified. }

function IntToHex(Value: Integer; Digits: Integer): string; overload;
function IntToHex(Value: Int64; Digits: Integer): string; overload;

{ StrToInt converts the given string to an integer value. If the string
  doesn't contain a valid value, an EConvertError exception is raised. }

function StrToInt(const S: string): Integer;
function StrToIntDef(const S: string; Default: Integer): Integer;
function TryStrToInt(const S: string; out Value: Integer): Boolean;

{ Similar to the above functions but for Int64 instead }

function StrToInt64(const S: string): Int64;
function StrToInt64Def(const S: string; const Default: Int64): Int64;
function TryStrToInt64(const S: string; out Value: Int64): Boolean;

{ Similar to the above functions but for the unsigned variety }

function StrToLongWord(const S: string): LongWord;
function StrToLongWordDef(const S: string; Default: LongWord): LongWord;
function TryStrToLongWord(const S: string; out Value: LongWord): Boolean;

function StrToUInt64(const S: string): UInt64;
function StrToUInt64Def(const S: string; const Default: UInt64): UInt64;
function TryStrToUInt64(const S: string; out Value: UInt64): Boolean;

{ StrToBool converts the given string to a boolean value.  If the string
  doesn't contain a valid value, an EConvertError exception is raised.
  BoolToStr converts boolean to a string value that in turn can be converted
  back into a boolean.  BoolToStr will always pick the first element of
  the TrueStrs/FalseStrs arrays. }

var
  TrueBoolStrs: array of String;
  FalseBoolStrs: array of String;

const
  DefaultTrueBoolStr = 'True';   // DO NOT LOCALIZE
  DefaultFalseBoolStr = 'False'; // DO NOT LOCALIZE

function StrToBool(const S: string; StrOnlyTest: Boolean = False): Boolean;
function StrToBoolDef(const S: string; const Default: Boolean; StrOnlyTest: Boolean = False): Boolean;
function TryStrToBool(const S: string; out Value: Boolean; StrOnlyTest: Boolean = False): Boolean;

function BoolToStr(B: Boolean; UseBoolStrs: Boolean = False): string;

{ TOpenedFile is a CLR filestream that stands in the place of the file
  handle on the Windows and Linux versions of the file functions. CLR
  file functions do not use handles }
type
  TOpenedFile = System.IO.FileStream;

{ FileOpen opens the specified file using the specified access mode. The
  access mode value is constructed by OR-ing one of the fmOpenXXXX constants
  with one of the fmShareXXXX constants. Under CLR, FileOpen returns a CLR file
  stream, or nil if the file does not exist. }

function FileOpen(const FileName: string; Mode: LongWord): TOpenedFile;

{ FileCreate creates a new file by the specified name. If the return value
  is non-nil, the function was successful and the value is a file stream with
  read/write access to the new file. A return value of nil indicates that an
  error occurred. }

function FileCreate(const FileName: string): TOpenedFile; overload;

{ This second version of FileCreate is for compatibility with the Linux
  function that lets you specify the access rights to put
  on the newly created file.  The access rights parameter is ignored }

function FileCreate(const FileName: string; Rights: Integer): TOpenedFile; overload;

{ FileRead reads Count bytes from the file given by Handle into the buffer
  specified by Buffer. The return value is the number of bytes actually
  read; it is less than Count if the end of the file was reached. The return
  value is -1 if an error occurred. }

function FileRead(Handle: TOpenedFile; var Buffer: TBytes; Count: LongWord): Integer; overload;
function FileRead(Handle: TOpenedFile; var Buffer: Boolean; Count: LongWord): Integer; overload;
function FileRead(Handle: TOpenedFile; var Buffer: Char; Count: LongWord): Integer; overload;
function FileRead(Handle: TOpenedFile; var Buffer: Double; Count: LongWord): Integer; overload;
function FileRead(Handle: TOpenedFile; var Buffer: Single; Count: LongWord): Integer; overload;
function FileRead(Handle: TOpenedFile; var Buffer: Integer; Count: LongWord): Integer; overload;
function FileRead(Handle: TOpenedFile; var Buffer: Cardinal; Count: LongWord): Integer; overload;
function FileRead(Handle: TOpenedFile; var Buffer: SmallInt; Count: LongWord): Integer; overload;
function FileRead(Handle: TOpenedFile; var Buffer: Word; Count: LongWord): Integer; overload;
function FileRead(Handle: TOpenedFile; var Buffer: Int64; Count: LongWord): Integer; overload;
// IsWide indicates whether the file is written using unicode or ansi chars.
// Ansi are the default text file characters for XP, although XP strings are Unicode.
function FileRead(Handle: TOpenedFile; var Buffer: string; Count: LongWord; IsWide: Boolean = False): Integer; overload;

{ FileWrite writes Count bytes to the file given by Handle from the buffer
  specified by Buffer. The return value is the number of bytes actually
  written, or -1 if an error occurred. }

function FileWrite(Handle: TOpenedFile; const Buffer: TBytes; Count: LongWord): Integer; overload;
function FileWrite(Handle: TOpenedFile; const Buffer: Boolean; Count: LongWord): Integer; overload;
function FileWrite(Handle: TOpenedFile; const Buffer: Char; Count: LongWord): Integer; overload;
function FileWrite(Handle: TOpenedFile; const Buffer: Double; Count: LongWord): Integer; overload;
function FileWrite(Handle: TOpenedFile; const Buffer: Single; Count: LongWord): Integer; overload;
function FileWrite(Handle: TOpenedFile; const Buffer: Integer; Count: LongWord): Integer; overload;
function FileWrite(Handle: TOpenedFile; const Buffer: Cardinal; Count: LongWord): Integer; overload;
function FileWrite(Handle: TOpenedFile; const Buffer: SmallInt; Count: LongWord): Integer; overload;
function FileWrite(Handle: TOpenedFile; const Buffer: Word; Count: LongWord): Integer; overload;
function FileWrite(Handle: TOpenedFile; const Buffer: Int64; Count: LongWord): Integer; overload;
// IsWide indicates whether to write the file using unicode or ansi chars.
// Ansi are the default text file characters for XP, although XP strings are Unicode.
function FileWrite(Handle: TOpenedFile; const Buffer: string; Count: LongWord; IsWide: Boolean = False): Integer; overload;

{ FileSeek changes the current position of the file given by Handle to be
  Offset bytes relative to the point given by Origin. Origin = 0 means that
  Offset is relative to the beginning of the file, Origin = 1 means that
  Offset is relative to the current position, and Origin = 2 means that
  Offset is relative to the end of the file. The return value is the new
  current position, relative to the beginning of the file, or -1 if an error
  occurred. }

function FileSeek(Handle: TOpenedFile; Offset, Origin: Integer): Integer; overload;
function FileSeek(Handle: TOpenedFile; const Offset: Int64; Origin: Integer): Int64; overload;

{ FileClose closes the specified file. }

procedure FileClose(Handle: TOpenedFile);

{ FileGetDate returns the OS date-and-time stamp of the file given by
  Handle. The return value is -1 if the handle is invalid. The
  FileDateToDateTime function can be used to convert the returned value to
  a TDateTime value. }

function FileGetDate(Handle: TOpenedFile): Integer;

{ FileSetDate sets the OS date-and-time stamp of the file given by FileName or
  Handle to the value given by Age. The DateTimeToFileDate function can be used
  to convert a TDateTime value to an OS date-and-time stamp. The return value
  is zero if the function was successful. Otherwise the return value is an
  error code.  }

function FileSetDate(Handle: TOpenedFile; Age: Integer): Integer; overload;
function FileSetDate(const FileName: string; Age: Integer): Integer; overload;

{ A CLR-only overload lets you specify the date-and-time stamp using a TDateTime value.  }

function FileSetDate(const FileName: string; ATimeStamp: TDateTime): Integer; overload;

{ FileAge returns the date-and-time stamp of the specified file. The return value
  can be converted to a TDateTime value using the FileDateToDateTime function.
  The return value is -1 if the file does not exist. }

function FileAge(const FileName: string): Integer;

{ FileExists returns a boolean value that indicates whether the specified
  file exists. }

function FileExists(const FileName: string): Boolean;

{ DirectoryExists returns a boolean value that indicates whether the
  specified directory exists (and is actually a directory) }

function DirectoryExists(const Directory: string): Boolean;

{ ForceDirectories ensures that all the directories in a specific path exist.
  Any portion that does not already exist will be created.  Function result
  indicates success of the operation.  The function can fail if the current
  user does not have sufficient file access rights to create directories in
  the given path.  }

function ForceDirectories(Dir: string): Boolean;

{ File Search routines. When using CLR, FindFirst, FindNext, and FindClose are
  only available on Windows. For more generic file searching that can be used
  on other .NET platforms, use System.IO.Directory.GetFiles or
  System.IO.Directory.GetFileSystemEntries }

type

{ Generic filename type}

  TFileName = type string;

{ Search record used by FindFirst, FindNext, and FindClose }

  TSearchRec = record
    Time: Integer;
    Size: Integer;
    Attr: Integer;
    Name: TFileName;
    ExcludeAttr: Integer;
    FindHandle: THandle platform;
    FindData: TWIN32FindData platform;
  end;

 { FindFirst searches the directory given by Path for the first entry that
  matches the filename given by Path and the attributes given by Attr. The
  result is returned in the search record given by SearchRec. The return
  value is zero if the function was successful. Otherwise the return value
  is a system error code. After calling FindFirst, always call FindClose.
  FindFirst is typically used with FindNext and FindClose as follows:

    Result := FindFirst(Path, Attr, SearchRec);
    while Result = 0 do
    begin
      ProcessSearchRec(SearchRec);
      Result := FindNext(SearchRec);
    end;
    FindClose(SearchRec);

  where ProcessSearchRec represents user-defined code that processes the
  information in a search record. }

function FindFirst(const Path: string; Attr: Integer;
  var F: TSearchRec): Integer; platform;

{ FindNext returs the next entry that matches the name and attributes
  specified in a previous call to FindFirst. The search record must be one
  that was passed to FindFirst. The return value is zero if the function was
  successful. Otherwise the return value is a system error code. }

function FindNext(var F: TSearchRec): Integer; platform;

{ FindClose terminates a FindFirst/FindNext sequence and frees memory and system
  resources allocated by FindFirst.
  Every FindFirst/FindNext must end with a call to FindClose. }

procedure FindClose(var F: TSearchRec); platform;

{ FileGetAttr returns the file attributes of the file given by FileName. The
  attributes can be examined by AND-ing with the faXXXX constants defined
  above. A return value of -1 indicates that an error occurred. }

function FileGetAttr(const FileName: string): Integer;

{ FileSetAttr sets the file attributes of the file given by FileName to the
  value given by Attr. The attribute value is formed by OR-ing the
  appropriate faXXXX constants. The return value is zero if the function was
  successful. Otherwise the return value is an error code. }

function FileSetAttr(const FileName: string; Attr: Integer): Integer;

{ FileIsReadOnly tests whether a given file is read-only for the current
  process and effective user id.  If the file does not exist, the
  function returns False.  (Check FileExists before calling FileIsReadOnly) }

function FileIsReadOnly(const FileName: string): Boolean;

{ FileSetReadOnly sets the read only state of a file.  The file must
  exist and the current effective user id must be the owner of the file.
  The function returns True if the file was successfully modified,
  False if there was an error. }

function FileSetReadOnly(const FileName: string; ReadOnly: Boolean): Boolean;

{ DeleteFile deletes the file given by FileName. The return value is True if
  the file was successfully deleted, or False if an error occurred. }

function DeleteFile(const FileName: string): Boolean;

{ RenameFile renames the file given by OldName to the name given by NewName.
  The return value is True if the file was successfully renamed, or False if
  an error occurred. }

function RenameFile(const OldName, NewName: string): Boolean;

{ ChangeFileExt changes the extension of a filename. FileName specifies a
  filename with or without an extension, and Extension specifies the new
  extension for the filename. The new extension can be a an empty string or
  a period followed by up to three characters. }

function ChangeFileExt(const FileName, Extension: string): string;

{ ExtractFilePath extracts the drive and directory parts of the given
  filename. The resulting string is the leftmost characters of FileName,
  up to and including the colon or backslash that separates the path
  information from the name and extension. The resulting string is empty
  if FileName contains no drive and directory parts. }

function ExtractFilePath(const FileName: string): string;

{ ExtractFileDir extracts the drive and directory parts of the given
  filename. The resulting string is a directory name suitable for passing
  to SetCurrentDir, CreateDir, etc. The resulting string is empty if
  FileName contains no drive and directory parts. }

function ExtractFileDir(const FileName: string): string;

{ ExtractFileDrive extracts the drive part of the given filename.  For
  filenames with drive letters, the resulting string is '<drive>:'.
  For filenames with a UNC path, the resulting string is in the form
  '\\<servername>\<sharename>'.  If the given path contains neither
  style of filename, the result is an empty string. }

function ExtractFileDrive(const FileName: string): string;

{ ExtractFileName extracts the name and extension parts of the given
  filename. The resulting string is the leftmost characters of FileName,
  starting with the first character after the colon or backslash that
  separates the path information from the name and extension. The resulting
  string is equal to FileName if FileName contains no drive and directory
  parts. }

function ExtractFileName(const FileName: string): string;

{ ExtractFileExt extracts the extension part of the given filename. The
  resulting string includes the period character that separates the name
  and extension parts. The resulting string is empty if the given filename
  has no extension. }

function ExtractFileExt(const FileName: string): string;

{ ExpandFileName expands the given filename to a fully qualified filename.
  The resulting string consists of a drive letter, a colon, a root relative
  directory path, and a filename. Embedded '.' and '..' directory references
  are removed. }

function ExpandFileName(const FileName: string): string;

{ ExpandFilenameCase returns a fully qualified filename like ExpandFilename,
  but performs a case-insensitive filename search looking for a close match
  in the actual file system, differing only in uppercase versus lowercase of
  the letters.  This is useful to convert lazy user input into useable file
  names, or to convert filename data created on a case-insensitive file
  system (Win32) to something useable on a case-sensitive file system (Linux).

  The MatchFound out parameter indicates what kind of match was found in the
  file system, and what the function result is based upon:

  ( in order of increasing difficulty or complexity )
  mkExactMatch:  Case-sensitive match.  Result := ExpandFileName(FileName).
  mkSingleMatch: Exactly one file in the given directory path matches the
        given filename on a case-insensitive basis.
        Result := ExpandFileName(FileName as found in file system).
  mkAmbiguous: More than one file in the given directory path matches the
        given filename case-insensitively.
        In many cases, this should be considered an error.
        Result := ExpandFileName(First matching filename found).
  mkNone:  File not found at all.  Result := ExpandFileName(FileName).

  Note that because this function has to search the file system it may be
  much slower than ExpandFileName, particularly when the given filename is
  ambiguous or does not exist.  Use ExpandFilenameCase only when you have
  a filename of dubious orgin - such as from user input - and you want
  to make a best guess before failing.  }

type
  TFilenameCaseMatch = (mkNone, mkExactMatch, mkSingleMatch, mkAmbiguous);

function ExpandFileNameCase(const FileName: string;
  out MatchFound: TFilenameCaseMatch): string;

{ ExpandUNCFileName expands the given filename to a fully qualified filename.
  This function is the same as ExpandFileName except that it will return the
  drive portion of the filename in the format '\\<servername>\<sharename> if
  that drive is actually a network resource instead of a local resource.
  Like ExpandFileName, embedded '.' and '..' directory references are
  removed. }

function ExpandUNCFileName(const FileName: string): string; platform;

{ ExtractRelativePath will return a file path name relative to the given
  BaseName.  It strips the common path dirs and adds '..\' for each level
  up from the BaseName path. }

function ExtractRelativePath(const BaseName, DestName: string): string;

{ ExtractShortPathName will convert the given filename to the short form
  by calling the GetShortPathName API.  Will return an empty string if
  the file or directory specified does not exist }

function ExtractShortPathName(const FileName: string): string; platform;

{ FileSearch searches for the file given by Name in the list of directories
  given by DirList. The directory paths in DirList must be separated by
  PathSep chars. The search always starts with the current directory of the
  current drive. The returned value is a concatenation of one of the
  directory paths and the filename, or an empty string if the file could not
  be located. }

function FileSearch(const Name, DirList: string): string;

{ FileDateToDateTime converts an OS date-and-time value to a TDateTime
  value. The FileAge, FileGetDate, and FileSetDate routines operate on OS
  date-and-time values, and the Time field of a TSearchRec used by the
  FindFirst and FindNext functions contains an OS date-and-time value. }

function FileDateToDateTime(FileDate: Integer): TDateTime;

{ DateTimeToFileDate converts a TDateTime value to an OS date-and-time
  value. The FileAge, FileGetDate, and FileSetDate routines operate on OS
  date-and-time values, and the Time field of a TSearchRec used by the
  FindFirst and FindNext functions contains an OS date-and-time value. }

function DateTimeToFileDate(ADateTime: TDateTime): Integer;

{ GetCurrentDir returns the current directory. }

function GetCurrentDir: string;

{ SetCurrentDir sets the current directory. The return value is True if
  the current directory was successfully changed, or False if an error
  occurred. }

function SetCurrentDir(const Dir: string): Boolean;

{ CreateDir creates a new directory. The return value is True if a new
  directory was successfully created, or False if an error occurred. }

function CreateDir(const Dir: string): Boolean;

{ RemoveDir deletes an existing empty directory. The return value is
  True if the directory was successfully deleted, or False if an error
  occurred. }

function RemoveDir(const Dir: string; Recursive: Boolean = False): Boolean;

{ String formatting routines }

{ The Format routine formats the argument list given by the Args parameter
  using the format string given by the Format parameter.

  Format strings contain two types of objects--plain characters and format
  specifiers. Plain characters are copied verbatim to the resulting string.
  Format specifiers fetch arguments from the argument list and apply
  formatting to them.

  Format specifiers have the following form:

    "%" [index ":"] ["-"] [width] ["." prec] type

  A format specifier begins with a % character. After the % come the
  following, in this order:

  -  an optional argument index specifier, [index ":"]
  -  an optional left-justification indicator, ["-"]
  -  an optional width specifier, [width]
  -  an optional precision specifier, ["." prec]
  -  the conversion type character, type

  The following conversion characters are supported:

  d  Decimal. The argument must be an integer value. The value is converted
     to a string of decimal digits. If the format string contains a precision
     specifier, it indicates that the resulting string must contain at least
     the specified number of digits; if the value has less digits, the
     resulting string is left-padded with zeros.

  u  Unsigned decimal.  Similar to 'd' but no sign is output.

  e  Scientific. The argument must be a floating-point value. The value is
     converted to a string of the form "-d.ddd...E+ddd". The resulting
     string starts with a minus sign if the number is negative, and one digit
     always precedes the decimal point. The total number of digits in the
     resulting string (including the one before the decimal point) is given
     by the precision specifer in the format string--a default precision of
     15 is assumed if no precision specifer is present. The "E" exponent
     character in the resulting string is always followed by a plus or minus
     sign and at least three digits.

  f  Fixed. The argument must be a floating-point value. The value is
     converted to a string of the form "-ddd.ddd...". The resulting string
     starts with a minus sign if the number is negative. The number of digits
     after the decimal point is given by the precision specifier in the
     format string--a default of 2 decimal digits is assumed if no precision
     specifier is present.

  g  General. The argument must be a floating-point value. The value is
     converted to the shortest possible decimal string using fixed or
     scientific format. The number of significant digits in the resulting
     string is given by the precision specifier in the format string--a
     default precision of 15 is assumed if no precision specifier is present.
     Trailing zeros are removed from the resulting string, and a decimal
     point appears only if necessary. The resulting string uses fixed point
     format if the number of digits to the left of the decimal point in the
     value is less than or equal to the specified precision, and if the
     value is greater than or equal to 0.00001. Otherwise the resulting
     string uses scientific format.

  n  Number. The argument must be a floating-point value. The value is
     converted to a string of the form "-d,ddd,ddd.ddd...". The "n" format
     corresponds to the "f" format, except that the resulting string
     contains thousand separators.

  m  Money. The argument must be a floating-point value. The value is
     converted to a string that represents a currency amount. The conversion
     is controlled by the CurrencyString, CurrencyFormat, NegCurrFormat,
     ThousandSeparator, DecimalSeparator, and CurrencyDecimals global
     variables, all of which are initialized from locale settings provided
     by the operating system.  For example, Currency Format preferences can be
     set in the International section of the Windows Control Panel. If the format
     string contains a precision specifier, it overrides the value given
     by the CurrencyDecimals global variable.

  p  Pointer. The argument must be a pointer value. The value is converted
     to a string of the form "XXXX:YYYY" where XXXX and YYYY are the
     segment and offset parts of the pointer expressed as four hexadecimal
     digits.

  s  String. The argument must be a character, a string, or a PChar value.
     The string or character is inserted in place of the format specifier.
     The precision specifier, if present in the format string, specifies the
     maximum length of the resulting string. If the argument is a string
     that is longer than this maximum, the string is truncated.

  x  Hexadecimal. The argument must be an integer value. The value is
     converted to a string of hexadecimal digits. If the format string
     contains a precision specifier, it indicates that the resulting string
     must contain at least the specified number of digits; if the value has
     less digits, the resulting string is left-padded with zeros.

  Conversion characters may be specified in upper case as well as in lower
  case--both produce the same results.

  For all floating-point formats, the actual characters used as decimal and
  thousand separators are obtained from the DecimalSeparator and
  ThousandSeparator global variables.

  Index, width, and precision specifiers can be specified directly using
  decimal digit string (for example "%10d"), or indirectly using an asterisk
  charcater (for example "%*.*f"). When using an asterisk, the next argument
  in the argument list (which must be an integer value) becomes the value
  that is actually used. For example "Format('%*.*f', [8, 2, 123.456])" is
  the same as "Format('%8.2f', [123.456])".

  A width specifier sets the minimum field width for a conversion. If the
  resulting string is shorter than the minimum field width, it is padded
  with blanks to increase the field width. The default is to right-justify
  the result by adding blanks in front of the value, but if the format
  specifier contains a left-justification indicator (a "-" character
  preceding the width specifier), the result is left-justified by adding
  blanks after the value.

  An index specifier sets the current argument list index to the specified
  value. The index of the first argument in the argument list is 0. Using
  index specifiers, it is possible to format the same argument multiple
  times. For example "Format('%d %d %0:d %d', [10, 20])" produces the string
  '10 20 10 20'.

  The Format function can be combined with other formatting functions. For
  example

    S := Format('Your total was %s on %s', [
      FormatFloat('$#,##0.00;;zero', Total),
      FormatDateTime('mm/dd/yy', Date)]);

  which uses the FormatFloat and FormatDateTime functions to customize the
  format beyond what is possible with Format.

  Each of the string formatting routines that uses global variables for
  formatting (separators, decimals, date/time formats etc.), have 2
  overloaded equivalents. One requires a parameter of type TFormatSettings,
  the other IFormatProvider. These additional parameters provides the
  formatting information rather than the global variables. }

function Format(const Format: string; const Args: array of const): string; overload;
function Format(const Format: string; const Args: array of const;
  const FormatSettings: TFormatSettings): string; overload;
function Format(const Format: string; const Args: array of const;
  Provider: IFormatProvider): string; overload;

{ FmtStr formats the argument list given by Args using the format string
  given by Format into the string variable given by Result. For further
  details, see the description of the Format function. }

procedure FmtStr(var Result: string; const Format: string;
  const Args: array of const); overload;
procedure FmtStr(var Result: string; const Format: string;
  const Args: array of const; const FormatSettings: TFormatSettings); overload;
procedure FmtStr(var Result: string; const Format: string;
  const Args: array of const; Provider: IFormatProvider); overload;

{ FormatBuf formats the argument list given by Args using the format string
  given by Format and FmtLen into the buffer given by Buffer and BufLen.
  The Format parameter is a reference to a buffer containing FmtLen
  characters, and the Buffer parameter is a reference to a buffer of BufLen
  characters. The returned value is the number of characters actually stored
  in Buffer. The returned value is always less than or equal to BufLen. For
  further details, see the description of the Format function. }

function FormatBuf(var Buffer: System.Text.StringBuilder; const Format: string;
  FmtLen: Cardinal; const Args: array of const): Cardinal; overload;
function FormatBuf(var Buffer: System.Text.StringBuilder; const Format: string;
  FmtLen: Cardinal; const Args: array of const; const FormatSettings: TFormatSettings): Cardinal; overload;
function FormatBuf(var Buffer: System.Text.StringBuilder; const Format: string;
  FmtLen: Cardinal; const Args: array of const; Provider: IFormatProvider): Cardinal; overload;

{ The WideFormat routine formats the argument list given by the Args parameter
  using the format WideString given by the Format parameter. This routine is
  the WideString equivalent of Format. For further details, see the description
  of the Format function. }

function WideFormat(const AFormat: WideString;
  const Args: array of const): WideString; overload;
function WideFormat(const AFormat: WideString;
  const Args: array of const; const FormatSettings: TFormatSettings): WideString; overload;
function WideFormat(const AFormat: WideString;
  const Args: array of const; Provider: IFormatProvider): WideString; overload;

{ WideFmtStr formats the argument list given by Args using the format WideString
  given by Format into the WideString variable given by Result. For further
  details, see the description of the Format function. }

procedure WideFmtStr(var AResult: WideString; const AFormat: WideString;
  const Args: array of const); overload;
procedure WideFmtStr(var AResult: WideString; const AFormat: WideString;
  const Args: array of const; const FormatSettings: TFormatSettings); overload;
procedure WideFmtStr(var AResult: WideString; const AFormat: WideString;
  const Args: array of const; Provider: IFormatProvider); overload;

{ WideFormatBuf formats the argument list given by Args using the format string
  given by Format and FmtLen into the buffer given by Buffer and BufLen.
  The Format parameter is a reference to a buffer containing FmtLen
  UNICODE characters (WideChar), and the Buffer parameter is a reference to a
  buffer of BufLen UNICODE characters (WideChar). The return value is the number
  of UNICODE characters actually stored in Buffer. The return value is always
  less than or equal to BufLen. For further details, see the description of the
  Format function.

  Important: BufLen, FmtLen and the return result are always the number of
  UNICODE characters, *not* the number of bytes. To calculate the number of bytes
  multiply them by SizeOf(WideChar). }

function WideFormatBuf(var ABuffer: System.Text.StringBuilder; const AFormat: WideString;
  AFmtLen: Cardinal; const Args: array of const): Cardinal; overload;
function WideFormatBuf(var ABuffer: System.Text.StringBuilder; const AFormat: WideString;
  AFmtLen: Cardinal; const Args: array of const; const FormatSettings: TFormatSettings): Cardinal; overload;
function WideFormatBuf(var ABuffer: System.Text.StringBuilder; const AFormat: WideString;
  AFmtLen: Cardinal; const Args: array of const; Provider: IFormatProvider): Cardinal; overload;

{ Floating point conversion routines }

{ Each of the floating point conversion routines that uses global variables
  for formatting (separators, decimals, etc.), have 2 overloaded equivalents.
  One requires a parameter of type TFormatSettings, the other IFormatProvider.
  These additional parameters provides the formatting information rather
  than the global variables. }

{ FloatToStr converts the floating-point value given by Value to its string
  representation. The conversion uses general number format with 15
  significant digits. For further details, see the description of the
  FloatToStrF function. }

function FloatToStr(Value: Extended): string; overload;
function FloatToStr(Value: Extended; const FormatSettings: TFormatSettings): string; overload;
function FloatToStr(Value: Extended; Provider: IFormatProvider): string; overload;

{ FloatToStrF converts the floating-point value given by Value to its string
  representation. The Format parameter controls the format of the resulting
  string. The Precision parameter specifies the precision of the given value.
  It should be 7 or less for values of type Single, 15 or less for values of
  type Double, and 18 or less for values of type Extended. The meaning of the
  Digits parameter depends on the particular format selected.

  The possible values of the Format parameter, and the meaning of each, are
  described below.

  ffGeneral - General number format. The value is converted to the shortest
  possible decimal string using fixed or scientific format. Trailing zeros
  are removed from the resulting string, and a decimal point appears only
  if necessary. The resulting string uses fixed point format if the number
  of digits to the left of the decimal point in the value is less than or
  equal to the specified precision, and if the value is greater than or
  equal to 0.00001. Otherwise the resulting string uses scientific format.
  The Digits parameter is always ignored.

  ffExponent - Scientific format. The value is converted to a string of the
  form "-d.ddd...E+dddd". The resulting string starts with a minus sign if
  the number is negative, and one digit always precedes the decimal point.
  The total number of digits in the resulting string (including the one
  before the decimal point) is given by the Precision parameter. The "E"
  exponent character in the resulting string is always followed by a plus
  or minus sign and up to four digits. The Digits parameter specifies the
  minimum number of digits in the exponent (between 0 and 4).

  ffFixed - Fixed point format. The value is converted to a string of the
  form "-ddd.ddd...". The resulting string starts with a minus sign if the
  number is negative, and at least one digit always precedes the decimal
  point. The number of digits after the decimal point is given by the Digits
  parameter--it must be between 0 and 18. If the number of digits to the
  left of the decimal point is greater than the specified precision, the
  resulting value will use scientific format.

  ffNumber - Number format. The value is converted to a string of the form
  "-d,ddd,ddd.ddd...". The ffNumber format corresponds to the ffFixed format,
  except that the resulting string contains thousand separators.

  ffCurrency - Currency format. The value is converted to a string that
  represents a currency amount. The conversion is controlled by the
  CurrencyString, CurrencyFormat, NegCurrFormat, ThousandSeparator, and
  DecimalSeparator global variables, all of which are initialized from
  locale settings provided by the operating system.  For example,
  Currency Format preferences can be set in the International section
  of the Windows Control Panel.
  The number of digits after the decimal point is given by the Digits
  parameter--it must be between 0 and 18.

  For all formats, the actual characters used as decimal and thousand
  separators are obtained from the operating system (the values to
  which the DecimalSeparator and ThousandSeparator global variables are
  initialized.)

  If the given value is a NAN (not-a-number), the resulting string is 'NAN'.
  If the given value is positive infinity, the resulting string is 'INF'. If
  the given value is negative infinity, the resulting string is '-INF'. }

type
  TFloatFormat = (ffGeneral, ffExponent, ffFixed, ffNumber, ffCurrency);

function FloatToStrF(Value: Extended; Format: TFloatFormat;
  Precision, Digits: Integer): string; overload;
function FloatToStrF(Value: Extended; Format: TFloatFormat;
  Precision, Digits: Integer; const FormatSettings: TFormatSettings): string; overload;
function FloatToStrF(Value: Extended; Format: TFloatFormat;
  Precision, Digits: Integer; Provider: IFormatProvider): string; overload;

{Add CurrencySymbol adds in a currency symbol using the specified format.
 The CurrFormat parameter works like the global CurrencyFormat variable:
 0 = '$1',   1 = '1$',    2 = '$ 1',  3 = '1 $' }

function AddCurrencySymbol(const Value, CurrSymbol: string; CurrFormat: Byte): string; overload;
function AddCurrencySymbol(const Value: string; Provider: IFormatProvider): string; overload;

{ AddNegCurrencySymbol adds in a currency symbol using the specified format.
  The CurrFormat paramerter works like the global NegCurrFormat variable:
    0 = '($1)'      4 = '(1$)'      8 = '-1 $'      12 = '$ -1'
    1 = '-$1'       5 = '-1$'       9 = '-$ 1'      13 = '1- $'
    2 = '$-1'       6 = '1-$'      10 = '1 $-'      14 = '($ 1)'
    3 = '$1-'       7 = '1$-'      11 = '$ 1-'      15 = '(1 $)'  }

function AddNegCurrencySymbol(const Value, CurrSymbol: string; CurrFormat: Byte): string; overload;
function AddNegCurrencySymbol(const Value: string; Provider: IFormatProvider): string; overload;

{ CurrToStr converts the currency value given by Value to its string
  representation. The conversion uses general number format. For further
  details, see the description of the CurrToStrF function. }

function CurrToStr(Value: Currency): string; overload;
function CurrToStr(Value: Currency; const FormatSettings: TFormatSettings): string; overload;
function CurrToStr(Value: Currency; Provider: IFormatProvider): string; overload;

{ CurrToStrF converts the currency value given by Value to its string
  representation. A call to CurrToStrF corresponds to a call to
  FloatToStrF with an implied precision of 19 digits. }

function CurrToStrF(Value: Currency; Format: TFloatFormat;
  Digits: Integer): string; overload;
function CurrToStrF(Value: Currency; Format: TFloatFormat;
  Digits: Integer; const FormatSettings: TFormatSettings): string; overload;
function CurrToStrF(Value: Currency; Format: TFloatFormat;
  Digits: Integer; Provider: IFormatProvider): string; overload;

{ FloatToCurr will range validate a value to make sure it falls
  within the acceptable currency range }

function MinCurrency: Currency; { -922337203685477.5807 }
function MaxCurrency: Currency; {  922337203685477.5807 }

function FloatToCurr(const Value: Extended): Currency;
function TryFloatToCurr(const Value: Extended; out AResult: Currency): Boolean;

{ FormatFloat formats the floating-point value given by Value using the
  format string given by Format. The following format specifiers are
  supported in the format string:

  0     Digit placeholder. If the value being formatted has a digit in the
        position where the '0' appears in the format string, then that digit
        is copied to the output string. Otherwise, a '0' is stored in that
        position in the output string.

  #     Digit placeholder. If the value being formatted has a digit in the
        position where the '#' appears in the format string, then that digit
        is copied to the output string. Otherwise, nothing is stored in that
        position in the output string.

  .     Decimal point. The first '.' character in the format string
        determines the location of the decimal separator in the formatted
        value; any additional '.' characters are ignored. The actual
        character used as a the decimal separator in the output string is
        determined by the DecimalSeparator global variable, which is initialized
        from locale settings obtained from the operating system.

  ,     Thousand separator. If the format string contains one or more ','
        characters, the output will have thousand separators inserted between
        each group of three digits to the left of the decimal point. The
        placement and number of ',' characters in the format string does not
        affect the output, except to indicate that thousand separators are
        wanted. The actual character used as a the thousand separator in the
        output is determined by the ThousandSeparator global variable, which
        is initialized from locale settings obtained from the operating system.

  E+    Scientific notation. If any of the strings 'E+', 'E-', 'e+', or 'e-'
  E-    are contained in the format string, the number is formatted using
  e+    scientific notation. A group of up to four '0' characters can
  e-    immediately follow the 'E+', 'E-', 'e+', or 'e-' to determine the
        minimum number of digits in the exponent. The 'E+' and 'e+' formats
        cause a plus sign to be output for positive exponents and a minus
        sign to be output for negative exponents. The 'E-' and 'e-' formats
        output a sign character only for negative exponents.

  'xx'  Characters enclosed in single or double quotes are output as-is, and
  "xx"  do not affect formatting.

  ;     Separates sections for positive, negative, and zero numbers in the
        format string.

  The locations of the leftmost '0' before the decimal point in the format
  string and the rightmost '0' after the decimal point in the format string
  determine the range of digits that are always present in the output string.

  The number being formatted is always rounded to as many decimal places as
  there are digit placeholders ('0' or '#') to the right of the decimal
  point. If the format string contains no decimal point, the value being
  formatted is rounded to the nearest whole number.

  If the number being formatted has more digits to the left of the decimal
  separator than there are digit placeholders to the left of the '.'
  character in the format string, the extra digits are output before the
  first digit placeholder.

  To allow different formats for positive, negative, and zero values, the
  format string can contain between one and three sections separated by
  semicolons.

  One section - The format string applies to all values.

  Two sections - The first section applies to positive values and zeros, and
  the second section applies to negative values.

  Three sections - The first section applies to positive values, the second
  applies to negative values, and the third applies to zeros.

  If the section for negative values or the section for zero values is empty,
  that is if there is nothing between the semicolons that delimit the
  section, the section for positive values is used instead.

  If the section for positive values is empty, or if the entire format string
  is empty, the value is formatted using general floating-point formatting
  with 15 significant digits, corresponding to a call to FloatToStrF with
  the ffGeneral format. General floating-point formatting is also used if
  the value has more than 18 digits to the left of the decimal point and
  the format string does not specify scientific notation.

  The table below shows some sample formats and the results produced when
  the formats are applied to different values:

  Format string          1234        -1234       0.5         0
  -----------------------------------------------------------------------
                         1234        -1234       0.5         0
  0                      1234        -1234       1           0
  0.00                   1234.00     -1234.00    0.50        0.00
  #.##                   1234        -1234       .5
  #,##0.00               1,234.00    -1,234.00   0.50        0.00
  #,##0.00;(#,##0.00)    1,234.00    (1,234.00)  0.50        0.00
  #,##0.00;;Zero         1,234.00    -1,234.00   0.50        Zero
  0.000E+00              1.234E+03   -1.234E+03  5.000E-01   0.000E+00
  #.###E-0               1.234E3     -1.234E3    5E-1        0E0
  -----------------------------------------------------------------------}

function FormatFloat(const Format: string; Value: Extended): string; overload;
function FormatFloat(const Format: string; Value: Extended;
  const FormatSettings: TFormatSettings): string; overload;
function FormatFloat(const Format: string; Value: Extended;
  Provider: IFormatProvider): string; overload;

{ FormatCurr formats the currency value given by Value using the format
  string given by Format. For further details, see the description of the
  FormatFloat function. }

function FormatCurr(const Format: string; Value: Currency): string; overload;
function FormatCurr(const Format: string; Value: Currency;
  const FormatSettings: TFormatSettings): string; overload;
function FormatCurr(const Format: string; Value: Currency;
  Provider: IFormatProvider): string; overload;

{ StrToFloat converts the given string to a floating-point value. The string
  must consist of an optional sign (+ or -), a string of digits with an
  optional decimal point, and an optional 'E' or 'e' followed by a signed
  integer. Leading and trailing blanks in the string are ignored. The
  DecimalSeparator global variable defines the character that must be used
  as a decimal point. Note that unlike with dcc32, Thousand separators and
  currency symbols ARE allowed in the string. If the string doesn't contain
  a valid value, FormatCurr raises an EConvertError exception. }

function StrToFloat(const S: string): Extended; overload;
function StrToFloat(const S: string; const FormatSettings: TFormatSettings): Extended; overload;
function StrToFloat(const S: string; Provider: IFormatProvider): Extended; overload;

function StrToFloatDef(const S: string; const Default: Extended): Extended; overload;
function StrToFloatDef(const S: string; const Default: Extended;
  const FormatSettings: TFormatSettings): Extended; overload;
function StrToFloatDef(const S: string; const Default: Extended;
  Provider: IFormatProvider): Extended; overload;

function TryStrToFloat(const S: string; out Value: Double): Boolean; overload;
function TryStrToFloat(const S: string; out Value: Double;
  const FormatSettings: TFormatSettings): Boolean; overload;
function TryStrToFloat(const S: string; out Value: Double;
  Provider: IFormatProvider): Boolean; overload;

function TryStrToFloat(const S: string; out Value: Single): Boolean; overload;
function TryStrToFloat(const S: string; out Value: Single;
  const FormatSettings: TFormatSettings): Boolean; overload;
function TryStrToFloat(const S: string; out Value: Single;
  Provider: IFormatProvider): Boolean; overload;

{ StrToCurr converts the given string to a currency value. For further
  details, see the description of the StrToFloat function. }

function StrToCurr(const S: string): Currency; overload;
function StrToCurr(const S: string; const FormatSettings: TFormatSettings): Currency; overload;
function StrToCurr(const S: string; Provider: IFormatProvider): Currency; overload;

function StrToCurrDef(const S: string; const Default: Currency): Currency; overload;
function StrToCurrDef(const S: string; const Default: Currency;
  const FormatSettings: TFormatSettings): Currency; overload;
function StrToCurrDef(const S: string; const Default: Currency;
  Provider: IFormatProvider): Currency; overload;

function TryStrToCurr(const S: string; out Value: Currency): Boolean; overload;
function TryStrToCurr(const S: string; out Value: Currency;
  const FormatSettings: TFormatSettings): Boolean; overload;
function TryStrToCurr(const S: string; out Value: Currency;
  Provider: IFormatProvider): Boolean; overload;


{ StringReplace replaces occurances of <oldpattern> with <newpattern> in a
  given string. }

type
  TReplaceFlags = set of (rfReplaceAll, rfIgnoreCase);

function StringReplace(const S, OldPattern, NewPattern: string;
  Flags: TReplaceFlags): string;

{ WrapText will scan a string for BreakChars and insert the BreakStr at the
  last BreakChar position before MaxCol.  Will not insert a break into an
  embedded quoted string (both ''' and '"' supported) }

{! WrapText: Type of BreakChars has changed from set to dynamic array. This breaks
  backward compatibility, and needs to be documented. }

function WrapText(const Line, BreakStr: WideString; const BreakChars: array of WideChar;
  MaxCol: Integer): string; overload;
function WrapText(const Line, BreakStr: AnsiString; const BreakChars: array of AnsiChar;
  MaxCol: Integer): string; overload;
function WrapText(const Line: string; MaxCol: Integer = 45): string; overload;

{ FindCmdLineSwitch determines whether the string in the Switch parameter
  was passed as a command line argument to the application.  SwitchChars
  identifies valid argument-delimiter characters (i.e., "-" and "/" are
  common delimiters). The IgnoreCase paramter controls whether a
  case-sensistive or case-insensitive search is performed. }

const
  SwitchChars =  ['/','-'];

function FindCmdLineSwitch(const Switch: string; const Chars: TSysCharSet;
  IgnoreCase: Boolean): Boolean; overload;

{ These versions of FindCmdLineSwitch are convenient for writing portable
  code.  The characters that are valid to indicate command line switches vary
  on different platforms.  For example, '/' cannot be used as a switch char
  on Linux because '/' is the path delimiter. }

{ This version uses SwitchChars defined above. }
function FindCmdLineSwitch(const Switch: string; IgnoreCase: Boolean): Boolean; overload;

{ This version uses SwitchChars defined above, and IgnoreCase False. }
function FindCmdLineSwitch(const Switch: string): Boolean; overload;

{ FreeAndNil frees the given TObject instance and sets the variable reference
  to nil.  Be careful to pass only TObjects to this routine. Note: FreeAndNil
  differs subtly from the dcc32 version. Because of compiler differences on
  untyped parameters, Obj is not set to nil until after the free occurs, where
  under dcc32, the change to nil happened before the call to the Free method.}

procedure FreeAndNil(var Obj);

type

{ Exceptions }

  ExceptionHelper = class helper (TObjectHelper) for Exception
  private
    class function CreateMsg(const Msg: string): Exception;
    function GetHelpContext: Integer;
    procedure SetHelpContext(AHelpContext: Integer);
  public
    /// Doc: The help context return zero(0) if exception's helplink property cannot be parsed into an integer.
    property HelpContext: Integer read GetHelpContext write SetHelpContext;

    // constructor Create(const Msg: string) is provided by the CLR class
    class function CreateFmt(const Msg: string; const Args: array of const): Exception;
    class function CreateHelp(const Msg: string; AHelpContext: Integer): Exception;
    class function CreateFmtHelp(const Msg: string; const Args: array of const;
      AHelpContext: Integer): Exception;

    // System.Exception.HResult is protected.  This helper exposes
    // the HResult for read-only access by non-descendents
    function HResult: Integer;
  end;
  ExceptionClass = class of Exception;

const
  MaxEraCount = 7;

{ GetFormatSettings resets all locale-specific variables (date, time, number,
  currency formats, system locale) to the values provided by the operating system. }

procedure GetFormatSettings;

{ GetLocaleFormatSettings loads locale-specific variables (date, time, number,
  currency formats) with values provided by the operating system for the
  specified locale (LCID). The values are stored in the FormatSettings record. }

procedure GetLocaleFormatSettings(LCID: Integer;
  var FormatSettings: TFormatSettings);

{*******************************************************}
{       SysUtils Date/Time Support Section              }
{*******************************************************}

const

/// Units of time and DateDelta have been moved to Borland.Delphi.System

{ Days between TDateTime basis (12/31/1899) and Unix time_t basis (1/1/1970) }
  UnixDateDelta = 25569;

type

{ Date and time record }

  TTimeStamp = record
    Time: Integer;      { Number of milliseconds since midnight }
    Date: Integer;      { One plus number of days since 1/1/0001 }
  end;

{ Date/time support routines }

function DateTimeToTimeStamp(ADateTime: TDateTime): TTimeStamp;

function TimeStampToDateTime(const ATimeStamp: TTimeStamp): TDateTime;

{! MSecsToTimeStamp/TimeStampToMSecs used to use Comp as their working type,
  they now use Int64. }

function MSecsToTimeStamp(MSecs: Int64): TTimeStamp;
function TimeStampToMSecs(const ATimeStamp: TTimeStamp): Int64;

{ EncodeDate encodes the given year, month, and day into a TDateTime value.
  The year must be between 1 and 9999, the month must be between 1 and 12,
  and the day must be between 1 and N, where N is the number of days in the
  specified month. If the specified values are not within range, an
  EConvertError exception is raised. The resulting value is the number of
  days between 12/30/1899 and the given date. }

function EncodeDate(Year, Month, Day: Word): TDateTime;

{ EncodeTime encodes the given hour, minute, second, and millisecond into a
  TDateTime value. The hour must be between 0 and 23, the minute must be
  between 0 and 59, the second must be between 0 and 59, and the millisecond
  must be between 0 and 999. If the specified values are not within range, an
  EConvertError exception is raised. The resulting value is a number between
  0 (inclusive) and 1 (not inclusive) that indicates the fractional part of
  a day given by the specified time. The value 0 corresponds to midnight,
  0.5 corresponds to noon, 0.75 corresponds to 6:00 pm, etc. }

function EncodeTime(Hour, Min, Sec, MSec: Word): TDateTime;

{ Instead of generating errors the following variations of EncodeDate and
  EncodeTime simply return False if the parameters given are not valid.
  Other than that, these functions are functionally the same as the above
  functions. }

function TryEncodeDate(Year, Month, Day: Word; out Date: TDateTime): Boolean;
function TryEncodeTime(Hour, Min, Sec, MSec: Word; out Time: TDateTime): Boolean;

{ DecodeDate decodes the integral (date) part of the given TDateTime value
  into its corresponding year, month, and day. If the given TDateTime value
  is less than or equal to zero, the year, month, and day return parameters
  are all set to zero. }

procedure DecodeDate(const ADateTime: TDateTime; var Year, Month, Day: Word);

{ This variation of DecodeDate works similarly to the above function but
  returns more information.  The result value of this function indicates
  whether the year decoded is a leap year or not.  }

function DecodeDateFully(const ADateTime: TDateTime; var Year, Month, Day,
  DOW: Word): Boolean;

{ DecodeTime decodes the fractional (time) part of the given TDateTime value
  into its corresponding hour, minute, second, and millisecond. }

procedure DecodeTime(const ADateTime: TDateTime; var Hour, Min, Sec, MSec: Word);

{ DateTimeToSystemTime converts a date and time from Delphi's TDateTime
  format into the Win32 API's TSystemTime format. }

procedure DateTimeToSystemTime(const ADateTime: TDateTime; var SystemTime: TSystemTime); platform;

{ SystemTimeToDateTime converts a date and time from the Win32 API's
  TSystemTime format into Delphi's TDateTime format. }

function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime; platform;

{ DayOfWeek returns the day of the week of the given date. The result is an
  integer between 1 and 7, corresponding to Sunday through Saturday.
  This function is not ISO 8601 compliant, for that see the DateUtils unit. }

function DayOfWeek(const ADateTime: TDateTime): Word;

{ Date returns the current date. }

function Date: TDateTime;

{ Time returns the current time. }

function Time: TDateTime;
function GetTime: TDateTime;

{ Now returns the current date and time, corresponding to Date + Time. }

function Now: TDateTime;

{ Current year returns the year portion of the date returned by Now }

function CurrentYear: Word;

{ IncMonth returns Date shifted by the specified number of months.
  NumberOfMonths parameter can be negative, to return a date N months ago.
  If the input day of month is greater than the last day of the resulting
  month, the day is set to the last day of the resulting month.
  Input time of day is copied to the DateTime result.  }

function IncMonth(const ADateTime: TDateTime; NumberOfMonths: Integer = 1): TDateTime;

{ Optimized version of IncMonth that works with years, months and days
  directly.  See above comments for more detail as to what happens to the day
  when incrementing months }

procedure IncAMonth(var Year, Month, Day: Word; NumberOfMonths: Integer = 1);

{ ReplaceTime replaces the time portion of the DateTime parameter with the given
  time value, adjusting the signs as needed if the date is prior to 1900
  (Date value less than zero)  }

procedure ReplaceTime(var ADateTime: TDateTime; const NewTime: TDateTime);

{ ReplaceDate replaces the date portion of the DateTime parameter with the given
  date value, adjusting as needed for negative dates }

procedure ReplaceDate(var ADateTime: TDateTime; const NewDate: TDateTime);

{ IsLeapYear determines whether the given year is a leap year. }

function IsLeapYear(Year: Word): Boolean;

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

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

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

{ Each of the date/time formatting routines that uses global variables
  for formatting (separators, decimals, etc.), have 2 overloaded
  equivalents. One requires a parameter of type TFormatSettings, the
  other IFormatProvider. These additional parameters provides the
  formatting information rather than the global variables. }

{ DateToStr converts the date part of the given TDateTime value to a string.
  The conversion uses the format specified by the ShortDateFormat global
  variable. }

function DateToStr(const ADateTime: TDateTime): string; overload;
function DateToStr(const ADateTime: TDateTime; const FormatSettings: TFormatSettings): string; overload;
function DateToStr(const ADateTime: TDateTime; Provider: IFormatProvider): string; overload;

{ TimeToStr converts the time part of the given TDateTime value to a string.
  The conversion uses the format specified by the LongTimeFormat global
  variable. }

function TimeToStr(const ADateTime: TDateTime): string; overload;
function TimeToStr(const ADateTime: TDateTime; const FormatSettings: TFormatSettings): string; overload;
function TimeToStr(const ADateTime: TDateTime; Provider: IFormatProvider): string; overload;

{ DateTimeToStr converts the given date and time to a string. The resulting
  string consists of a date and time formatted using the ShortDateFormat and
  LongTimeFormat global variables. Time information is included in the
  resulting string only if the fractional part of the given date and time
  value is non-zero. }

function DateTimeToStr(const ADateTime: TDateTime): string; overload;
function DateTimeToStr(const ADateTime: TDateTime; const FormatSettings: TFormatSettings): string; overload;
function DateTimeToStr(const ADateTime: TDateTime; Provider: IFormatProvider): string; overload;

{ StrToDate converts the given string to a date value. The string must
  consist of two or three numbers, separated by the character defined by
  the DateSeparator global variable. The order for month, day, and year is
  determined by the ShortDateFormat global variable--possible combinations
  are m/d/y, d/m/y, and y/m/d. If the string contains only two numbers, it
  is interpreted as a date (m/d or d/m) in the current year. Year values
  between 0 and 99 are assumed to be in the current century. If the given
  string does not contain a valid date, an EConvertError exception is
  raised. }

function StrToDate(const S: string): TDateTime; overload;
function StrToDate(const S: string; const FormatSettings: TFormatSettings): TDateTime; overload;
function StrToDate(const S: string; Provider: IFormatProvider): TDateTime; overload;

function StrToDateDef(const S: string; const Default: TDateTime): TDateTime; overload;
function StrToDateDef(const S: string; const Default: TDateTime;
  const FormatSettings: TFormatSettings): TDateTime; overload;
function StrToDateDef(const S: string; const Default: TDateTime;
  Provider: IFormatProvider): TDateTime; overload;

function TryStrToDate(const S: string; out Value: TDateTime): Boolean; overload;
function TryStrToDate(const S: string; out Value: TDateTime;
  const FormatSettings: TFormatSettings): Boolean; overload;
function TryStrToDate(const S: string; out Value: TDateTime;
  Provider: IFormatProvider): Boolean; overload;

{ StrToTime converts the given string to a time value. The string must
  consist of two or three numbers, separated by the character defined by
  the TimeSeparator global variable, optionally followed by an AM or PM
  indicator. The numbers represent hour, minute, and (optionally) second,
  in that order. If the time is followed by AM or PM, it is assumed to be
  in 12-hour clock format. If no AM or PM indicator is included, the time
  is assumed to be in 24-hour clock format. If the given string does not
  contain a valid time, an EConvertError exception is raised. }

function StrToTime(const S: string): TDateTime; overload;
function StrToTime(const S: string; const FormatSettings: TFormatSettings): TDateTime; overload;
function StrToTime(const S: string; Provider: IFormatProvider): TDateTime; overload;

function StrToTimeDef(const S: string; const Default: TDateTime): TDateTime; overload;
function StrToTimeDef(const S: string; const Default: TDateTime;
  const FormatSettings: TFormatSettings): TDateTime; overload;
function StrToTimeDef(const S: string; const Default: TDateTime;
  Provider: IFormatProvider): TDateTime; overload;

function TryStrToTime(const S: string; out Value: TDateTime): Boolean; overload;
function TryStrToTime(const S: string; out Value: TDateTime;
  const FormatSettings: TFormatSettings): Boolean; overload;
function TryStrToTime(const S: string; out Value: TDateTime;
  Provider: IFormatProvider): Boolean; overload;

{ StrToDateTime converts the given string to a date and time value. The
  string must contain a date optionally followed by a time. The date and
  time parts of the string must follow the formats described for the
  StrToDate and StrToTime functions. }

function StrToDateTime(const S: string): TDateTime; overload;
function StrToDateTime(const S: string; const FormatSettings: TFormatSettings): TDateTime; overload;
function StrToDateTime(const S: string; Provider: IFormatProvider): TDateTime; overload;

function StrToDateTimeDef(const S: string; const Default: TDateTime): TDateTime; overload;
function StrToDateTimeDef(const S: string; const Default: TDateTime;
  const FormatSettings: TFormatSettings): TDateTime; overload;
function StrToDateTimeDef(const S: string; const Default: TDateTime;
  Provider: IFormatProvider): TDateTime; overload;

function TryStrToDateTime(const S: string; out Value: TDateTime): Boolean; overload;
function TryStrToDateTime(const S: string; out Value: TDateTime;
  const FormatSettings: TFormatSettings): Boolean; overload;
function TryStrToDateTime(const S: string; out Value: TDateTime;
  Provider: IFormatProvider): Boolean; overload;

{ FormatDateTime formats the date-and-time value given by DateTime using the
  format given by Format. The following format specifiers are supported:

  c       Displays the date using the format given by the ShortDateFormat
          global variable, followed by the time using the format given by
          the LongTimeFormat global variable. The time is not displayed if
          the fractional part of the DateTime value is zero.

  d       Displays the day as a number without a leading zero (1-31).

  dd      Displays the day as a number with a leading zero (01-31).

  ddd     Displays the day as an abbreviation (Sun-Sat) using the strings
          given by the ShortDayNames global variable.

  dddd    Displays the day as a full name (Sunday-Saturday) using the strings
          given by the LongDayNames global variable.

  ddddd   Displays the date using the format given by the ShortDateFormat
          global variable.

  dddddd  Displays the date using the format given by the LongDateFormat
          global variable.

  g       Displays the period/era as an abbreviation (Japanese and
          Taiwanese locales only). -- uses gg instead in clr

  gg      Displays the period/era as a full name.

  e       Displays the year in the current period/era as a number without
          a leading zero (Japanese, Korean and Taiwanese locales only).
          -- uses gg instead in clr

  ee      Displays the year in the current period/era as a number with
          a leading zero (Japanese, Korean and Taiwanese locales only).
          -- uses gg instead in clr

  m       Displays the month as a number without a leading zero (1-12). If
          the m specifier immediately follows an h or hh specifier, the
          minute rather than the month is displayed.

  mm      Displays the month as a number with a leading zero (01-12). If
          the mm specifier immediately follows an h or hh specifier, the
          minute rather than the month is displayed.

  mmm     Displays the month as an abbreviation (Jan-Dec) using the strings
          given by the ShortMonthNames global variable.

  mmmm    Displays the month as a full name (January-December) using the
          strings given by the LongMonthNames global variable.

  yy      Displays the year as a two-digit number (00-99).

  yyyy    Displays the year as a four-digit number (0000-9999).

  h       Displays the hour without a leading zero (0-23).

  hh      Displays the hour with a leading zero (00-23).

  n       Displays the minute without a leading zero (0-59).

  nn      Displays the minute with a leading zero (00-59).

  s       Displays the second without a leading zero (0-59).

  ss      Displays the second with a leading zero (00-59).

  z       Displays the millisecond without a leading zero (0-999). not supported
          in clr -- uses zzz instead.

  zzz     Displays the millisecond with a leading zero (000-999).

  t       Displays the time using the format given by the ShortTimeFormat
          global variable.

  tt      Displays the time using the format given by the LongTimeFormat
          global variable.

  am/pm   Uses the 12-hour clock for the preceding h or hh specifier, and
          displays 'am' for any hour before noon, and 'pm' for any hour
          after noon. Not supported in clr, uses ampm instead.

  a/p     Uses the 12-hour clock for the preceding h or hh specifier, and
          displays 'a' for any hour before noon, and 'p' for any hour after
          noon. Except on CLR, The a/p specifier can use lower, upper,
          or mixed case, and the result is displayed accordingly.

  ampm    Uses the 12-hour clock for the preceding h or hh specifier, and
          displays the contents of the TimeAMString global variable for any
          hour before noon, and the contents of the TimePMString global
          variable for any hour after noon.

  /       Displays the date separator character given by the DateSeparator
          global variable.

  :       Displays the time separator character given by the TimeSeparator
          global variable.

  'xx'    Characters enclosed in single or double quotes are displayed as-is,
  "xx"    and do not affect formatting.

  Format specifiers may be written in upper case as well as in lower case
  letters--both produce the same result.

  If the string given by the Format parameter is empty, the date and time
  value is formatted as if a 'c' format specifier had been given.

  The following example:

    S := FormatDateTime('"The meeting is on" dddd, mmmm d, yyyy, ' +
      '"at" hh:mm AM/PM', StrToDateTime('2/15/95 10:30am'));

  assigns 'The meeting is on Wednesday, February 15, 1995 at 10:30 AM' to
  the string variable S. }

function FormatDateTime(const Format: string; ADateTime: TDateTime): string; overload;
function FormatDateTime(const Format: string; ADateTime: TDateTime;
  const FormatSettings: TFormatSettings): string; overload;
function FormatDateTime(const Format: string; ADateTime: TDateTime;
  Provider: IFormatProvider): string; overload;

{ DateTimeToString converts the date and time value given by DateTime using
  the format string given by Format into the string variable given by Result.
  For further details, see the description of the FormatDateTime function. }

procedure DateTimeToString(var Result: string; const Format: string;
  ADateTime: TDateTime); overload;
procedure DateTimeToString(var Result: string; const Format: string;
  ADateTime: TDateTime; const FormatSettings: TFormatSettings); overload;
procedure DateTimeToString(var Result: string; const Format: string;
  ADateTime: TDateTime; Provider: IFormatProvider); overload;

{ ConvertDelphiDateTimeFormat and ConvertClrDateTimeFormat convert between
 our date time format strings and the ones used by System.DateTime. This
 comes close, but there are some cases where the mapping must be approximate.
  For Delphi formats, this means
    * am/pm maps to ampm (that is, must use system setting)
    * a/p is based on current settings, not hardcoded to 'a' or 'p'
    * no control over case in the am/pm or a/p strings
    * no options for how to represent era, they all map to gg
    * no support for z -- it maps to fractional seconds with 3 decimals (zzz)

  For CLR formats, this means
    * no support for single-digit years, they map to 2 digit years.
    * no support for 12-hour clock when there is no am/pm symbol, 24-hour is used.
    * no support for fractional seconds, they map to milliseconds (zzz)
    * no support for time zone offsets
 }
function ConvertDelphiDateTimeFormat(const Format: string): string;
function ConvertClrDateTimeFormat(const Format: string): string;

{ FloatToDateTime will range validate a value to make sure it falls
  within the acceptable date range }

function MinDateTime: TDateTime; { 01/01/0100 12:00:00.000 AM }
function MaxDateTime: TDateTime; { 12/31/9999 11:59:59.999 PM }

function FloatToDateTime(const Value: Extended): TDateTime;
function TryFloatToDateTime(const Value: Extended; out AResult: TDateTime): Boolean;

{ In Linux, the parameter to sleep() is in whole seconds.  In Windows, the
  parameter is in milliseconds.  To ease headaches, we implement a version
  of sleep here for Linux that takes milliseconds and calls a Linux system
  function with sub-second resolution.  This maps directly to the Windows
  API on Windows. }

procedure Sleep(milliseconds: Cardinal);

{ System error messages }

function SysErrorMessage(ErrorCode: Integer): string;

type
  EOSError = class(Exception)
  public
    ErrorCode: Cardinal;
  end;

{ RaiseLastOSError calls GetLastError to retrieve the code for
  the last occuring error in a call to an OS or system library function.
  If GetLastError returns an error code,  RaiseLastOSError raises
  an EOSError exception with the error code and a system-provided
  message associated with with error. }

procedure RaiseLastOSError;

procedure RaiseLastWin32Error; deprecated;  // use RaiseLastOSError

{ Win32Check is used to check the return value of a Win32 API function     }
{ which returns a BOOL to indicate success.  If the Win32 API function     }
{ returns False (indicating failure), Win32Check calls RaiseLastWin32Error }
{ to raise an exception.  If the Win32 API function returns True,          }
{ Win32Check returns True. }

function Win32Check(RetVal: BOOL): BOOL;

{ ExceptionErrorMessage returns an error message that results from
  the supplied exception object. Note that this is not backward compatible }
function ExceptionErrorMessage(AExceptObject: TObject): string;

{ShowException displays an exception error message in a message box or to
the console window, depending on the type of application. The second
parameter is ignored on CLR, and is included only for backward compatibility}
procedure ShowException(AExceptObject: TObject; ExceptAddr: IntPtr);

{ExceptAddr is for compatibility so that calls to ShowException have
 a nil pointer to pass for the second parameter}
const
  ExceptAddr = nil;
  
{ HexDisplayPrefix contains the prefix to display on hexadecimal
  values - '$' for Pascal syntax, '0x' for C++ syntax.  This is
  for display only - this does not affect the string-to-integer
  conversion routines. }
var
  HexDisplayPrefix: string = '$';

{ File management routines }

var
  PathDelim: Char;
  DriveDelim: Char;
  PathSep: Char;

function Languages: TLanguages;
  
{ IsPathDelimiter returns True if the character S[Index]
  is a PathDelimiter ('\' or '/') }

function IsPathDelimiter(const S: string; Index: Integer): Boolean;

{ IsDelimiter returns True if the character S[Index] matches any
  character in the Delimiters string. }

function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;

{ IncludeTrailingPathDelimiter returns the path with a PathDelimiter
  ('/' or '\') at the end.  This function is MBCS enabled. }

function IncludeTrailingPathDelimiter(const S: string): string;

{ IncludeTrailingBackslash is the old name for IncludeTrailingPathDelimiter. }

function IncludeTrailingBackslash(const S: string): string; platform;

{ ExcludeTrailingPathDelimiter returns the path without a PathDelimiter
  ('\' or '/') at the end.  This function is MBCS enabled. }

function ExcludeTrailingPathDelimiter(const S: string): string;

{ ExcludeTrailingBackslash is the old name for ExcludeTrailingPathDelimiter. }

function ExcludeTrailingBackslash(const S: string): string; platform;

{ LastDelimiter returns the index in S of the rightmost whole
  character that matches any character in Delimiters (except null (#0)).
  Example: LastDelimiter('\.:', 'c:\filename.ext') returns 12. }

function LastDelimiter(const Delimiters, S: string): Integer;

{ AnsiCompareFileName supports DOS file name comparison idiosyncracies
  in Far East locales (Zenkaku) on Windows.
  In non-MBCS locales on Windows, AnsiCompareFileName is identical to
  AnsiCompareText (case insensitive).
  On Linux, AnsiCompareFileName is identical to AnsiCompareStr (case sensitive).
  For general purpose file name comparisions, you should use this function
  instead of AnsiCompareText. }

function AnsiCompareFileName(const S1, S2: AnsiString): Integer; overload;
function AnsiCompareFileName(const S1, S2: WideString): Integer; overload; deprecated;

function SameFileName(const S1, S2: string): Boolean;

{ AnsiLowerCaseFileName supports lowercase conversion idiosyncracies of
  DOS file names in Far East locales (Zenkaku).  In non-MBCS locales,
  AnsiLowerCaseFileName is identical to AnsiLowerCase. }

function AnsiLowerCaseFileName(const S: AnsiString): AnsiString; overload;
function AnsiLowerCaseFileName(const S: WideString): WideString; overload; deprecated;

{ AnsiUpperCaseFileName supports uppercase conversion idiosyncracies of
  DOS file names in Far East locales (Zenkaku).  In non-MBCS locales,
  AnsiUpperCaseFileName is identical to AnsiUpperCase. }

function AnsiUpperCaseFileName(const S: AnsiString): AnsiString; overload;
function AnsiUpperCaseFileName(const S: WideString): WideString; overload; deprecated;

{*******************************************************}
{          Interface support routines                   }
{*******************************************************}

type
  TInterfaceRef = type of interface;

function Supports(const Instance: TObject; const IID: TInterfaceRef; out Intf): Boolean; overload;
function Supports(const Instance: TObject; const IID: TInterfaceRef): Boolean; overload;
function Supports(const AClass: TClass; const IID: TInterfaceRef): Boolean; overload;

{**************************}
{  GUID handling routines  }
{**************************}

function CreateGUID(out Guid: Borland.Delphi.System.TGUID): HResult;
function StringToGUID(const S: string): Borland.Delphi.System.TGUID;
function GUIDToString(const GUID: Borland.Delphi.System.TGUID): string;
function IsEqualGUID(const guid1, guid2: Borland.Delphi.System.TGUID): Boolean;

{*******************************************************}
{        Misc routines                                  }
{*******************************************************}

type
  EAbort = class(Exception);

procedure Abort;

procedure Beep;

{ LeadBytes is a char set that indicates which char values are lead bytes
  in multibyte character sets (Japanese, Chinese, etc).
  This set is always empty for western locales. }
var
  LeadBytes: set of AnsiChar = [];

{ ByteType indicates what kind of byte exists at the Index'th byte in S.
  Western locales always return mbSingleByte.  Far East multibyte locales
  may also return mbLeadByte, indicating the byte is the first in a multibyte
  character sequence, and mbTrailByte, indicating that the byte is one of
  a sequence of bytes following a lead byte.  One or more trail bytes can
  follow a lead byte, depending on locale charset encoding and OS platform.
  Parameters are assumed to be valid. }

function ByteType(const S: AnsiString; Index: Integer): TMbcsByteType; overload;
function ByteType(const S: WideString; Index: Integer): TMbcsByteType; overload; deprecated;

{ ByteToCharLen returns the character length of a MBCS string, scanning the
  string for up to MaxLen bytes.  In multibyte character sets, the number of
  characters in a string may be less than the number of bytes.  }

function ByteToCharLen(const S: AnsiString; MaxLen: Integer): Integer; overload;
function ByteToCharLen(const S: WideString; MaxLen: Integer): Integer; overload; deprecated;

{ CharToByteLen returns the byte length of a MBCS string, scanning the string
  for up to MaxLen characters. }

function CharToByteLen(const S: AnsiString; MaxLen: Integer): Integer; overload;
function CharToByteLen(const S: WideString; MaxLen: Integer): Integer; overload; deprecated;

{ ByteToCharIndex returns the 1-based character index of the Index'th byte in
  a MBCS string.  Returns zero if Index is out of range:
  (Index <= 0) or (Index > Length(S)) }

function ByteToCharIndex(const S: AnsiString; Index: Integer): Integer; overload;
function ByteToCharIndex(const S: WideString; Index: Integer): Integer; overload; deprecated;

{ CharToByteIndex returns the 1-based byte index of the Index'th character
  in a MBCS string.  Returns zero if Index or Result are out of range:
  (Index <= 0) or (Index > Length(S)) or (Result would be > Length(S)) }

function CharToByteIndex(const S: AnsiString; Index: Integer): Integer; overload;
function CharToByteIndex(const S: WideString; Index: Integer): Integer; overload; deprecated;

{ CharLength returns the number of bytes required by the character starting
  at bytes S[Index].  }

function CharLength(const S: AnsiString; Index: Integer): Integer; overload;
function CharLength(const S: WideString; Index: Integer): Integer; overload; deprecated;

{ NextCharIndex returns the byte index of the first byte of the character
  following the character starting at S[Index].  }

function NextCharIndex(const S: AnsiString; Index: Integer): Integer; overload;
function NextCharIndex(const S: WideString; Index: Integer): Integer; overload; deprecated;

var
{ Empty string constants. These constants are provided for
  backwards compatibility only.  }

  EmptyStr: string = '';
  EmptyWideStr: WideString = '';

{ Win32 platform identifier.  This will be one of the following values:

    VER_PLATFORM_WIN32s
    VER_PLATFORM_WIN32_WINDOWS
    VER_PLATFORM_WIN32_NT

  See Borland.Vcl.Windows.pas for the numerical values. }

  Win32Platform: Integer = 0;

{ Win32 OS version information}

  Win32MajorVersion: Integer = 0;
  Win32MinorVersion: Integer = 0;
  Win32BuildNumber: Integer = 0;

{ Win32 OS extra version info string -

  see TOSVersionInfo.szCSDVersion }

  Win32CSDVersion: string = '';

{ OS version tester }

function CheckOSVersion(AMajor: Integer; AMinor: Integer = 0): Boolean;

{ Win32 OS version tester }

function CheckWin32Version(AMajor: Integer; AMinor: Integer = 0): Boolean; platform;

{ GetFileVersion returns the most significant 32 bits of a file's binary
  version number. Typically, this includes the major and minor version placed
  together in one 32-bit integer. It generally does not include the release
  or build numbers. It returns Cardinal(-1) if it failed. }

function GetFileVersion(const AFileName: string): Cardinal;

{ Checks that the current thread uses the specified threading model. If not it
  raises an exception. }

procedure CheckThreadingModel(Model: System.Threading.ApartmentState);
                                                       
{ SafeLoadLibrary calls LoadLibrary, disabling normal Win32 error message
  popup dialogs if the requested file can't be loaded.  SafeLoadLibrary also
  preserves the current FPU control word (precision, exception masks) across
  the LoadLibrary call (in case the DLL you're loading hammers the FPU control
  word in its initialization, as many MS DLLs do)}

function SafeLoadLibrary(const Filename: string;
  ErrorMode: UINT = SEM_NOOPENFILEERRORBOX): HMODULE;

{ Thread synchronization }

{ IReadWriteSync is an abstract interface for general read/write synchronization.
  Some implementations may allow simultaneous readers, but writers always have
  exclusive locks. Worst case is that this class behaves identical to a TRTLCriticalSection -
  that is, read and write locks block all other threads. }

type
  IReadWriteSync = interface
    ['{7B108C52-1D8F-4CDB-9CDF-57E071193D3F}']
    procedure BeginRead;
    procedure EndRead;
    function BeginWrite: Boolean;
    procedure EndWrite;
  end;

{ TMultiReadExclusiveWriteSynchronizer minimizes thread serialization to gain
  read access to a resource shared among threads while still providing complete
  exclusivity to callers needing write access to the shared resource.
  (multithread shared reads, single thread exclusive write)
  Read locks are allowed while owning a write lock.
  Read locks can be promoted to write locks within the same thread.
  (BeginRead, BeginWrite, EndWrite, EndRead)

  Note: Other threads have an opportunity to modify the protected resource
  when you call BeginWrite before you are granted the write lock, even
  if you already have a read lock open.  Best policy is not to retain
  any info about the protected resource (such as count or size) across a
  write lock.  Always reacquire samples of the protected resource after
  acquiring or releasing a write lock.

  The function result of BeginWrite indicates whether another thread got
  the write lock while the current thread was waiting for the write lock.
  Return value of True means that the write lock was acquired without
  any intervening modifications by other threads.  Return value of False
  means another thread got the write lock while you were waiting, so the
  resource protected by the MREWS object should be considered modified.
  Any samples of the protected resource should be discarded.

  In general, it's better to just always reacquire samples of the protected
  resource after obtaining a write lock.  The boolean result of BeginWrite
  and the RevisionLevel property help cases where reacquiring the samples
  is computationally expensive or time consuming.

  RevisionLevel changes each time a write lock is granted.  You can test
  RevisionLevel for equality with a previously sampled value of the property
  to determine if a write lock has been granted, implying that the protected
  resource may be changed from its state when the original RevisionLevel
  value was sampled.  Do not rely on the sequentiality of the current
  RevisionLevel implementation (it will wrap around to zero when it tops out).
  Do not perform greater than / less than comparisons on RevisionLevel values.
  RevisionLevel indicates only the stability of the protected resource since
  your original sample.  It should not be used to calculate how many
  revisions have been made.
}

type
  TMultiReadExclusiveWriteSynchronizer = class(TInterfacedObject, IReadWriteSync)
  private
    FReaderWriterLock: System.Threading.ReaderWriterLock;
    function GetRevisionLevel: Integer;
  public
    constructor Create;

    procedure BeginRead;
    procedure EndRead;
    function BeginWrite: Boolean;
    procedure EndWrite;

    {! RevisionLevel used to be Cardinal in DCC32 }
    property RevisionLevel: Integer read GetRevisionLevel;
  end;

  // short form
  TMREWSync = TMultiReadExclusiveWriteSynchronizer;

function InterlockedIncrement(var Addend: Integer): Integer;
function InterlockedDecrement(var Addend: Integer): Integer;
function InterlockedExchange(var Target: Integer; Value: Integer): Integer;

function GetEnvironmentVariable(const Name: string): string; overload;

{ DiskFree returns the number of free bytes on the specified drive number,
  where 0 = Current, 1 = A, 2 = B, etc. DiskFree returns -1 if the drive
  number is invalid. }

function DiskFree(const Drive: string): Int64; overload; platform;
function DiskFree(Drive: Char): Int64; overload; platform;
function DiskFree(Drive: Byte): Int64; overload; platform;

{ DiskSize returns the size in bytes of the specified drive number, where
  0 = Current, 1 = A, 2 = B, etc. DiskSize returns -1 if the drive number
  is invalid. }

function DiskSize(const Drive: string): Int64; overload; platform;
function DiskSize(Drive: Char): Int64; overload; platform;
function DiskSize(Drive: Byte): Int64; overload; platform;

{*******************************************************}
{       SysUtils Exception Section                      }
{*******************************************************}

type
  EExternal = class(Exception)
  public
  end;

  EExternalException = class(EExternal);

procedure ZeroDivideError;

implementation

uses
  Math, StrUtils, SysConst,
  System.Globalization, System.Reflection, System.Runtime.InteropServices,
  Microsoft.Win32, System.Diagnostics;

procedure ConvertError(const ResString: string);
begin
  raise EConvertError.Create(ResString); // ..CreateRes(ResString);
end;

procedure ConvertErrorFmt(const ResString: string; const Args: array of const);
begin
  raise EConvertError.Create(Format(ResString, Args)); // ..CreateResFmt(ResString, Args);
end;

procedure ZeroDivideError;
begin
  raise EZeroDivide.Create(SDivByZero);
end;

function UpperCase(const S: string): string;
begin
  if S <> nil then
    Result := System.String(S).ToUpper
  else
    Result := '';
end;

function LowerCase(const S: string): string;
begin
  if S <> nil then
    Result := System.String(S).ToLower
  else
    Result := '';
end;

function CompareStr(const S1, S2: string): Integer;
begin
  Result := System.String.CompareOrdinal(S1, S2);
end;

function SameStr(const S1, S2: string): Boolean;
begin
  Result := CompareStr(S1, S2) = 0;
end;

function CompareText(const S1, S2: string): Integer;
var
  I, Len1, Len2: Integer;
begin
  Len1 := Length(S1);
  Len2 := Length(S2);
  for I := 1 to Len1 do
  begin
    if I > Len2 then
    begin
      Result := 1;
      Exit;
    end;
    Result := Ord(UpCase(S1[I])) - Ord(UpCase(S2[I]));
    if Result <> 0 then Exit;
  end;
  Result := Len1 - Len2;
end;

function SameText(const S1, S2: string): Boolean;
begin
  Result := CompareText(S1, S2) = 0;
end;

function AnsiUpperCase(const S: AnsiString): AnsiString;
begin
  Result := WideUpperCase(S);
end;

function AnsiUpperCase(const S: WideString): WideString; deprecated;
begin
  Result := WideUpperCase(S);
end;

function AnsiLowerCase(const S: AnsiString): AnsiString;
begin
  Result := WideLowerCase(S);
end;

function AnsiLowerCase(const S: WideString): WideString; deprecated;
begin
  Result := WideLowerCase(S);
end;

function AnsiCompareStr(const S1, S2: AnsiString): Integer;
begin
  Result := WideCompareStr(S1, S2);
end;

function AnsiCompareStr(const S1, S2: WideString): Integer; deprecated;
begin
  Result := WideCompareStr(S1, S2);
end;

function AnsiSameStr(const S1, S2: AnsiString): Boolean;
begin
  Result := AnsiCompareStr(S1, S2) = 0;
end;

function AnsiSameStr(const S1, S2: WideString): Boolean; deprecated;
begin
  Result := WideCompareStr(S1, S2) = 0;
end;

function AnsiCompareText(const S1, S2: AnsiString): Integer;
begin
  Result := WideCompareText(S1, S2);
end;

function AnsiCompareText(const S1, S2: WideString): Integer; deprecated;
begin
  Result := WideCompareText(S1, S2);
end;

function AnsiSameText(const S1, S2: AnsiString): Boolean;
begin
  Result := AnsiCompareText(S1, S2) = 0;
end;

function AnsiSameText(const S1, S2: WideString): Boolean; deprecated;
begin
  Result := WideCompareText(S1, S2) = 0;
end;

function WideUpperCase(const S: WideString): WideString;
begin
  if S <> nil then
    Result := System.String(S).ToUpper
  else
    Result := '';
end;

function WideLowerCase(const S: WideString): WideString;
begin
  if S <> nil then
    Result := System.String(S).ToLower
  else
    Result := '';
end;

function WideCompareStr(const S1, S2: WideString): Integer;
begin
  Result := System.String.Compare(S1, S2, False);
end;

function WideSameStr(const S1, S2: WideString): Boolean;
begin
  Result := WideCompareStr(S1, S2) = 0;
end;

function WideCompareText(const S1, S2: WideString): Integer;
begin
  Result := System.String.Compare(S1, S2, True);
end;

function WideSameText(const S1, S2: WideString): Boolean;
begin
  Result := WideCompareText(S1, S2) = 0;
end;

function Trim(const S: string): string;
var
  I, L, E: Integer;
begin
  L := Length(S);
  E := L;
  I := 1;
  while (I <= L) and (S[I] <= ' ') do Inc(I);
  if I > L then Result := ''
  else
  begin
    while S[L] <= ' ' do Dec(L);
    if (I <> 1) or (L <> E) then
      Result := Copy(S, I, L - I + 1)
    else
      Result := S;
  end;
end;

function TrimLeft(const S: string): string;
var
  I, L: Integer;
begin
  L := Length(S);
  I := 1;
  while (I <= L) and (S[I] <= ' ') do Inc(I);
  if I > L then Result := ''
  else if I <> 1 then Result := Copy(S, I, Maxint)
  else Result := S;
end;

function TrimRight(const S: string): string;
var
  I, L: Integer;
begin
  L := Length(S);
  I := L;
  while (I > 0) and (S[I] <= ' ') do Dec(I);
  if I <> L then Result := Copy(S, 1, I)
  else Result := S;
end;

function AnsiPos(const Substr, S: AnsiString): Integer;
begin
   Result := Pos(Substr, S);
end;

function AnsiPos(const Substr, S: WideString): Integer; deprecated;
begin
   Result := Pos(Substr, S);
end;

function QuotedStr(const S: string): string;
begin
  Result := QuotedStr(S, WideChar(''''));
end;

function QuotedStr(const S: string; QuoteChar: Char): string;
var
  SB: StringBuilder;
  I: Integer;
begin
  SB := StringBuilder.Create(S);
  for I := SB.Length - 1 downto 0 do
    if SB[I] = QuoteChar then SB.Insert(I, QuoteChar);
  SB.Insert(0, QuoteChar);
  SB.Append(QuoteChar);
  Result := SB.ToString;
end;

function AnsiQuotedStr(const S: AnsiString; Quote: AnsiChar): AnsiString;
begin
  QuotedStr(S, Char(Quote));
end;

function AnsiQuotedStr(const S: WideString; Quote: WideChar): WideString; deprecated;
begin
  QuotedStr(S, Quote);
end;

function DequotedStr(const S: string): string;
begin
  Result := DequotedStr(S, Char(''''));
end;

function DequotedStr(const S: string; QuoteChar: Char): string;
var
  I: Integer;
begin
  I := 1;
  Result := DequotedStr(S, QuoteChar, I);
end;

function DequotedStr(const S: string; QuoteChar: Char; var P: Integer): string;
var
  SB: StringBuilder;
  Start, L: Integer;
  EndQuoteFound: Boolean;
begin
  if (S = '') or (S[P] <> QuoteChar) then
    Result := ''
  else
  begin
    SB := StringBuilder.create;
    L := Length(S);
    EndQuoteFound := False;
    Inc(P); // skip the first quotechar;
    Start := P;
    while (P <= L) and not EndQuoteFound do
    begin
      if S[P] = QuoteChar then
      begin
        if (P = L) or (S[P+1] <> QuoteChar) then // end of line or of quote
        begin
          SB.Append(Copy(S, Start, P-Start));
          EndQuoteFound := True;
        end
        else // quoted quotechar
        begin
          Inc(P); //skip the "quoting char"
          SB.Append(Copy(S, Start, P-Start));
          Start := P+1;
        end;
      end;
      Inc(P);
    end;
    Result := SB.ToString;
  end;
end;


function AnsiDequotedStr(const S: AnsiString; AQuote: AnsiChar): AnsiString;
begin
  Result := DequotedStr(S, Char(AQuote));
  if Result = ' ' then
    Result := S;
end;

function AnsiDequotedStr(const S: WideString; AQuote: WideChar): WideString; deprecated;
begin
  Result := DequotedStr(S, AQuote);
  if Result = ' ' then
    Result := S;
end;

function AdjustLineBreaks(const S: string; Style: TTextLineBreakStyle): string;
var
  P, Added: Integer;
  SB: StringBuilder;
begin
  if Style = tlbsCRLF then
  begin
    SB := StringBuilder.Create(S);
    Added := 0;
    P := Pos(#10, S) - 1;
    while P >= 0 do
    begin
      if (P = 0) or  (S[P] <> #13) then
      begin
        SB.Insert(P + Added, #13);
        Inc(Added);
      end;
      P := PosEx(#10, S, P + 2) - 1;
    end;
    Result := SB.ToString;
   end
   else { Syle = tlbsLF }
     Result := StringReplace(S, #13#10, #10, [rfReplaceAll]);
end;

function IsBreakChar(C: WideChar; BreakChars: array of WideChar): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to Length(BreakChars) - 1 do
    if BreakChars[I] = C then
    begin
      Result := True;
      Exit;
    end;
end;

function WrapText(const Line, BreakStr: WideString; const BreakChars: array of WideChar;
  MaxCol: Integer): string; overload;
var
  Col, Pos: Integer;
  LinePos, LineLen: Integer;
  BreakLen, BreakPos: Integer;
  QuoteChar, CurChar: WideChar;
  ExistingBreak: Boolean;
  SB: StringBuilder;
begin
  Col := 1;
  Pos := 1;
  LinePos := 1;
  BreakPos := 0;
  QuoteChar := ' ';
  ExistingBreak := False;
  LineLen := Length(Line);
  BreakLen := Length(BreakStr);
  SB := StringBuilder.Create(LineLen + BreakLen * ((LineLen - 1) div MaxCol));
  while Pos <= LineLen do
  begin
    CurChar := Line[Pos];
    if CurChar = BreakStr[1] then
    begin
      if QuoteChar = ' ' then
      begin
        ExistingBreak := System.String.CompareOrdinal(BreakStr, 0, Line, Pos - 1,
          BreakLen) = 0;
        if ExistingBreak then
        begin
          Inc(Pos, BreakLen-1);
          BreakPos := Pos;
        end;
      end
    end
    else if IsBreakChar(CurChar, BreakChars) then
    begin
      if QuoteChar = ' ' then BreakPos := Pos
    end
    else if (CurChar = '''') or (CurChar = '"') then
    begin
      if CurChar = QuoteChar then
        QuoteChar := ' '
      else if QuoteChar = ' ' then
        QuoteChar := CurChar;
    end;
    Inc(Pos);
    Inc(Col);
    if (QuoteChar <> '''') and (QuoteChar <> '"') and (ExistingBreak or
      ((Col > MaxCol) and (BreakPos > LinePos))) then
    begin
      Col := Pos - BreakPos;
      SB.Append(Line, LinePos - 1, BreakPos - LinePos + 1);
      if (CurChar <> '''') and (CurChar <> '"') then
        while Pos <= LineLen do
        begin
          if IsBreakChar(Line[Pos], BreakChars) then
            Inc(Pos)
          else if System.String.CompareOrdinal(sLineBreak, 0, Line, Pos - 1,
            Length(sLineBreak)) = 0 then
            Inc(Pos, Length(sLineBreak))
          else
            break;
        end;
      if not ExistingBreak and (Pos < LineLen) then
        SB.Append(BreakStr);
      Inc(BreakPos);
      LinePos := BreakPos;
      ExistingBreak := False;
    end;
  end;
  if LinePos <= LineLen then
    SB.Append(Line, LinePos - 1, LineLen - LinePos + 1);
  Result := SB.ToString;
end;

function WrapText(const Line, BreakStr: AnsiString; const BreakChars: array of AnsiChar;
  MaxCol: Integer): string;
var
  BreakCs: array of WideChar;
  I: Integer;
begin
  SetLength(BreakCs, Length(BreakChars));
  for i := 0 to Length(BreakChars) - 1 do
    BreakCs[i] := WideChar(BreakChars[i]);
  WrapText(Line, BreakStr, BreakCs, MaxCol);
end;

function WrapText(const Line: string; MaxCol: Integer): string;
begin
  Result := WrapText(Line, sLineBreak, CharArrayOf(' -'#9), MaxCol);
end;

function FindCmdLineSwitch(const Switch: string; const Chars: TSysCharSet;
  IgnoreCase: Boolean): Boolean;
var
  I: Integer;
  S: string;
  Args: array of string;
begin
  Args := System.Environment.GetCommandLineArgs;
  for I := 1 to Length(Args) - 1 do   // skip first string -- its the program
  begin
    S := Args[I];
    if (Chars = []) or (S[1] in Chars) then
      if System.String.Compare(Switch, 0, S, 1, Length(S) - 1, IgnoreCase) = 0 then
      begin
        Result := True;
        Exit;
      end;
  end;
  Result := False;
end;

function FindCmdLineSwitch(const Switch: string): Boolean;
begin
  Result := FindCmdLineSwitch(Switch, SwitchChars, True);
end;

function FindCmdLineSwitch(const Switch: string; IgnoreCase: Boolean): Boolean;
begin
  Result := FindCmdLineSwitch(Switch, SwitchChars, IgnoreCase);
end;

procedure FreeAndNil(var Obj);
begin
  TObject(Obj).Free;
  Obj := nil;
end;

{ const moved out for performance reasons }
const
  Alpha = ['A'..'Z', 'a'..'z', '_'];
  AlphaNumeric = Alpha + ['0'..'9'];
  AlphaNumericDot = AlphaNumeric + ['.'];

function IsValidIdent(const Ident: string; AllowDots: Boolean): Boolean;
var
  I: Integer;
begin
  Result := False;
  if (Length(Ident) = 0) or not (Ident[1] in Alpha) then Exit;
  if AllowDots then
    for I := 2 to Length(Ident) do
    begin
      if not (Ident[I] in AlphaNumericDot) then Exit
    end
  else
    for I := 2 to Length(Ident) do
      if not (Ident[I] in AlphaNumeric) then Exit;
  Result := True;
end;

function IntToStr(Value: Integer): string;
begin
  Result := System.Convert.ToString(Value);
end;

function IntToStr(Value: Int64): string;
begin
  Result := System.Convert.ToString(Value);
end;

function UIntToStr(Value: LongWord): string;
begin
  Result := System.Convert.ToString(Value);
end;

function UIntToStr(Value: UInt64): string;
begin
  Result := System.Convert.ToString(Value);
end;

function IntToHex(Value: Integer; Digits: Integer): string;
begin
  FmtStr(Result, '%.*x', [Digits, Value]);
end;

function IntToHex(Value: Int64; Digits: Integer): string;
begin
  FmtStr(Result, '%.*x', [Digits, Value]);
end;

function StrToInt(const S: string): Integer;
var
  E: Integer;
begin
  Val(S, Result, E);
  if E <> 0 then ConvertErrorFmt(SInvalidInteger, [S]);
end;

function StrToIntDef(const S: string; Default: Integer): Integer;
begin
  if not TryStrToInt(S, Result) then
    Result := Default;
end;

function TryStrToInt(const S: string; out Value: Integer): Boolean;
var
  E: Integer;
begin
  Val(S, Value, E);
  Result := E = 0;
end;

function StrToLongWord(const S: string): LongWord;
var
  E: Integer;
begin
  Val(S, Result, E);
  if E <> 0 then ConvertErrorFmt(SInvalidInteger, [S]);
end;

function StrToLongWordDef(const S: string; Default: LongWord): LongWord;
begin
  if not TryStrToLongWord(S, Result) then
    Result := Default;
end;

function TryStrToLongWord(const S: string; out Value: LongWord): Boolean;
var
  E: Integer;
begin
  Val(S, Value, E);
  Result := E = 0;
end;

function StrToInt64(const S: string): Int64;
var
  E: Integer;
begin
  Val(S, Result, E);
  if E <> 0 then ConvertErrorFmt(SInvalidInteger, [S]);
end;

function StrToInt64Def(const S: string; const Default: Int64): Int64;
begin
  if not TryStrToInt64(S, Result) then
    Result := Default;
end;

function TryStrToInt64(const S: string; out Value: Int64): Boolean;
var
  E: Integer;
begin
  Val(S, Value, E);
  Result := E = 0;
end;

function StrToUInt64(const S: string): UInt64;
var
  E: Integer;
begin
  Val(S, Result, E);
  if E <> 0 then ConvertErrorFmt(SInvalidInteger, [S]);
end;

function StrToUInt64Def(const S: string; const Default: UInt64): UInt64;
begin
  if not TryStrToUInt64(S, Result) then
    Result := Default;
end;

function TryStrToUInt64(const S: string; out Value: UInt64): Boolean;
var
  E: Integer;
begin
  Val(S, Value, E);
  Result := E = 0;
end;

function StringReplace(const S, OldPattern, NewPattern: string;
  Flags: TReplaceFlags): string;
var
  SearchStr, Patt, NewStr: string;
  Offset: Integer;
  SB: StringBuilder;
begin
  if rfIgnoreCase in Flags then
  begin
    SearchStr := UpperCase(S);
    Patt := UpperCase(OldPattern);
  end else
  begin
    SearchStr := S;
    Patt := OldPattern;
  end;
  NewStr := S;
  SB := StringBuilder.Create;
  while SearchStr <> '' do
  begin
    Offset := Pos(Patt, SearchStr);
    if Offset = 0 then
    begin
      SB.Append(NewStr);
      Break;
    end;
    SB.Append(NewStr, 0, Offset - 1);
    SB.Append(NewPattern);
    NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
    if not (rfReplaceAll in Flags) then
    begin
      SB.Append(NewStr);
      Break;
    end;
    SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
  end;
  Result := SB.ToString;
end;

procedure VerifyBoolStrArray;
begin
  if Length(TrueBoolStrs) = 0 then
  begin
    SetLength(TrueBoolStrs, 2);
    TrueBoolStrs[0] := DefaultTrueBoolStr;
    TrueBoolStrs[1] := DefaultTrueBoolStr[1];
  end;
  if Length(FalseBoolStrs) = 0 then
  begin
    SetLength(FalseBoolStrs, 2);
    FalseBoolStrs[0] := DefaultFalseBoolStr;
    FalseBoolStrs[1] := DefaultFalseBoolStr[1];
  end;
end;

function StrToBool(const S: string; StrOnlyTest: Boolean): Boolean;
begin
  if not TryStrToBool(S, Result, StrOnlyTest) then
    ConvertErrorFmt(SInvalidBoolean, [S]);
end;

function StrToBoolDef(const S: string; const Default: Boolean; StrOnlyTest: Boolean): Boolean;
begin
  if not TryStrToBool(S, Result, StrOnlyTest) then
    Result := Default;
end;

function TryStrToBool(const S: string; out Value: Boolean; StrOnlyTest: Boolean): Boolean;

  function CompareWith(const aArray: array of string): Boolean;
  var
    I: Integer;
  begin
    Result := False;
    for I := Low(aArray) to High(aArray) do
      if AnsiSameText(S, aArray[I]) then
      begin
        Result := True;
        Break;
      end;
  end;

var
  LResult: Double;
begin
  if not StrOnlyTest then
  begin
    Result := TryStrToFloat(S, LResult);
    if Result then
    begin
      Value := LResult <> 0;
      Exit;
    end;
  end;

  VerifyBoolStrArray;
  Result := CompareWith(TrueBoolStrs);
  if Result then
    Value := True
  else
  begin
    Result := CompareWith(FalseBoolStrs);
    if Result then
      Value := False;
  end;
end;

const
  cSimpleBoolStrs: array [boolean] of String = ('0', '-1');
  
function BoolToStr(B: Boolean; UseBoolStrs: Boolean = False): string;
begin
  if UseBoolStrs then
  begin
    VerifyBoolStrArray;
    if B then
      Result := TrueBoolStrs[0]
    else
      Result := FalseBoolStrs[0];
  end
  else
    Result := cSimpleBoolStrs[B];
end;

function Format(const Format: string; const Args: array of const): string;
begin
  FmtStr(Result, Format, Args);
end;

function Format(const Format: string; const Args: array of const;
  const FormatSettings: TFormatSettings): string;
begin
  FmtStr(Result, Format, Args, FormatSettings);
end;

function Format(const Format: string; const Args: array of const;
  Provider: IFormatProvider): string;
begin
  FmtStr(Result, Format, Args, Provider);
end;

procedure FmtStr(var Result: string; const Format: string;
  const Args: array of const);
var
  Buffer: System.Text.StringBuilder;
begin
  Buffer := System.Text.StringBuilder.Create(Length(Format) * 2);
  FormatBuf(Buffer, Format, Length(Format), Args);
  Result := Buffer.ToString;
end;

procedure FmtStr(var Result: string; const Format: string;
  const Args: array of const; const FormatSettings: TFormatSettings);
var
  Buffer: System.Text.StringBuilder;
begin
  Buffer := System.Text.StringBuilder.Create(Length(Format) * 2);
  FormatBuf(Buffer, Format, Length(Format), Args, FormatSettings);
  Result := Buffer.ToString;
end;

procedure FmtStr(var Result: string; const Format: string;
  const Args: array of const; Provider: IFormatProvider);
var
  Buffer: System.Text.StringBuilder;
begin
  Buffer := System.Text.StringBuilder.Create(Length(Format) * 2);
  FormatBuf(Buffer, Format, Length(Format), Args, Provider);
  Result := Buffer.ToString;
end;

function FormatBuf(var Buffer: System.Text.StringBuilder; const Format: string;
  FmtLen: Cardinal; const Args: array of const): Cardinal;
var
  LFormat: NumberFormatInfo;
begin
  LFormat := NumberFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.Clone);
  with LFormat do
  begin
    CurrencyDecimalSeparator := DecimalSeparator;
    CurrencyGroupSeparator := ThousandSeparator;
    NumberDecimalSeparator := DecimalSeparator;
    NumberGroupSeparator := ThousandSeparator;
    CurrencySymbol := CurrencyString;
    CurrencyPositivePattern := CurrencyFormat;
    CurrencyNegativePattern := NegCurrFormat;
  end;
  Result := FormatBuf(Buffer, Format, FmtLen, Args, LFormat);
end;

function FormatBuf(var Buffer: System.Text.StringBuilder; const Format: string;
  FmtLen: Cardinal; const Args: array of const; const FormatSettings: TFormatSettings): Cardinal;
var
  LFormat: NumberFormatInfo;
begin
  LFormat := NumberFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.Clone);
  with LFormat, FormatSettings do
  begin
    CurrencyDecimalSeparator := DecimalSeparator;
    CurrencyGroupSeparator := ThousandSeparator;
    NumberDecimalSeparator := DecimalSeparator;
    NumberGroupSeparator := ThousandSeparator;
    CurrencySymbol := CurrencyString;
    CurrencyPositivePattern := CurrencyFormat;
    CurrencyNegativePattern := NegCurrFormat;
  end;
  Result := FormatBuf(Buffer, Format, FmtLen, Args, LFormat);
end;

function FormatBuf(var Buffer: System.Text.StringBuilder; const Format: string;
  FmtLen: Cardinal; const Args: array of const; Provider: IFormatProvider): Cardinal;

  procedure Error;
  begin
    raise System.FormatException.Create(SInvalidFormatString);
  end;

var
  s, srclen: Cardinal;
  argIndex: Cardinal;
  precisionStart: Cardinal;
  precisionLen: Integer;
  fmtSpec: System.Text.StringBuilder;
  argStr: string;
begin
  s := 1;
  argIndex := 0;
  srclen := Length(Format);
  fmtSpec := System.Text.StringBuilder.Create;

  while s <= srclen do
  begin
    if Format[s] = '%' then
    begin
      Inc(s);
      if s > srclen then break;
      if Format[s] = '%' then
      begin
        Buffer.Append(Format[s]);
        Inc(s);
        Continue;
      end;

      fmtSpec.Length := 0;
      fmtSpec.Append('{0,');

      if Format[s] = '-' then   // width might be first
      begin
        fmtSpec.Append(Char('-'));
        Inc(s);
      end;

      if Format[s] = '*' then
      begin
        fmtSpec.Append(Args[argIndex]);
        Inc(argIndex);
        Inc(s);
      end
      else
      begin
        while (s < srclen) and System.Char.IsDigit(Format[s]) do
        begin
          fmtSpec.Append(Format[s]);
          Inc(s);
        end;
      end;

      if s > srclen then Error;

      if Format[s] = ':' then
      begin
        Inc(s);

        // something got added, it must be the index
        if fmtSpec.Length > 3 then
        begin
          argStr := fmtSpec.ToString(3, fmtSpec.Length - 3);
          argIndex := Int32.Parse(argStr);
          fmtSpec.Length := 3;
        end

        // nothing got added, the index then defaults to zero
        else
          argIndex := 0;

        //  width follows argIndex
        if Format[s] = '-' then
        begin
          fmtSpec.Append(Char('-'));
          Inc(s);
        end;

        if Format[s] = '*' then
        begin
          fmtSpec.Append(Args[argIndex]);
          Inc(argIndex);
          Inc(s);
        end
        else
        begin
          while (s < srclen) and System.Char.IsDigit(Format[s]) do
          begin
            fmtSpec.Append(Format[s]);
            Inc(s);
          end;
        end;
      end;

      if fmtSpec.Length = 3 then
        fmtSpec.Length := 2;    // remove comma if no width spec was found

      if s > srclen then Error;

      if Format[s] = '.' then
      begin
        Inc(s);
        if Format[s] = '*' then
        begin
          precisionStart := Integer(Args[argIndex]);
          precisionLen := -1;
          Inc(argIndex);
          Inc(s);
        end
        else
        begin
          precisionStart := s - 1;
          while (s < srclen) and System.Char.IsDigit(Format[s]) do
            Inc(s);
          precisionLen := s - precisionStart - 1;
        end;
      end
      else
      begin
        precisionStart := 0;
        precisionLen := 0;
      end;

      fmtSpec.Append(Char(':'));
      case Format[s] of
        'd', 'D',
        'u', 'U': fmtSpec.Append(Char('d'));
        'e', 'E',
        'f', 'F',
        'g', 'G',
        'n', 'N',
        'x', 'X': fmtSpec.Append(Char(Format[s]));
        'm', 'M': fmtSpec.Append(Char('c'));
        'p', 'P': fmtSpec.Append(Char('x'));
        's', 'S': ;   // no format spec needed for strings
      else
        Error;
      end;

      if precisionLen > 0 then
        fmtSpec.Append(Format, precisionStart, precisionLen)
      else if precisionLen < 0 then
        fmtSpec.Append(precisionStart);

      fmtSpec.Append(Char('}'));
      Buffer.AppendFormat(Provider, fmtSpec.ToString, [Args[argIndex]]);
      Inc(argIndex);
    end
    else
      Buffer.Append(Format[s]);

    Inc(s);
  end;
  Result := Buffer.Length;
end;

function WideFormat(const AFormat: WideString;
  const Args: array of const): WideString;
begin
  Result := Format(AFormat, Args);
end;

function WideFormat(const AFormat: WideString;
  const Args: array of const; const FormatSettings: TFormatSettings): WideString;
begin
  Result := Format(AFormat, Args, FormatSettings);
end;

function WideFormat(const AFormat: WideString;
  const Args: array of const; Provider: IFormatProvider): WideString;
begin
  Result := Format(AFormat, Args, Provider);
end;

procedure WideFmtStr(var AResult: WideString; const AFormat: WideString;
  const Args: array of const);
begin
  FmtStr(AResult, AFormat, Args);
end;

procedure WideFmtStr(var AResult: WideString; const AFormat: WideString;
  const Args: array of const; const FormatSettings: TFormatSettings);
begin
  FmtStr(AResult, AFormat, Args, FormatSettings);
end;

procedure WideFmtStr(var AResult: WideString; const AFormat: WideString;
  const Args: array of const; Provider: IFormatProvider);
begin
  FmtStr(AResult, AFormat, Args, Provider);
end;

function WideFormatBuf(var ABuffer: System.Text.StringBuilder; const AFormat: WideString;
  AFmtLen: Cardinal; const Args: array of const): Cardinal;
begin
  Result := FormatBuf(ABuffer, AFormat, AFmtLen, Args);
end;

function WideFormatBuf(var ABuffer: System.Text.StringBuilder; const AFormat: WideString;
  AFmtLen: Cardinal; const Args: array of const; const FormatSettings: TFormatSettings): Cardinal;
begin
  Result := FormatBuf(ABuffer, AFormat, AFmtLen, Args, FormatSettings);
end;

function WideFormatBuf(var ABuffer: System.Text.StringBuilder; const AFormat: WideString;
  AFmtLen: Cardinal; const Args: array of const; Provider: IFormatProvider): Cardinal;
begin
  Result := FormatBuf(ABuffer, AFormat, AFmtLen, Args, Provider);
end;

function StrToFloat(const S: string): Extended;
var
  Value: Double;
begin
  if not TryStrToFloat(S, Value) then
    ConvertErrorFmt(SInvalidFloat, [S]);
  Result := Value;
end;

function StrToFloat(const S: string; const FormatSettings: TFormatSettings): Extended;
var
  Value: Double;
begin
  if not TryStrToFloat(S, Value, FormatSettings) then
    ConvertErrorFmt(SInvalidFloat, [S]);
  Result := Value;
end;

function StrToFloat(const S: string; Provider: IFormatProvider): Extended;
var
  Value: Double;
begin
  if not TryStrToFloat(S, Value, Provider) then
    ConvertErrorFmt(SInvalidFloat, [S]);
  Result := Value;
end;

function StrToFloatDef(const S: string; const Default: Extended): Extended;
var
  Value: Double;
begin
  if TryStrToFloat(S, Value) then
    Result := Value
  else
    Result := Default;
end;

function StrToFloatDef(const S: string; const Default: Extended;
  const FormatSettings: TFormatSettings): Extended;
var
  Value: Double;
begin
  if TryStrToFloat(S, Value, FormatSettings) then
    Result := Value
  else
    Result := Default;
end;

function StrToFloatDef(const S: string; const Default: Extended;
  Provider: IFormatProvider): Extended;
var
  Value: Double;
begin
  if TryStrToFloat(S, Value, Provider) then
    Result := Value
  else
    Result := Default;
end;

function TryStrToFloat(const S: string; out Value: Double): Boolean;
var
  LFormat: NumberFormatInfo;
begin
  LFormat := NumberFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.Clone);
  with LFormat do
  begin
    CurrencyDecimalSeparator := DecimalSeparator;
    CurrencyGroupSeparator := ThousandSeparator;
    NumberDecimalSeparator := DecimalSeparator;
    NumberGroupSeparator := ThousandSeparator;
  end;
  Result := TryStrToFloat(S, Value, LFormat);
end;

function TryStrToFloat(const S: string; out Value: Double;
  const FormatSettings: TFormatSettings): Boolean;
var
  LFormat: NumberFormatInfo;
begin
  LFormat := NumberFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.Clone);
  with LFormat, FormatSettings do
  begin
    CurrencyDecimalSeparator := DecimalSeparator;
    CurrencyGroupSeparator := ThousandSeparator;
    NumberDecimalSeparator := DecimalSeparator;
    NumberGroupSeparator := ThousandSeparator;
  end;
  Result := TryStrToFloat(S, Value, LFormat);
end;

function TryStrToFloat(const S: string; out Value: Double;
  Provider: IFormatProvider): Boolean;
begin
  Result := System.Double.TryParse(S, NumberStyles.Float, Provider, Value);
end;

function TryStrToFloat(const S: string; out Value: Single): Boolean;
var
  LValue: Double;
begin
  Result := TryStrToFloat(S, LValue);
  if Result then
    Value := LValue;
end;

function TryStrToFloat(const S: string; out Value: Single;
  const FormatSettings: TFormatSettings): Boolean;
var
  LValue: Double;
begin
  Result := TryStrToFloat(S, LValue, FormatSettings);
  if Result then
    Value := LValue;
end;


function TryStrToFloat(const S: string; out Value: Single;
  Provider: IFormatProvider): Boolean;
var
  LValue: Double;
begin
  Result := TryStrToFloat(S, LValue, Provider);
  if Result then
    Value := LValue;
end;

function StrToCurr(const S: string): Currency;
begin
  if not TryStrToCurr(S, Result) then
    ConvertErrorFmt(SInvalidFloat, [S]);
end;

function StrToCurr(const S: string; const FormatSettings: TFormatSettings): Currency;
begin
  if not TryStrToCurr(S, Result, FormatSettings) then
    ConvertErrorFmt(SInvalidFloat, [S]);
end;

function StrToCurr(const S: string; Provider: IFormatProvider): Currency;
begin
  if not TryStrToCurr(S, Result, Provider) then
    ConvertErrorFmt(SInvalidFloat, [S]);
end;


function StrToCurrDef(const S: string; const Default: Currency): Currency;
begin
  if not TryStrToCurr(S, Result) then
    Result := Default;
end;

function StrToCurrDef(const S: string; const Default: Currency;
  const FormatSettings: TFormatSettings): Currency; 
begin
  if not TryStrToCurr(S, Result, FormatSettings) then
    Result := Default;
end;

function StrToCurrDef(const S: string; const Default: Currency;
  Provider: IFormatProvider): Currency;
begin
  if not TryStrToCurr(S, Result, Provider) then
    Result := Default;
end;

function TryStrToCurr(const S: string; out Value: Currency): Boolean;
var
  LFormat: NumberFormatInfo;
begin
  LFormat := NumberFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.Clone);
  with LFormat do
  begin
    CurrencyDecimalSeparator := DecimalSeparator;
    CurrencyGroupSeparator := ThousandSeparator;
    NumberDecimalSeparator := DecimalSeparator;
    NumberGroupSeparator := ThousandSeparator;
  end;
  Result := TryStrToCurr(S, Value, LFormat);
end;

function TryStrToCurr(const S: string; out Value: Currency;
  const FormatSettings: TFormatSettings): Boolean;
var
  LFormat: NumberFormatInfo;
begin
  LFormat := NumberFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.Clone);
  with LFormat, FormatSettings do
  begin
    CurrencyDecimalSeparator := DecimalSeparator;
    CurrencyGroupSeparator := ThousandSeparator;
    NumberDecimalSeparator := DecimalSeparator;
    NumberGroupSeparator := ThousandSeparator;
  end;
  Result := TryStrToCurr(S, Value, LFormat);
end;

function TryStrToCurr(const S: string; out Value: Currency;
  Provider: IFormatProvider): Boolean;
begin
  Result := Currency.TryParse(S, NumberStyles.Float, Provider, Value);
end;

function AddCurrencySymbol(const Value, CurrSymbol: string; CurrFormat: Byte): string;
begin
  case CurrFormat of
    0: Result := Format('%s%s', [CurrSymbol, Value]);
    1: Result := Format('%s%s', [Value, CurrSymbol]);
    2: Result := Format('%s %s', [CurrSymbol, Value]);
    3: Result := Format('%s %s', [Value, CurrSymbol]);
  end;
end;

function AddCurrencySymbol(const Value: string; Provider: IFormatProvider): string;
var
  LFormat: NumberFormatInfo;
begin
  if Assigned(Provider) then
    LFormat := NumberFormatInfo(Provider.GetFormat(TypeOf(NumberFormatInfo)))
  else
    LFormat := nil;

  if Assigned(LFormat) then
    Result := AddCurrencySymbol(Value, LFormat.CurrencySymbol, LFormat.CurrencyPositivePattern)
  else
    Result := AddCurrencySymbol(Value, CurrencyString, CurrencyFormat);
end;

{   0 = '($1)'      4 = '(1$)'      8 = '-1 $'      12 = '$ -1'
    1 = '-$1'       5 = '-1$'       9 = '-$ 1'      13 = '1- $'
    2 = '$-1'       6 = '1-$'      10 = '1 $-'      14 = '($ 1)'
    3 = '$1-'       7 = '1$-'      11 = '$ 1-'      15 = '(1 $)'  }

function AddNegCurrencySymbol(const Value, CurrSymbol: string; CurrFormat: Byte): string;
begin
  case CurrFormat of
    0: Result := Format('(%s%s)', [CurrSymbol, Value]);
    1: Result := Format('-%s%s', [CurrSymbol, Value]);
    2: Result := Format('%s-%s', [CurrSymbol, Value]);
    3: Result := Format('%s%s-', [CurrSymbol, Value]);
    4: Result := Format('(%s%s)', [Value, CurrSymbol]);
    5: Result := Format('-%s%s', [Value, CurrSymbol]);
    6: Result := Format('%s-%s', [Value, CurrSymbol]);
    7: Result := Format('%s%s-', [Value, CurrSymbol]);
    8: Result := Format('-%s %s', [Value, CurrSymbol]);
    9: Result := Format('-%s %s', [CurrSymbol, Value]);
   10: Result := Format('%s %s-', [Value, CurrSymbol]);
   11: Result := Format('%s %s-', [CurrSymbol, Value]);
   12: Result := Format('%s %s', [CurrSymbol, Value]);
   13: Result := Format('%s -%s', [Value, CurrSymbol]);
   14: Result := Format('(%s- %s)', [CurrSymbol, Value]);
   15: Result := Format('(%s %s)', [Value, CurrSymbol]);
  end;
end;

function AddNegCurrencySymbol(const Value: string; Provider: IFormatProvider): string;
var
  LFormat: NumberFormatInfo;
begin
  if Assigned(Provider) then
    LFormat := NumberFormatInfo(Provider.GetFormat(TypeOf(NumberFormatInfo)))
  else
    LFormat := nil;
    
  if Assigned(LFormat) then
    Result := AddNegCurrencySymbol(Value, LFormat.CurrencySymbol, LFormat.CurrencyNegativePattern)
  else
    Result := AddNegCurrencySymbol(Value, CurrencyString, NegCurrFormat);
end;

function FloatToStr(Value: Extended): string;
begin
  Result := FloatToStrF(Value, ffGeneral, 15, 0);
end;

function FloatToStr(Value: Extended; const FormatSettings: TFormatSettings): string;
begin
  Result := FloatToStrF(Value, ffGeneral, 15, 0, FormatSettings);
end;

function FloatToStr(Value: Extended; Provider: IFormatProvider): string;
begin
  Result := FloatToStrF(Value, ffGeneral, 15, 0, Provider);
end;

function FloatToStrF(Value: Extended; Format: TFloatFormat;
  Precision, Digits: Integer): string;
var
  LFormat: NumberFormatInfo;
begin
  LFormat := NumberFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.Clone);
  with LFormat do
  begin
    CurrencyDecimalSeparator := DecimalSeparator;
    CurrencyGroupSeparator := ThousandSeparator;
    NumberDecimalSeparator := DecimalSeparator;
    NumberGroupSeparator := ThousandSeparator;
    CurrencySymbol := CurrencyString;
    CurrencyPositivePattern := CurrencyFormat;
    CurrencyNegativePattern := NegCurrFormat;
  end;
  Result := FloatToStrF(Value, Format, Precision, Digits, LFormat);
end;

function FloatToStrF(Value: Extended; Format: TFloatFormat;
  Precision, Digits: Integer; const FormatSettings: TFormatSettings): string;
var
  LFormat: NumberFormatInfo;
begin
  LFormat := NumberFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.Clone);
  with LFormat, FormatSettings do
  begin
    CurrencyDecimalSeparator := DecimalSeparator;
    CurrencyGroupSeparator := ThousandSeparator;
    NumberDecimalSeparator := DecimalSeparator;
    NumberGroupSeparator := ThousandSeparator;
    CurrencySymbol := CurrencyString;
    CurrencyPositivePattern := CurrencyFormat;
    CurrencyNegativePattern := NegCurrFormat;
  end;
  Result := FloatToStrF(Value, Format, Precision, Digits, LFormat);
end;

function FloatToStrF(Value: Extended; Format: TFloatFormat;
  Precision, Digits: Integer; Provider: IFormatProvider): string;
var
  FormatStr: string;
  LogVal: Double;
  Scientific: Boolean;
  ActualDigits: Integer;
begin
  FormatStr := '';
  Scientific := True;
  ActualDigits := Digits;
  if Format = ffExponent then
  begin
    if Digits <= 0 then Digits := 1;
    FormatStr := '0.' + StringOfChar('0', Precision - 1) + 'E+' +
      StringOfChar('0', Digits);
  end
  else
  begin
    if Value = 0 then
      LogVal := 0
    else
      LogVal := Abs(System.Math.Log10(Abs(Value)));
    if (LogVal >= Precision) then
      FormatStr := '0.' + StringOfChar('#', Precision - 1) + 'E-0' 
    else 
    begin
      Scientific := False;
      ActualDigits := Precision - Trunc(LogVal) - 1;
      if Format = ffGeneral then
      begin
        FormatStr := StringOfChar('#', ActualDigits);
        Digits := ActualDigits;
      end
      else
      begin
        if Digits < ActualDigits then
          ActualDigits := Digits;
        FormatStr := StringOfChar('0', ActualDigits);
      end;
      if Format in [ffNumber, ffCurrency] then
        FormatStr := '#,0.' + FormatStr
      else
        FormatStr := '0.' + FormatStr;
    end;
  end;

  if Scientific or (Value >= 0) or (Format <> ffCurrency) then
    Result := System.Double(Value).ToString(FormatStr, Provider)
  else
    Result := System.Double(-Value).ToString(FormatStr, Provider);

  if Scientific then
    Exit;
  if Digits > ActualDigits then
  begin
    if ActualDigits = 0 then
      Result := Result + DecimalSeparator + StringOfChar('0', Digits - ActualDigits)
    else
      Result := Result + StringOfChar('0', Digits - ActualDigits);
  end;
  if (Format = ffCurrency) then
    if Value >= 0 then
      Result := AddCurrencySymbol(Result, Provider)
    else
      Result := AddNegCurrencySymbol(Result, Provider);
end;

function CurrToStr(Value: Currency): string;
begin
  Result := CurrToStrF(Value, ffGeneral, 0);
end;

function CurrToStr(Value: Currency; const FormatSettings: TFormatSettings): string;
begin
  Result := CurrToStrF(Value, ffGeneral, 0, FormatSettings);
end;

function CurrToStr(Value: Currency; Provider: IFormatProvider): string;
begin
  Result := CurrToStrF(Value, ffGeneral, 0, Provider);
end;

function CurrToStrF(Value: Currency; Format: TFloatFormat; Digits: Integer): string;
var
  LFormat: NumberFormatInfo;
begin
  LFormat := NumberFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.Clone);
  with LFormat do
  begin
    CurrencyDecimalSeparator := DecimalSeparator;
    CurrencyGroupSeparator := ThousandSeparator;
    NumberDecimalSeparator := DecimalSeparator;
    NumberGroupSeparator := ThousandSeparator;
    CurrencySymbol := CurrencyString;
    CurrencyPositivePattern := CurrencyFormat;
    CurrencyNegativePattern := NegCurrFormat;
  end;
  Result := CurrToStrF(Value, Format, Digits, LFormat);
end;

function CurrToStrF(Value: Currency; Format: TFloatFormat;
  Digits: Integer; const FormatSettings: TFormatSettings): string;
var
  LFormat: NumberFormatInfo;
begin
  LFormat := NumberFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.Clone);
  with LFormat, FormatSettings do
  begin
    CurrencyDecimalSeparator := DecimalSeparator;
    CurrencyGroupSeparator := ThousandSeparator;
    NumberDecimalSeparator := DecimalSeparator;
    NumberGroupSeparator := ThousandSeparator;
    CurrencySymbol := CurrencyString;
    CurrencyPositivePattern := CurrencyFormat;
    CurrencyNegativePattern := NegCurrFormat;
  end;
  Result := CurrToStrF(Value, Format, Digits, LFormat);
end;


function CurrToStrF(Value: Currency; Format: TFloatFormat;
  Digits: Integer; Provider: IFormatProvider): string;
var
  Temp: Currency;
begin
  case Format of
    ffExponent:
      begin
        if Digits <= 0 then
          Digits := 1;
        Result := Value.ToString('0.' + StringOfChar('0', 18) + 'E+' + StringOfChar('0', Digits),
          Provider);
      end;
    ffGeneral:
      Result := Value.ToString(Value.GeneralFormatString, Provider);
    ffFixed:
      Result := Value.ToString('0.' + StringOfChar('0', Digits), Provider);
    ffNumber, ffCurrency:
      begin
        Temp := Value;
        if (Format = ffCurrency) and (Value < 0) then
          Temp := -Value;
        Result := Temp.ToString('#,0.' + StringOfChar('0', Digits), Provider);
        if Format = ffCurrency then
          if Value >= 0 then
            Result := AddCurrencySymbol(Result, Provider)
          else
            Result := AddNegCurrencySymbol(Result, Provider);
      end;
  end;
end;

function MinCurrency: Currency;
begin
  Result := Currency.MinValue;
end;

function MaxCurrency: Currency;
begin
  Result := Currency.MaxValue;
end;

function TryFloatToCurr(const Value: Extended; out AResult: Currency): Boolean;
begin
  Result := (Value >= Currency.MinValue) and (Value <= Currency.MaxValue);
  if Result then
    AResult := Value;
end;

function FloatToCurr(const Value: Extended): Currency;
begin
  if not TryFloatToCurr(Value, Result) then
    ConvertErrorFmt(SInvalidCurrency, [FloatToStr(Value)]);
end;

{*******************************************************}
{       SysUtils Date/Time Support Section              }
{*******************************************************}

{ Date/time support routines }

const
  FMSecsPerDay: Single = MSecsPerDay;
  IMSecsPerDay: Integer = MSecsPerDay;

function DateTimeToTimeStamp(ADateTime: TDateTime): TTimeStamp;
begin
  Result.Date := Trunc(ADateTime) + DateDelta;
  Result.Time := Convert.ToInt32(Double(ADateTime.Time) * MSecsPerDay);
  if Result.Time < 0 then
    Result.Time := -Result.Time;
end;

procedure ValidateTimeStamp(const ATimeStamp: TTimeStamp);
begin
  if (ATimeStamp.Time < 0) or (ATimeStamp.Date <= 0) then
    ConvertErrorFmt(SInvalidTimeStamp, [ATimeStamp.Date, ATimeStamp.Time]);
end;

function TimeStampToDateTime(const ATimeStamp: TTimeStamp): TDateTime;
begin
  ValidateTimeStamp(ATimeStamp);
  Result := ATimeStamp.Date - DateDelta;
  if Result < 0 then
    Result := Result - (ATimeStamp.Time / MSecsPerDay)
  else
    Result := Result + (ATimeStamp.Time / MSecsPerDay);
end;

function MSecsToTimeStamp(MSecs: Int64): TTimeStamp;
begin
  Result.Date := MSecs div MSecsPerDay;
  Result.Time := MSecs mod MSecsPerDay;
end;

function TimeStampToMSecs(const ATimeStamp: TTimeStamp): Int64;
begin
  ValidateTimeStamp(ATimeStamp);
  Result := Int64(ATimeStamp.Date) * MSecsPerDay + ATimeStamp.Time;
end;

{ Time encoding and decoding }

function TryEncodeTime(Hour, Min, Sec, MSec: Word; out Time: TDateTime): Boolean;
begin
  Result := TDateTime.TryEncodeTime(Hour, Min, Sec, MSec, Time);
end;

function EncodeTime(Hour, Min, Sec, MSec: Word): TDateTime;
begin
  Result := TDateTime.EncodeTime(Hour, Min, Sec, MSec);
end;

procedure DecodeTime(const ADateTime: TDateTime; var Hour, Min, Sec, MSec: Word);
begin
  TDateTime.DecodeTime(ADateTime, Hour, Min, Sec, MSec);
end;

{ Date encoding and decoding }

function IsLeapYear(Year: Word): Boolean;
begin
  Result := TDateTime.IsLeapYear(Year);
end;

function TryEncodeDate(Year, Month, Day: Word; out Date: TDateTime): Boolean;
begin
  Result := TDateTime.TryEncodeDate(Year, Month, Day, Date);
end;

function EncodeDate(Year, Month, Day: Word): TDateTime;
begin
  Result := TDateTime.EncodeDate(Year, Month, Day);
end;

function DecodeDateFully(const ADateTime: TDateTime; var Year, Month, Day, DOW: Word): Boolean;
begin
  Result := TDateTime.DecodeDate(ADateTime, Year, Month, Day, DOW);
end;

procedure DecodeDate(const ADateTime: TDateTime; var Year, Month, Day: Word);
begin
  TDateTime.DecodeDate(ADateTime, Year, Month, Day);
end;

procedure DateTimeToSystemTime(const ADateTime: TDateTime; var SystemTime: TSystemTime);
begin
  with SystemTime do
  begin
    DecodeDateFully(ADateTime, wYear, wMonth, wDay, wDayOfWeek);
    Dec(wDayOfWeek);
    DecodeTime(ADateTime, wHour, wMinute, wSecond, wMilliseconds);
  end;
end;

function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;
begin
  with SystemTime do
  begin
    Result := EncodeDate(wYear, wMonth, wDay);
    if Result >= 0 then
      Result := Result + EncodeTime(wHour, wMinute, wSecond, wMilliSeconds)
    else
      Result := Result - EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);
  end;
end;

function DayOfWeek(const ADateTime: TDateTime): Word;
begin
  Result := ADateTime.DayOfWeek;
end;

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

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

function GetTime: TDateTime;
begin
  Result := Time;
end;

function Now: TDateTime;
begin
  Result := TDateTime.Now;
end;

function IncMonth(const ADateTime: TDateTime; NumberOfMonths: Integer): TDateTime;
begin
  Result := ADateTime.AddMonth(NumberOfMonths);
end;

procedure IncAMonth(var Year, Month, Day: Word; NumberOfMonths: Integer);
begin
  DecodeDate(EncodeDate(Year, Month, Day).AddMonth(NumberOfMonths), Year, Month, Day);
end;

procedure ReplaceTime(var ADateTime: TDateTime; const NewTime: TDateTime);
begin
  ADateTime := ADateTime.ReplaceTime(NewTime);
end;

procedure ReplaceDate(var ADateTime: TDateTime; const NewDate: TDateTime);
begin
  ADateTime := ADateTime.ReplaceDate(NewDate);
end;

function CurrentYear: Word;
begin
  Result := TDateTime.TheYear;
end;

function DateToStr(const ADateTime: TDateTime): string;
begin
  DateTimeToString(Result, ShortDateFormat, ADateTime);
end;

function DateToStr(const ADateTime: TDateTime; const FormatSettings: TFormatSettings): string;
begin
  DateTimeToString(Result, ShortDateFormat, ADateTime, FormatSettings);
end;

function DateToStr(const ADateTime: TDateTime; Provider: IFormatProvider): string;
var
  FormatStr: string;
  LFormat: DateTimeFormatInfo;
begin
  if Assigned(Provider) then
    LFormat := DateTimeFormatInfo(Provider.GetFormat(TypeOf(DateTimeFormatInfo)));
  if Assigned(LFormat) then
    FormatStr := ConvertClrDateTimeFormat(LFormat.ShortDatePattern)
  else
    FormatStr := ShortDateFormat;
  DateTimeToString(Result, FormatStr, ADateTime, Provider);
end;

function TimeToStr(const ADateTime: TDateTime): string;
begin
  DateTimeToString(Result, LongTimeFormat, ADateTime);
end;

function TimeToStr(const ADateTime: TDateTime; const FormatSettings: TFormatSettings): string;
begin
  DateTimeToString(Result, LongTimeFormat, ADateTime, FormatSettings);
end;

function TimeToStr(const ADateTime: TDateTime; Provider: IFormatProvider): string;
var
  FormatStr: string;
  LFormat: DateTimeFormatInfo;
begin
  if Assigned(Provider) then
    LFormat := DateTimeFormatInfo(Provider.GetFormat(TypeOf(DateTimeFormatInfo)));
  if Assigned(LFormat) then
    FormatStr := ConvertClrDateTimeFormat(LFormat.LongTimePattern)
  else
    FormatStr := LongTimeFormat;
  DateTimeToString(Result, FormatStr, ADateTime, Provider);
end;

function DateTimeToStr(const ADateTime: TDateTime): string;
begin
  if ADateTime.Time = 0 then
    DateTimeToString(Result, ShortDateFormat, ADateTime)
  else
    DateTimeToString(Result, '', ADateTime);
end;

function DateTimeToStr(const ADateTime: TDateTime; const FormatSettings: TFormatSettings): string;
begin
  if ADateTime.Time = 0 then
    DateTimeToString(Result, FormatSettings.ShortDateFormat, ADateTime, FormatSettings)
  else
    DateTimeToString(Result, '', ADateTime, FormatSettings);
end;

function DateTimeToStr(const ADateTime: TDateTime; Provider: IFormatProvider): string;
var
  LFormat: DateTimeFormatInfo;
begin
  LFormat := nil;
  if ADateTime.Time = 0 then
  begin
    if Assigned(Provider) then
      LFormat := DateTimeFormatInfo(Provider.GetFormat(TypeOf(DateTimeFormatInfo)));
    if Assigned(LFormat) then
      DateTimeToString(Result, ConvertClrDateTimeFormat(LFormat.ShortDatePattern), ADateTime, Provider)
    else
      DateTimeToString(Result, ShortDateFormat, ADateTime, Provider);
  end
  else
    DateTimeToString(Result, '', ADateTime, Provider);
end;

function FormatDateTime(const Format: string; ADateTime: TDateTime): string;
begin
  DateTimeToString(Result, Format, ADateTime);
end;

function FormatDateTime(const Format: string; ADateTime: TDateTime;
  const FormatSettings: TFormatSettings): string;
begin
  DateTimeToString(Result, Format, ADateTime, FormatSettings);
end;

function FormatDateTime(const Format: string; ADateTime: TDateTime;
  Provider: IFormatProvider): string;
begin
  DateTimeToString(Result, Format, ADateTime, Provider);
end;

procedure ScanBlanks(const S: string; var Pos: Integer);
var
  I: Integer;
begin
  I := Pos;
  while (I <= Length(S)) and (S[I] = ' ') do Inc(I);
  Pos := I;
end;

function ScanNumber(const S: string; var Pos: Integer;
  var Number: Word; var CharCount: Byte): Boolean;
var
  I: Integer;
  N: Word;
begin
  Result := False;
  CharCount := 0;
  ScanBlanks(S, Pos);
  I := Pos;
  N := 0;
  while (I <= Length(S)) and System.Char.IsDigit(S[I]) and (N < 1000) do
  begin
    N := N * 10 + (Ord(S[I]) - Ord('0'));
    Inc(I);
  end;
  if I > Pos then
  begin
    CharCount := I - Pos;
    Pos := I;
    Number := N;
    Result := True;
  end;
end;

function ScanString(const S: string; var Pos: Integer;
  const Symbol: string): Boolean;
begin
  Result := False;
  if Symbol <> '' then
  begin
    ScanBlanks(S, Pos);
    if AnsiCompareText(Symbol, Copy(S, Pos, Length(Symbol))) = 0 then
    begin
      Inc(Pos, Length(Symbol));
      Result := True;
    end;
  end;
end;

type
  TDateOrder = (doMDY, doDMY, doYMD);

function GetDateOrder(const DateFormat: string): TDateOrder;
var
  I: Integer;
begin
  Result := doMDY;
  I := 1;
  while I <= Length(DateFormat) do
  begin
    case Chr(Ord(DateFormat[I]) and $DF) of
      'E': Result := doYMD;
      'Y': Result := doYMD;
      'M': Result := doMDY;
      'D': Result := doDMY;
    else
      Inc(I);
      Continue;
    end;
    Exit;
  end;
end;

function ScanDate(const S: string; var Pos: Integer;
  var Date: TDateTime): Boolean; overload;
var
  DateOrder: TDateOrder;
  N1, N2, N3, Y, M, D: Word;
  L1, L2, L3, YearLen: Byte;
  CenturyBase: Integer;
begin
  Y := 0;
  M := 0;
  D := 0;
  YearLen := 0;
  Result := False;
  DateOrder := GetDateOrder(ShortDateFormat);

                                                                          
                                                                        
                                                                
                                  
                                                           
                                                                             
                                  
                                                                            
                                 

  if not (ScanNumber(S, Pos, N1, L1) and ScanString(S, Pos, DateSeparator) and
    ScanNumber(S, Pos, N2, L2)) then Exit;
  if ScanString(S, Pos, DateSeparator) then
  begin
    if not ScanNumber(S, Pos, N3, L3) then Exit;
    case DateOrder of
      doMDY: begin Y := N3; YearLen := L3; M := N1; D := N2; end;
      doDMY: begin Y := N3; YearLen := L3; M := N2; D := N1; end;
      doYMD: begin Y := N1; YearLen := L1; M := N2; D := N3; end;
    end;
                                                                             
    if (YearLen <= 2) then
    begin
      CenturyBase := CurrentYear - TwoDigitYearCenturyWindow;
      Inc(Y, CenturyBase div 100 * 100);
      if (TwoDigitYearCenturyWindow > 0) and (Y < CenturyBase) then
        Inc(Y, 100);
    end;
  end else
  begin
    Y := CurrentYear;
    if DateOrder = doDMY then
    begin
      D := N1; M := N2;
    end else
    begin
      M := N1; D := N2;
    end;
  end;
  ScanString(S, Pos, DateSeparator);
  ScanBlanks(S, Pos);
                                                                     
                                                                   
  Result := TryEncodeDate(Y, M, D, Date);
end;

function ScanDate(const S: string; var Pos: Integer;
  var Date: TDateTime; const FormatSettings: TFormatSettings): Boolean; overload;
var
  DateOrder: TDateOrder;
  N1, N2, N3, Y, M, D: Word;
  L1, L2, L3, YearLen: Byte;
  CenturyBase: Integer;
begin
  Y := 0;
  M := 0;
  D := 0;
  YearLen := 0;
  Result := False;
  DateOrder := GetDateOrder(FormatSettings.ShortDateFormat);

                                                                          
                                                                        
                                                                
                                  
                                                           
                                                                             
                                  
                                                                            
                                 

  if not (ScanNumber(S, Pos, N1, L1) and ScanString(S, Pos, FormatSettings.DateSeparator) and
    ScanNumber(S, Pos, N2, L2)) then Exit;
  if ScanString(S, Pos, FormatSettings.DateSeparator) then
  begin
    if not ScanNumber(S, Pos, N3, L3) then Exit;
    case DateOrder of
      doMDY: begin Y := N3; YearLen := L3; M := N1; D := N2; end;
      doDMY: begin Y := N3; YearLen := L3; M := N2; D := N1; end;
      doYMD: begin Y := N1; YearLen := L1; M := N2; D := N3; end;
    end;
                                                                             
    if (YearLen <= 2) then
    begin
      CenturyBase := CurrentYear - FormatSettings.TwoDigitYearCenturyWindow;
      Inc(Y, CenturyBase div 100 * 100);
      if (FormatSettings.TwoDigitYearCenturyWindow > 0) and (Y < CenturyBase) then
        Inc(Y, 100);
    end;
  end else
  begin
    Y := CurrentYear;
    if DateOrder = doDMY then
    begin
      D := N1; M := N2;
    end else
    begin
      M := N1; D := N2;
    end;
  end;
  ScanString(S, Pos, FormatSettings.DateSeparator);
  ScanBlanks(S, Pos);
                                                                     
                                                                   
  Result := TryEncodeDate(Y, M, D, Date);
end;

function ScanTime(const S: string; var Pos: Integer;
  var Time: TDateTime): Boolean; overload;
var
  BaseHour: Integer;
  Hour, Min, Sec, MSec: Word;
  Junk: Byte;
begin
  Result := False;
  BaseHour := -1;
  if ScanString(S, Pos, TimeAMString) or ScanString(S, Pos, 'AM') then
    BaseHour := 0
  else if ScanString(S, Pos, TimePMString) or ScanString(S, Pos, 'PM') then
    BaseHour := 12;
  if BaseHour >= 0 then ScanBlanks(S, Pos);
  if not ScanNumber(S, Pos, Hour, Junk) then Exit;
  Min := 0;
  Sec := 0;
  MSec := 0;
  if ScanString(S, Pos, TimeSeparator) then
  begin
    if not ScanNumber(S, Pos, Min, Junk) then Exit;
    if ScanString(S, Pos, TimeSeparator) then
    begin
      if not ScanNumber(S, Pos, Sec, Junk) then Exit;
      if ScanString(S, Pos, DecimalSeparator) then
        if not ScanNumber(S, Pos, MSec, Junk) then Exit;
    end;
  end;
  if BaseHour < 0 then
    if ScanString(S, Pos, TimeAMString) or ScanString(S, Pos, 'AM') then
      BaseHour := 0
    else
      if ScanString(S, Pos, TimePMString) or ScanString(S, Pos, 'PM') then
        BaseHour := 12;
  if BaseHour >= 0 then
  begin
    if (Hour = 0) or (Hour > 12) then Exit;
    if Hour = 12 then Hour := 0;
    Inc(Hour, BaseHour);
  end;
  ScanBlanks(S, Pos);
  Result := TryEncodeTime(Hour, Min, Sec, MSec, Time);
end;

function ScanTime(const S: string; var Pos: Integer;
  var Time: TDateTime; const FormatSettings: TFormatSettings): Boolean; overload;
var
  BaseHour: Integer;
  Hour, Min, Sec, MSec: Word;
  Junk: Byte;
begin
  Result := False;
  BaseHour := -1;
  if ScanString(S, Pos, FormatSettings.TimeAMString) or ScanString(S, Pos, 'AM') then
    BaseHour := 0
  else if ScanString(S, Pos, FormatSettings.TimePMString) or ScanString(S, Pos, 'PM') then
    BaseHour := 12;
  if BaseHour >= 0 then ScanBlanks(S, Pos);
  if not ScanNumber(S, Pos, Hour, Junk) then Exit;
  Min := 0;
  Sec := 0;
  MSec := 0;
  if ScanString(S, Pos, FormatSettings.TimeSeparator) then
  begin
    if not ScanNumber(S, Pos, Min, Junk) then Exit;
    if ScanString(S, Pos, FormatSettings.TimeSeparator) then
    begin
      if not ScanNumber(S, Pos, Sec, Junk) then Exit;
      if ScanString(S, Pos, FormatSettings.DecimalSeparator) then
        if not ScanNumber(S, Pos, MSec, Junk) then Exit;
    end;
  end;
  if BaseHour < 0 then
    if ScanString(S, Pos, FormatSettings.TimeAMString) or ScanString(S, Pos, 'AM') then
      BaseHour := 0
    else
      if ScanString(S, Pos, FormatSettings.TimePMString) or ScanString(S, Pos, 'PM') then
        BaseHour := 12;
  if BaseHour >= 0 then
  begin
    if (Hour = 0) or (Hour > 12) then Exit;
    if Hour = 12 then Hour := 0;
    Inc(Hour, BaseHour);
  end;
  ScanBlanks(S, Pos);
  Result := TryEncodeTime(Hour, Min, Sec, MSec, Time);
end;

function StrToDate(const S: string): TDateTime;
begin
  if not TryStrToDate(S, Result) then
    ConvertErrorFmt(SInvalidDate, [S]);
end;

function StrToDate(const S: string; const FormatSettings: TFormatSettings): TDateTime;
begin
  if not TryStrToDate(S, Result, FormatSettings) then
    ConvertErrorFmt(SInvalidDate, [S]);
end;

function StrToDate(const S: string; Provider: IFormatProvider): TDateTime;
begin
  if not TryStrToDate(S, Result, Provider) then
    ConvertErrorFmt(SInvalidDate, [S]);
end;

function StrToDateDef(const S: string; const Default: TDateTime): TDateTime;
begin
  if not TryStrToDate(S, Result) then
    Result := Default;
end;

function StrToDateDef(const S: string; const Default: TDateTime;
  const FormatSettings: TFormatSettings): TDateTime;
begin
  if not TryStrToDate(S, Result, FormatSettings) then
    Result := Default;
end;

function StrToDateDef(const S: string; const Default: TDateTime;
  Provider: IFormatProvider): TDateTime;
begin
  if not TryStrToDate(S, Result, Provider) then
    Result := Default;
end;

function TryStrToDate(const S: string; out Value: TDateTime): Boolean;
var
  Pos: Integer;
begin
  Pos := 1;
  Result := ScanDate(S, Pos, Value) and (Pos > Length(S));
end;

function TryStrToDate(const S: string; out Value: TDateTime;
  const FormatSettings: TFormatSettings): Boolean;
var
  Pos: Integer;
begin
  Pos := 1;
  Result := ScanDate(S, Pos, Value, FormatSettings) and (Pos > Length(S));
end;

function TryStrToDate(const S: string; out Value: TDateTime;
  Provider: IFormatProvider): Boolean;
begin
  Result := False;
  try
    Value := TDateTime.Parse(S, Provider);
    Result := True;
  except
  end;
end;

function StrToTime(const S: string): TDateTime;
begin
  if not TryStrToTime(S, Result) then
    ConvertErrorFmt(SInvalidTime, [S]);
end;

function StrToTime(const S: string; const FormatSettings: TFormatSettings): TDateTime;
begin
  if not TryStrToTime(S, Result, FormatSettings) then
    ConvertErrorFmt(SInvalidTime, [S]);
end;

function StrToTime(const S: string; Provider: IFormatProvider): TDateTime; 
begin
  if not TryStrToTime(S, Result, Provider) then
    ConvertErrorFmt(SInvalidTime, [S]);
end;

function StrToTimeDef(const S: string; const Default: TDateTime): TDateTime;
begin
  if not TryStrToTime(S, Result) then
    Result := Default;
end;

function StrToTimeDef(const S: string; const Default: TDateTime;
  const FormatSettings: TFormatSettings): TDateTime;
begin
  if not TryStrToTime(S, Result, FormatSettings) then
    Result := Default;
end;

function StrToTimeDef(const S: string; const Default: TDateTime;
  Provider: IFormatProvider): TDateTime;
begin
  if not TryStrToTime(S, Result, Provider) then
    Result := Default;
end;

function TryStrToTime(const S: string; out Value: TDateTime): Boolean;
var
  Pos: Integer;
begin
  Pos := 1;
  Result := ScanTime(S, Pos, Value) and (Pos > Length(S));
end;

function TryStrToTime(const S: string; out Value: TDateTime;
  const FormatSettings: TFormatSettings): Boolean;
var
  Pos: Integer;
begin
  Pos := 1;
  Result := ScanTime(S, Pos, Value, FormatSettings) and (Pos > Length(S));
end;

function TryStrToTime(const S: string; out Value: TDateTime;
  Provider: IFormatProvider): Boolean;
begin
  Result := False;
  try
    Value := TDateTime.Parse(S, Provider, DateTimeStyles.NoCurrentDateDefault);
    Result := True;
  except
  end;
end;

function StrToDateTime(const S: string): TDateTime;
begin
  if not TryStrToDateTime(S, Result) then
    ConvertErrorFmt(SInvalidDateTime, [S]);
end;

function StrToDateTime(const S: string; const FormatSettings: TFormatSettings): TDateTime;
begin
  if not TryStrToDateTime(S, Result, FormatSettings) then
    ConvertErrorFmt(SInvalidDateTime, [S]);
end;

function StrToDateTime(const S: string; Provider: IFormatProvider): TDateTime;
begin
  if not TryStrToDateTime(S, Result, Provider) then
    ConvertErrorFmt(SInvalidDateTime, [S]);
end;

function StrToDateTimeDef(const S: string; const Default: TDateTime): TDateTime;
begin
  if not TryStrToDateTime(S, Result) then
    Result := Default;
end;

function StrToDateTimeDef(const S: string; const Default: TDateTime;
  const FormatSettings: TFormatSettings): TDateTime;
begin
  if not TryStrToDateTime(S, Result, FormatSettings) then
    Result := Default;
end;

function StrToDateTimeDef(const S: string; const Default: TDateTime;
  Provider: IFormatProvider): TDateTime;
begin
  if not TryStrToDateTime(S, Result, Provider) then
    Result := Default;
end;

function TryStrToDateTime(const S: string; out Value: TDateTime): Boolean;
var
  Pos: Integer;
  Date, Time: TDateTime;
begin
  Result := True;
  Pos := 1;
  Time := 0;
  if not ScanDate(S, Pos, Date) or
     not ((Pos > Length(S)) or ScanTime(S, Pos, Time)) then

    // Try time only
    Result := TryStrToTime(S, Value)
  else
    if Date >= 0 then
      Value := Date + Time
    else
      Value := Date - Time;
end;

function TryStrToDateTime(const S: string; out Value: TDateTime;
  const FormatSettings: TFormatSettings): Boolean;
var
  Pos: Integer;
  Date, Time: TDateTime;
begin
  Result := True;
  Pos := 1;
  Time := 0;
  if not ScanDate(S, Pos, Date, FormatSettings) or
     not ((Pos > Length(S)) or ScanTime(S, Pos, Time, FormatSettings)) then

    // Try time only
    Result := TryStrToTime(S, Value, FormatSettings)
  else
    if Date >= 0 then
      Value := Date + Time
    else
      Value := Date - Time;
end;

function TryStrToDateTime(const S: string; out Value: TDateTime;
  Provider: IFormatProvider): Boolean;
begin
  Result := False;
  try
    Value := TDateTime.Parse(S, Provider, DateTimeStyles.NoCurrentDateDefault);
    Result := True;
  except
  end;
end;

{ Date/time to string conversions }

{ Conversions between date formats: This is close, but there are some
  cases where the mapping must be approximate.
  For Delphi formats, this means
    * am/pm maps to ampm (that is, must use system setting)
    * a/p is based on current settings, not hardcoded to 'a' or 'p'
    * no control over case in the am/pm or a/p strings
    * no options for how to represent era, they all map to gg
    * no support for z -- it maps to fractional seconds with 3 decimals (zzz)

  For CLR formats, this means
    * no support for single-digit years, they map to 2 digit years.
    * no support for 12-hour clock when there is no am/pm symbol, 24-hour is used.
    * no support for fractional seconds, they map to milliseconds (zzz)
    * no support for time zone offsets
 }
function AddStringToFormat(SB: StringBuilder; I: Integer; S: String): Integer;
begin
  SB.Append(S);
  Result := I + 1;
end;

function ConvertDelphiDateTimeFormat(const Format: string): string;
var
  I, Count, HPos, H2Pos, Len: Integer;
  C : Char;
  DTInfo: System.Globalization.DateTimeFormatInfo;
  SB: StringBuilder;
begin
  Len := Length(Format);
  if Len = 0 then
  begin
    Result := '';
    Exit;
  end;
  if (Len = 1) and ((Format[1] = 'c') or (Format[1] = 'C')) then
  begin
    Result := 'G';
    Exit;
  end;
  DTInfo := System.Threading.Thread.CurrentThread.CurrentCulture.DateTimeFormat;
  SB := StringBuilder.Create(Len);
  I := 1;
  HPos := -1;
  H2Pos := -1;
  while I <= Len do
  begin
    C := Format[I];
    case C of
      'd', 'D':   { ddddd and dddddd must be remapped }
        begin
          Count := 0;
          while (I + Count <= Len) and
                 ((Format[I + Count] = 'd') or (Format[I + Count] = 'D')) do
            Count := Count + 1;
          case Count of
            5: SB.Append(DTInfo.ShortDatePattern);
            6: SB.Append(DTInfo.LongDatePattern);
            else
                SB.Append(StringOfChar('d', Count));
          end;
          Inc(I, Count);
        end;
      't', 'T':  { t -> ShortTimeFormat, tt -> LongTimeFormat }
        begin
          if (I < Len) and
             ((Format[I + 1] = 't') or (Format[I + 1] = 'T')) then
          begin
            SB.Append(DTInfo.LongTimePattern);
            I := I + 2;
          end
          else
          begin
            SB.Append(DTInfo.ShortTimePattern);
            I := I + 1;
          end
        end;
      'c', 'C': { embedded general format }
        begin
          SB.Append(DTInfo.ShortDatePattern);
          I := AddStringToFormat(SB, I, ' ');
          SB.Append(DTInfo.LongTimePattern);
        end;
      'h', 'H': { assume 24-hour clock for now }
        begin
          { remember this position -- we will convert to 12-hour later if we
            find and am/pm string }
          HPos := SB.Length;
          I := AddStringToFormat(SB, I, 'H');
          if (I <= Len) and ((Format[I] = 'h') or (Format[I] = 'H')) then
          begin
            H2Pos := SB.Length;
            I := AddStringToFormat(SB, I, 'H');
          end;
        end;
      'a', 'A': { check for AM/PM strings -- note we cant honor case here }
        begin
          if System.String.Compare(Format, I - 1, 'am/pm', 0, 5, True) = 0 then
          begin
            SB.Append('tt');
            I := I + 5;
          end
          else if System.String.Compare(Format, I - 1, 'ampm', 0, 4, True) = 0 then
          begin
            SB.Append('tt');
            I := I + 4;
          end
          else if System.String.Compare(Format, I - 1, 'a/p', 0, 3, True) = 0 then
          begin
            AddStringToFormat(SB, I, 't');
            Inc(I, 3);
          end
          else
            I := AddStringToFormat(SB, I, C);
          if HPos <> -1 then // check if we need to convert hour code to 12-hour
          begin
            SB.Chars[HPos] := 'h';
            if H2Pos <> -1 then
              SB.Chars[H2Pos] := 'h';
            HPos := -1;
            H2Pos := -1;
          end;
        end;
      '\': { need to double this }
        I := AddStringToFormat(SB, I, '\\');
      'e', 'E', 'g', 'G': { only gg is supported }
        begin
          I := AddStringToFormat(SB, I, 'gg');
          if (I <= Len) and (UpCase(C) = UpCase(Format[I])) then
            I := I + 1;
        end;
      '''', '"': {start of quoted literal sequence}
        begin
          I := AddStringToFormat(SB, I, C);
          Count := 0;
          while (I + Count <= Len) and (Format[I + Count] <> C) do
            Inc(Count);
          SB.Append(Format, I - 1, Count);
          Inc(I, Count);
          if I <= Len then
            I := AddStringToFormat(SB, I, C);
        end;
      'z', 'Z' : { milliseconds not supported, use fff }
        begin
          SB.Append('fff');
          while (I <= Len) and ((Format[I] = 'z') or (Format[I] = 'Z')) do
            I := I + 1;
        end;
      'n', 'N': { minutes}
        I := AddStringToFormat(SB, I, 'm');
      'm', 'M': { lower case m must be upper cased, upper case M is fine as is}
        I := AddStringToFormat(SB, I, 'M');
      'y', 'Y': { upper case Y must be lower cased, lower case y is fine as is}
        I := AddStringToFormat(SB, I, 'y');
      's', 'S': { upper case S must be lower cased, lower case s is fine as is}
        I := AddStringToFormat(SB, I, 's');
      else { anything else works the same }
        I := AddStringToFormat(SB, I, C);
    end;
  end;
  Result := SB.ToString;
end;

function ConvertClrDateTimeFormat(const Format: string): string;
var
  I, Len: Integer;
  DTInfo: System.Globalization.DateTimeFormatInfo;
  SB: StringBuilder;
begin
  Len := Length(Format);
  if Len = 0 then
  begin
    Result := '';
    Exit;
  end;
  if Len = 1 then
  begin
    DTInfo := System.Threading.Thread.CurrentThread.CurrentCulture.DateTimeFormat;
    case Format[1] of
      'd': Result := ShortDateFormat;
      'D': Result := LongDateFormat;
      'f': Result := LongDateFormat + ' ' + ShortTimeFormat;
      'F', 'U': Result := LongDateFormat + ' ' + LongTimeFormat;
      'g': Result := ShortDateFormat + ' ' + ShortTimeFormat;
      'G': Result := 'c';
      'm','M': Result :=  ConvertClrDateTimeFormat(DTInfo.MonthDayPattern);
      'r','R': Result := ConvertClrDateTimeFormat(DTInfo.RFC1123Pattern);
      's': Result := ConvertClrDateTimeFormat(DTInfo.SortableDateTimePattern);
      't': Result := ShortTimeFormat;
      'T' : Result := LongTimeFormat;
      'u': Result := ConvertClrDateTimeFormat(DTInfo.UniversalSortableDateTimePattern);
      'y', 'Y': Result := ConvertClrDateTimeFormat(DTInfo.YearMonthPattern);
      else Result := '';
    end;
    Exit;
  end;
//  Result := Format;
  SB := StringBuilder.Create(Len);
  I := 1;
  while I <= Len do
  begin
    case Format[I] of
      'm':   { minutes are n in Delphi formats }
        I := AddStringToFormat(SB, I, 'n');
      'f':  { not supported, use milliseconds instead }
        begin
          SB.Append('zzz');
          while (I <= Len) and (Format[I] = 'f') do
            I := I + 1;
        end;
      't':  { t -> 'a/p' while tt -> 'ampm' }
        begin
          if (I < Len) and (Format[I + 1] = 't') then
          begin
            SB.Append('ampm');
            I := I + 2;
          end
          else
            I := AddStringToFormat(SB, I, 'a/p');
        end;
      'y': { y not supported, use yy, otherwise, just copy }
        begin
          if (I < Len) and (Format[I + 1] <> 'y') then
            I := AddStringToFormat(SB, I, 'yy')
          else
            while (I <= Len) and (Format[I] = 'y') do
              I := AddStringToFormat(SB, I, 'y');
        end;
      '\': { escape character for literals }
        if I < Len then
        begin
          SB.Append(QuotedStr(Format[I + 1]));
          Inc(I, 2);
        end
        else
          I := AddStringToFormat(SB, I, '\');
      '''': {start of quoted literal sequence}
        begin
          I := AddStringToFormat(SB, I, '''');
          while (I <= Len) and (Format[I] <> '''') do
            I := AddStringToFormat(SB, I, Format[I]);
          if I <= Len then
            I := AddStringToFormat(SB, I, '''');
        end;
      'z', '%': { ignore: no support for time zones, % is escape for 1-char custom }
        I := I + 1;
      else { anything else works the same or is as close as we can get }
        I := AddStringToFormat(SB, I, Format[I]);
    end;
  end;
  Result := SB.ToString;
end;

procedure DateTimeToString(var Result: string; const Format: string;
  ADateTime: TDateTime);
var
  LFormat: DateTimeFormatInfo;
  LShortMonthNames, LLongMonthNames: array[0..12] of string;
begin
  LFormat := DateTimeFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.DateTimeFormat.Clone);
  with LFormat do
  begin
    DateSeparator := Borland.Vcl.SysUtils.DateSeparator;
    ShortDatePattern := ConvertDelphiDateTimeFormat(ShortDateFormat);
    LongDatePattern := ConvertDelphiDateTimeFormat(LongDateFormat);
    TimeSeparator := Borland.Vcl.SysUtils.TimeSeparator;
    AMDesignator := TimeAMString;
    PMDesignator := TimePMString;
    ShortTimePattern := ConvertDelphiDateTimeFormat(ShortTimeFormat);
    LongTimePattern := ConvertDelphiDateTimeFormat(LongTimeFormat);

    System.Array.Copy(ShortMonthNames, LShortMonthNames, Length(ShortMonthNames));
    System.Array.Copy(LongMonthNames, LLongMonthNames, Length(LongMonthNames));
    AbbreviatedMonthNames := LShortMonthNames;
    MonthNames := LLongMonthNames;
    AbbreviatedDayNames := ShortDayNames;
    DayNames := LongDayNames;
  end;
  DateTimeToString(Result, Format, ADateTime, LFormat);
end;

procedure DateTimeToString(var Result: string; const Format: string;
  ADateTime: TDateTime; const FormatSettings: TFormatSettings);
var
  LFormat: DateTimeFormatInfo;
  LShortMonthNames, LLongMonthNames: array[0..12] of string;
begin
  LFormat := DateTimeFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.DateTimeFormat.Clone);
  with LFormat, FormatSettings do
  begin
    LFormat.DateSeparator := FormatSettings.DateSeparator;
    ShortDatePattern := ConvertDelphiDateTimeFormat(ShortDateFormat);
    LongDatePattern := ConvertDelphiDateTimeFormat(LongDateFormat);
    LFormat.TimeSeparator := FormatSettings.TimeSeparator;
    AMDesignator := TimeAMString;
    PMDesignator := TimePMString;
    ShortTimePattern := ConvertDelphiDateTimeFormat(ShortTimeFormat);
    LongTimePattern := ConvertDelphiDateTimeFormat(LongTimeFormat);

    System.Array.Copy(ShortMonthNames, LShortMonthNames, Length(ShortMonthNames));
    System.Array.Copy(LongMonthNames, LLongMonthNames, Length(LongMonthNames));
    AbbreviatedMonthNames := LShortMonthNames;
    MonthNames := LLongMonthNames;
    AbbreviatedDayNames := ShortDayNames;
    DayNames := LongDayNames;
  end;
  DateTimeToString(Result, Format, ADateTime, LFormat);
end;

procedure DateTimeToString(var Result: string; const Format: string;
  ADateTime: TDateTime; Provider: IFormatProvider);
begin
  Result := ADateTime.ToString(ConvertDelphiDateTimeFormat(Format), Provider);
end;

function MinDateTime: TDateTime;
begin
  Result := TDateTime.MinValue;
end;

function MaxDateTime: TDateTime;
begin
  Result := TDateTime.MaxValue;
end;

function TryFloatToDateTime(const Value: Extended; out AResult: TDateTime): Boolean;
begin
  Result := not ((Value < MinDateTimeAsDouble) or (Value >= Int(MaxDateTimeAsDouble) + 1.0));
  if Result then
    AResult := Value;
end;

function FloatToDateTime(const Value: Extended): TDateTime;
begin
  if not TryFloatToDateTime(Value, Result) then
    ConvertErrorFmt(SInvalidDateTimeFloat, [Value]);
end;

procedure Sleep(milliseconds: Cardinal);
begin
  System.Threading.Thread.Sleep(milliseconds);
end;

function SysErrorMessage(ErrorCode: Integer): string;
const
  BufferSize = 256;
var
  Buffer: StringBuilder;
  Len: Integer;
begin
  Buffer := StringBuilder.Create(BufferSize);
  Len := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS or
    FORMAT_MESSAGE_ARGUMENT_ARRAY, nil, ErrorCode, 0, Buffer, BufferSize, nil);
  while (Len > 0) and (Buffer[Len - 1] in [WideChar(#0)..WideChar(#32), WideChar('.')]) do Dec(Len);
  Buffer.Length := Len;
  Result := Buffer.ToString;
end;

procedure RaiseLastOSError;
var
  LastError: Integer;
  Error: EOSError;
begin
  LastError := GetLastError;
  if LastError <> 0 then
    Error := EOSError(EOSError.CreateFmt(SOSError, [LastError,
      SysErrorMessage(LastError)]))
  else
    Error := EOSError.Create(SUnkOSError);
  Error.ErrorCode := LastError;
  raise Error;
end;

procedure RaiseLastWin32Error;
begin
  RaiseLastOSError;
end;

function Win32Check(RetVal: BOOL): BOOL;
begin
  if not RetVal then RaiseLastWin32Error;
  Result := RetVal;
end;

function ExceptionErrorMessage(AExceptObject: TObject): string;
var
  E, E2: Exception;
  Msg: string;
begin
  if AExceptObject is Exception then
  begin
    E := System.Exception(AExceptObject);
    Msg := E.Message;
    while True do
    begin
      E2 := E.GetBaseException;
      if E2 <> E then
      begin
        if (Msg <> '') and (Msg[Length(Msg)] = '.') then Msg[Length(Msg)] := ':';
        Msg := Format('%s' + #13#10 + '%s', [Msg, E2.Message]);
        E := E2;
      end
      else Break;
    end;
    Result := Format(SException, [Msg, E.StackTrace]);
  end
  else
    Result := Format(SNonstandardException, [AExceptObject.ToString]);
end;

{ Display exception message }

procedure ShowException(AExceptObject: TObject; ExceptAddr: IntPtr);
var
  Msg: string;
begin
  Msg := ExceptionErrorMessage(AExceptObject);
  if IsConsole then
    WriteLn(Msg)
  else
    MessageBox(0, Msg, SExceptTitle, MB_OK or MB_ICONSTOP or MB_TASKMODAL);
end;

{ MBCS functions }

function ByteTypeTest(const S: AnsiString; Index: Integer): TMbcsByteType;
var
  I: Integer;
begin
  Result := mbSingleByte;
  if S = '' then Exit;
  if (Index = 1) then
  begin
    if S[1] in LeadBytes then
      Result := mbLeadByte;
  end
  else
  begin
    I := Index - 1;
    while (I >= 1) and (S[I] in LeadBytes) do Dec(I);
    if ((Index - I) mod 2) = 0 then
      Result := mbTrailByte
    else
      if S[Index] in LeadBytes then
        Result := mbLeadByte;
  end;
end;

function ByteType(const S: AnsiString; Index: Integer): TMbcsByteType;
begin
  Result := mbSingleByte;
  if SysLocale.FarEast then
    Result := ByteTypeTest(S, Index);
end;

function ByteType(const S: WideString; Index: Integer): TMbcsByteType;
begin
  Result := mbSingleByte;
end;

function ByteToCharLen(const S: AnsiString; MaxLen: Integer): Integer;
begin
  if Length(S) < MaxLen then
    MaxLen := Length(S);
  Result := ByteToCharIndex(S, MaxLen);
end;

function ByteToCharLen(const S: WideString; MaxLen: Integer): Integer;
begin
  Result := Length(S);
  if Result > MaxLen then
    Result := MaxLen;
end;

procedure CountChars(const S: AnsiString; MaxChars: Integer; var CharCount, ByteCount: Integer);
var
  C, L, B: Integer;
begin
  L := Length(S);
  C := 1;
  B := 1;
  while (B < L) and (C < MaxChars) do
  begin
    Inc(C);
    if S[B] in LeadBytes then
      B := NextCharIndex(S, B)
    else
      Inc(B);
  end;
  if (C = MaxChars) and (B < L) and (S[B] in LeadBytes) then
    B := NextCharIndex(S, B) - 1;
  CharCount := C;
  ByteCount := B;
end;

function CharToByteLen(const S: AnsiString; MaxLen: Integer): Integer;
var
  Chars: Integer;
begin
  Result := 0;
  if MaxLen <= 0 then Exit;
  if MaxLen > Length(S) then
    MaxLen := Length(S);
  if SysLocale.FarEast then
  begin
    CountChars(S, MaxLen, Chars, Result);
    if Result > Length(S) then
      Result := Length(S);
  end
  else
    Result := MaxLen;
end;

function CharToByteLen(const S: WideString; MaxLen: Integer): Integer;
begin
  if Length(S) > MaxLen then
    Result := MaxLen * 2
  else
    Result := Length(S) * 2;
end;

function ByteToCharIndex(const S: AnsiString; Index: Integer): Integer;
var
  I: Integer;
begin
  Result := 0;
  if (Index <= 0) or (Index > Length(S)) then Exit;
  Result := Index;
  if not SysLocale.FarEast then Exit;
  I := 1;
  Result := 0;
  while I <= Index do
  begin
    if S[I] in LeadBytes then
      I := NextCharIndex(S, I)
    else
      Inc(I);
    Inc(Result);
  end;
end;

function ByteToCharIndex(const S: WideString; Index: Integer): Integer;
begin
  Result := Index;
end;

function CharToByteIndex(const S: AnsiString; Index: Integer): Integer;
var
  Chars: Integer;
begin
  Result := 0;
  if (Index <= 0) or (Index > Length(S)) then Exit;
  if (Index > 1) and SysLocale.FarEast then
  begin
    CountChars(S, Index-1, Chars, Result);
    if (Chars < (Index-1)) or (Result >= Length(S)) then
      Result := 0  // Char index out of range
    else
      Inc(Result);
  end
  else
    Result := Index;
end;

function CharToByteIndex(const S: WideString; Index: Integer): Integer;
begin
  Result := Index;
end;

function StrCharLength(const Str: AnsiString; Index: Integer): Integer;
var
  Buffer, P: IntPtr;
begin
  Buffer := Marshal.StringToHGlobalAnsi(Str);
  try
    P := IntPtr(LongInt(Buffer) + Index - 1);
    Result := LongInt(CharNextA(P)) - LongInt(P);
  finally
    Marshal.FreeHGlobal(Buffer);
  end;
end;

function CharLength(const S: AnsiString; Index: Integer): Integer;
begin
  Result := 1;
  assert((Index > 0) and (Index <= Length(S)));
  if SysLocale.FarEast and (S[Index] in LeadBytes) then
    Result := StrCharLength(S, Index - 1);
end;

function CharLength(const S: WideString; Index: Integer): Integer;
begin
  Result := 2; // WideString is always 2 bytes
end;

function NextCharIndex(const S: AnsiString; Index: Integer): Integer;
begin
  Result := Index + 1;
  assert((Index > 0) and (Index <= Length(S)));
  if SysLocale.FarEast and (S[Index] in LeadBytes) then
    Result := Index + StrCharLength(S, Index - 1);
end;

function NextCharIndex(const S: WideString; Index: Integer): Integer;
begin
  Result := Index + 1;
end;

function LCIDToCodePage(ALcid: LCID): Integer;
var
  Buffer: StringBuilder;
begin
  Buffer := StringBuilder.Create(7);
  GetLocaleInfo(ALcid, LOCALE_IDEFAULTANSICODEPAGE, Buffer, Buffer.Capacity);
  Result:= StrToIntDef(Buffer.ToString, GetACP);
end;

procedure InitSysLocale;
var
  DefaultLCID: LCID;
  DefaultLangID: LANGID;
  AnsiCPInfo: TCPInfo;

  procedure InitLeadBytes;
  var
    I: Integer;
    J: Byte;
  begin
    GetCPInfo(LCIDToCodePage(SysLocale.DefaultLCID), AnsiCPInfo);
    with AnsiCPInfo do
    begin
      I := 0;
      while (I < MAX_LEADBYTES) and ((LeadByte[I] or LeadByte[I + 1]) <> 0) do
      begin
        for J := LeadByte[I] to LeadByte[I + 1] do
          Include(LeadBytes, AnsiChar(J));
        Inc(I, 2);
      end;
    end;
  end;

begin
  { Set default to English (US). }
  SysLocale.DefaultLCID := $0409;
  SysLocale.PriLangID := LANG_ENGLISH;
  SysLocale.SubLangID := SUBLANG_ENGLISH_US;

  DefaultLCID := System.Threading.Thread.CurrentThread.CurrentCulture.LCID;
  if DefaultLCID <> 0 then SysLocale.DefaultLCID := DefaultLCID;

  DefaultLangID := Word(DefaultLCID);
  if DefaultLangID <> 0 then
  begin
    SysLocale.PriLangID := DefaultLangID and $3ff;
    SysLocale.SubLangID := DefaultLangID shr 10;
  end;

  if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion > 4) then
  begin
    SysLocale.MiddleEast := True;
    SysLocale.FarEast    := True;

    { Far East (aka MBCS)? - }
    InitLeadBytes;
  end
  else
  begin
    SysLocale.MiddleEast := GetSystemMetrics(SM_MIDEASTENABLED) <> 0;
    SysLocale.FarEast    := GetSystemMetrics(SM_DBCSENABLED) <> 0;
    if SysLocale.FarEast then
      InitLeadBytes;
  end;
end;

procedure GetFormatSettings;
var
  I: integer;
  NumberInfo: System.Globalization.NumberFormatInfo;
  DateTimeInfo: System.Globalization.DateTimeFormatInfo;
begin
  InitSysLocale;
  NumberInfo := System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat;
  CurrencyString := NumberInfo.CurrencySymbol;
  CurrencyFormat := NumberInfo.CurrencyPositivePattern;
  NegCurrFormat := NumberInfo.CurrencyNegativePattern;
  ThousandSeparator := NumberInfo.CurrencyGroupSeparator;
  DecimalSeparator := NumberInfo.CurrencyDecimalSeparator;
  CurrencyDecimals := NumberInfo.CurrencyDecimalDigits;

  DateTimeInfo := System.Threading.Thread.CurrentThread.CurrentCulture.DateTimeFormat;
  DateSeparator := DateTimeInfo.DateSeparator;
  ShortDateFormat := ConvertClrDateTimeFormat(DateTimeInfo.ShortDatePattern);
  LongDateFormat := ConvertClrDateTimeFormat(DateTimeInfo.LongDatePattern);
  TimeSeparator := DateTimeInfo.TimeSeparator;
  TimeAMString := DateTimeInfo.AMDesignator;
  TimePMString := DateTimeInfo.PMDesignator;
  ShortTimeFormat := ConvertClrDateTimeFormat(DateTimeInfo.ShortTimePattern);
  LongTimeFormat := ConvertClrDateTimeFormat(DateTimeInfo.LongTimePattern);
  for I := 0 to 11 do
  begin
    ShortMonthNames[I + 1] := DateTimeInfo.AbbreviatedMonthNames[I];
    LongMonthNames[I + 1] := DateTimeInfo.MonthNames[I];
  end;
  for I := 0 to 6 do
  begin
    ShortDayNames[I + 1] := DateTimeInfo.AbbreviatedDayNames[I];
    LongDayNames[I + 1] := DateTimeInfo.DayNames[I];
  end;

  ListSeparator := System.Threading.Thread.CurrentThread.CurrentCulture.TextInfo.ListSeparator;
end;

procedure GetLocaleFormatSettings(LCID: Integer; var FormatSettings: TFormatSettings);
var
  I, DefaultLCID: Integer;
  LCultureInfo: CultureInfo;
begin
  if IsValidLocale(LCID, LCID_INSTALLED) then
    DefaultLCID := LCID
  else
    DefaultLCID := System.Threading.Thread.CurrentThread.CurrentCulture.LCID;

  LCultureInfo := CultureInfo.Create(DefaultLCID);
  with FormatSettings do
  begin
    CurrencyString := LCultureInfo.NumberFormat.CurrencySymbol;
    CurrencyFormat := LCultureInfo.NumberFormat.CurrencyPositivePattern;
    NegCurrFormat := LCultureInfo.NumberFormat.CurrencyNegativePattern;
    ThousandSeparator := LCultureInfo.NumberFormat.CurrencyGroupSeparator;
    DecimalSeparator := LCultureInfo.NumberFormat.CurrencyDecimalSeparator;
    CurrencyDecimals := LCultureInfo.NumberFormat.CurrencyDecimalDigits;

    DateSeparator := LCultureInfo.DateTimeFormat.DateSeparator;
    ShortDateFormat := ConvertClrDateTimeFormat(LCultureInfo.DateTimeFormat.ShortDatePattern);
    LongDateFormat := ConvertClrDateTimeFormat(LCultureInfo.DateTimeFormat.LongDatePattern);
    TimeSeparator := LCultureInfo.DateTimeFormat.TimeSeparator;
    TimeAMString := LCultureInfo.DateTimeFormat.AMDesignator;
    TimePMString := LCultureInfo.DateTimeFormat.PMDesignator;
    ShortTimeFormat := ConvertClrDateTimeFormat(LCultureInfo.DateTimeFormat.ShortTimePattern);
    LongTimeFormat := ConvertClrDateTimeFormat(LCultureInfo.DateTimeFormat.LongTimePattern);
    for I := 0 to 11 do
    begin
      ShortMonthNames[I + 1] := LCultureInfo.DateTimeFormat.AbbreviatedMonthNames[I];
      LongMonthNames[I + 1] := LCultureInfo.DateTimeFormat.MonthNames[I];
    end;
    for I := 0 to 6 do
    begin
      ShortDayNames[I + 1] := LCultureInfo.DateTimeFormat.AbbreviatedDayNames[I];
      LongDayNames[I + 1] := LCultureInfo.DateTimeFormat.DayNames[I];
    end;

    ListSeparator := LCultureInfo.TextInfo.ListSeparator;
  end;
end;

const
  AccessMode: array[0..2] of System.IO.FileAccess = (
    System.IO.FileAccess.Read,
    System.IO.FileAccess.Write,
    System.IO.FileAccess.ReadWrite);
  ShareMode: array[0..4] of System.IO.FileShare = (
    System.IO.FileShare.None,
    System.IO.FileShare.None,
    System.IO.FileShare.Read,
    System.IO.FileShare.Write,
    System.IO.FileShare.ReadWrite );

function FileOpen(const FileName: string; Mode: LongWord): TOpenedFile;
begin
  Result := nil;
  if ((Mode and 3) <= fmOpenReadWrite) and
     (((Mode and $F0) shr 4) <= fmShareDenyNone) then
    Result := System.IO.File.Open(FileName, System.IO.FileMode.Open,
      AccessMode[Mode and 3], ShareMode[(Mode and $F0) shr 4]);
end;

function FileCreate(const FileName: string): TOpenedFile;
begin
  Result := System.IO.File.Open(FileName, System.IO.FileMode.Create);
end;

function FileCreate(const FileName: string; Rights: Integer): TOpenedFile;
begin
  Result := FileCreate(FileName);
end;

function FileRead(Handle: TOpenedFile; var Buffer: TBytes; Count: LongWord): Integer; overload;
begin
  if Count > LongWord(Length(Buffer)) then Count := Length(Buffer);
  if (Handle <> nil) and (Count > 0) then
    Result := Handle.Read(Buffer, 0, Count)
  else Result := -1;
end;

function FileRead(Handle: TOpenedFile; var Buffer: Boolean; Count: LongWord): Integer; overload;
var
  ByteBuf: TBytes;
begin
  if Count <> SizeOf(Buffer) then Result := -1
  else
  begin
    SetLength(ByteBuf, Count);
    Result := FileRead(Handle, ByteBuf, Count);
    Buffer := System.BitConverter.ToBoolean(ByteBuf, 0);
  end;
end;

function FileRead(Handle: TOpenedFile; var Buffer: Char; Count: LongWord): Integer; overload;
var
  ByteBuf: TBytes;
begin
  if Count <> SizeOf(Char) then Result := -1
  else
  begin
    SetLength(ByteBuf, Count);
    Result := FileRead(Handle, ByteBuf, Count);
    Buffer := System.BitConverter.ToChar(ByteBuf, 0);
  end;
end;

function FileRead(Handle: TOpenedFile; var Buffer: Double; Count: LongWord): Integer; overload;
var
  ByteBuf: TBytes;
begin
  if Count <> SizeOf(Double) then Result := -1
  else
  begin
    SetLength(ByteBuf, Count);
    Result := FileRead(Handle, ByteBuf, Count);
    Buffer := System.BitConverter.ToDouble(ByteBuf, 0);
  end;
end;

function FileRead(Handle: TOpenedFile; var Buffer: Single; Count: LongWord): Integer; overload;
var
  ByteBuf: TBytes;
begin
  if Count <> SizeOf(Single) then Result := -1
  else
  begin
    SetLength(ByteBuf, Count);
    Result := FileRead(Handle, ByteBuf, Count);
    Buffer := System.BitConverter.ToSingle(ByteBuf, 0);
  end;
end;

function FileRead(Handle: TOpenedFile; var Buffer: Integer; Count: LongWord): Integer; overload;
var
  ByteBuf: TBytes;
begin
  if Count <> SizeOf(Integer) then Result := -1
  else
  begin
    SetLength(ByteBuf, Count);
    Result := FileRead(Handle, ByteBuf, Count);
    Buffer := System.BitConverter.ToInt32(ByteBuf, 0);
  end;
end;

function FileRead(Handle: TOpenedFile; var Buffer: Cardinal; Count: LongWord): Integer; overload;
var
  ByteBuf: TBytes;
begin
  if Count <> SizeOf(Cardinal) then Result := -1
  else
  begin
    SetLength(ByteBuf, Count);
    Result := FileRead(Handle, ByteBuf, Count);
    Buffer := System.BitConverter.ToUInt32(ByteBuf, 0);
  end;
end;

function FileRead(Handle: TOpenedFile; var Buffer: SmallInt; Count: LongWord): Integer; overload;
var
  ByteBuf: TBytes;
begin
  if Count <> SizeOf(SmallInt) then Result := -1
  else
  begin
    SetLength(ByteBuf, Count);
    Result := FileRead(Handle, ByteBuf, Count);
    Buffer := System.BitConverter.ToInt16(ByteBuf, 0);
  end;
end;

function FileRead(Handle: TOpenedFile; var Buffer: Word; Count: LongWord): Integer; overload;
var
  ByteBuf: TBytes;
begin
  if Count <> SizeOf(Word) then Result := -1
  else
  begin
    SetLength(ByteBuf, Count);
    Result := FileRead(Handle, ByteBuf, Count);
    Buffer := System.BitConverter.ToUInt16(ByteBuf, 0);
  end;
end;

function FileRead(Handle: TOpenedFile; var Buffer: Int64; Count: LongWord): Integer; overload;
var
  ByteBuf: TBytes;
begin
  if Count <> SizeOf(Int64) then Result := -1
  else
  begin
    SetLength(ByteBuf, Count);
    Result := FileRead(Handle, ByteBuf, Count);
    Buffer := System.BitConverter.ToInt64(ByteBuf, 0);
  end;
end;

function FileRead(Handle: TOpenedFile; var Buffer: string; Count: LongWord; IsWide: Boolean = False): Integer; overload;
var
  ByteBuf: TBytes;
begin
  SetLength(ByteBuf, Count);
  Result := FileRead(Handle, ByteBuf, Count);
  if IsWide then
    Buffer := System.Text.Encoding.Unicode.GetString(ByteBuf)
  else
    Buffer := StringOf(ByteBuf);
end;

function FileWrite(Handle: TOpenedFile; const Buffer: TBytes; Count: LongWord): Integer; overload;
var
  StartPos: Int64;
begin
  if Count > LongWord(Length(Buffer)) then Count := Length(Buffer);
  if (Handle <> nil) and (Count > 0) then
  begin
    StartPos := Handle.Position;
    Handle.Write(Buffer, 0, Count);
    Result := Handle.Position - StartPos;
  end
  else Result := -1;
end;

function FileWrite(Handle: TOpenedFile; const Buffer: Boolean; Count: LongWord): Integer; overload;
begin
  if Count <> SizeOf(Buffer) then Result := -1
  else
    Result := FileWrite(Handle, System.BitConverter.GetBytes(Buffer), Count);
end;

function FileWrite(Handle: TOpenedFile; const Buffer: Char; Count: LongWord): Integer; overload;
begin
  if Count <> SizeOf(Buffer) then Result := -1
  else
    Result := FileWrite(Handle, System.BitConverter.GetBytes(Buffer), Count);
end;

function FileWrite(Handle: TOpenedFile; const Buffer: Double; Count: LongWord): Integer; overload;
begin
  if Count <> SizeOf(Buffer) then Result := -1
  else
    Result := FileWrite(Handle, System.BitConverter.GetBytes(Buffer), Count);
end;

function FileWrite(Handle: TOpenedFile; const Buffer: Single; Count: LongWord): Integer; overload;
begin
  if Count <> SizeOf(Buffer) then Result := -1
  else
    Result := FileWrite(Handle, System.BitConverter.GetBytes(Buffer), Count);
end;

function FileWrite(Handle: TOpenedFile; const Buffer: Integer; Count: LongWord): Integer; overload;
begin
  if Count <> SizeOf(Buffer) then Result := -1
  else
    Result := FileWrite(Handle, System.BitConverter.GetBytes(Buffer), Count);
end;

function FileWrite(Handle: TOpenedFile; const Buffer: Cardinal; Count: LongWord): Integer; overload;
begin
  if Count <> SizeOf(Buffer) then Result := -1
  else
    Result := FileWrite(Handle, System.BitConverter.GetBytes(Buffer), Count);
end;

function FileWrite(Handle: TOpenedFile; const Buffer: SmallInt; Count: LongWord): Integer; overload;
begin
  if Count <> SizeOf(Buffer) then Result := -1
  else
    Result := FileWrite(Handle, System.BitConverter.GetBytes(Buffer), Count);
end;

function FileWrite(Handle: TOpenedFile; const Buffer: Word; Count: LongWord): Integer; overload;
begin
  if Count <> SizeOf(Buffer) then Result := -1
  else
    Result := FileWrite(Handle, System.BitConverter.GetBytes(Buffer), Count);
end;

function FileWrite(Handle: TOpenedFile; const Buffer: Int64; Count: LongWord): Integer; overload;
begin
  if Count <> SizeOf(Buffer) then Result := -1
  else
    Result := FileWrite(Handle, System.BitConverter.GetBytes(Buffer), Count);
end;

function FileWrite(Handle: TOpenedFile; const Buffer: string; Count: LongWord; IsWide: Boolean = False): Integer; overload;
begin
  if IsWide then
    Result := FileWrite(Handle, System.Text.Encoding.Unicode.GetBytes(Buffer), Count)
  else
    Result := FileWrite(Handle, BytesOf(AnsiString(Buffer)), Count);
end;

function FileSeek(Handle: TOpenedFile; Offset, Origin: Integer): Integer;
begin
  Result := Integer(FileSeek(Handle, Int64(Offset), Origin));
end;

const
  SeekOrigins: array[0..2] of System.IO.SeekOrigin = (
    System.IO.SeekOrigin.Begin,
    System.IO.SeekOrigin.Current,
    System.IO.SeekOrigin.End);

function FileSeek(Handle: TOpenedFile; const Offset: Int64; Origin: Integer): Int64;
begin
    Result := Handle.Seek(Offset, SeekOrigins[Origin]);
end;


procedure FileClose(Handle: TOpenedFile);
begin
  Handle.Close;
end;

function FileGetDate(Handle: TOpenedFile): Integer;
begin
  if Handle = nil then
    Result := -1
  else
    Result := FileAge(Handle.Name);
end;

function FileSetDate(const FileName: string; ATimeStamp: TDateTime): Integer;
begin
  Result := 0;
  try
    System.IO.File.SetLastWriteTime(FileName, ATimeStamp);
  except
    on E: Exception do
      Result := E.HResult;
    else
      Result := 1;
  end;
end;

function FileSetDate(const FileName: string; Age: Integer): Integer;
begin
  Result := FileSetDate(FileName, FileDateToDateTime(Age));
end;

function FileSetDate(Handle: TOpenedFile; Age: Integer): Integer;
begin
  if Handle = nil then
    Result := -1
  else
    Result := FileSetDate(Handle.Name, Age);
end;

function FindMatchingFile(var F: TSearchRec): Integer;
var
  LocalFileTime: TFileTime;
  TheDate, TheTime: Word;
begin
  with F do
  begin
    while FindData.dwFileAttributes and ExcludeAttr <> 0 do
      if not FindNextFile(FindHandle, FindData) then
      begin
        Result := GetLastError;
        Exit;
      end;
    FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
    FileTimeToDosDateTime(LocalFileTime, TheDate, TheTime);
    Time := MakeLong(TheTime, TheDate);
    Size := FindData.nFileSizeLow;
    Attr := FindData.dwFileAttributes;
    Name := FindData.cFileName;
  end;
  Result := 0;
end;

const
  faSpecial = faHidden or faSysFile or faVolumeID or faDirectory;

function FindFirst(const Path: string; Attr: Integer;
  var  F: TSearchRec): Integer;
begin
  F.ExcludeAttr := not Attr and faSpecial;
  F.FindHandle := FindFirstFile(Path, F.FindData);
  if F.FindHandle <> INVALID_HANDLE_VALUE then
  begin
    Result := FindMatchingFile(F);
    if Result <> 0 then FindClose(F);
  end else
    Result := GetLastError;
end;

function FindNext(var F: TSearchRec): Integer;
begin
  if FindNextFile(F.FindHandle, F.FindData) then
    Result := FindMatchingFile(F)
  else
    Result := GetLastError;
end;

procedure FindClose(var F: TSearchRec);
begin
  if F.FindHandle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(F.FindHandle);
    F.FindHandle := INVALID_HANDLE_VALUE;
  end;
end;

function FileExists(const FileName: string): Boolean;
begin
  Result := System.IO.File.Exists(FileName);
end;

function FileDateToDateTime(FileDate: Integer): TDateTime;
var
  LoPart, HiPart: Word;
begin
  LoPart := Word(FileDate);
  HiPart := FileDate shr 16;
  Result := EncodeDate(HiPart shr 9 + 1980, HiPart shr 5 and 15, HiPart and 31) +
            EncodeTime(LoPart shr 11, LoPart shr 5 and 63, LoPart and 31 shl 1, 0);
end;

function DateTimeToFileDate(ADateTime: TDateTime): Integer;
var
  Year, Month, Day, Hour, Min, Sec, MSec, LoPart, HiPart: Word;
begin
  DecodeDate(ADateTime, Year, Month, Day);
  if (Year < 1980) or (Year > 2107) then Result := 0 else
  begin
    DecodeTime(ADateTime, Hour, Min, Sec, MSec);
    LoPart := (Sec shr 1) or (Min shl 5) or (Hour shl 11);
    HiPart := Day or (Month shl 5) or ((Year - 1980) shl 9);
    Result := LoPart + (HiPart shl 16);
  end;
end;

function FileAge(const FileName: string): Integer;
begin
  if not FileExists(FileName) then
    Result := -1
  else
    Result := DateTimeToFileDate(System.IO.File.GetLastWriteTime(FileName).ToOADate);
end;

function FileGetAttr(const FileName: string): Integer;
begin
  Result := Integer(System.IO.File.GetAttributes(FileName));
end;

function FileSetAttr(const FileName: string; Attr: Integer): Integer;
begin
  try
    System.IO.File.SetAttributes(FileName, System.IO.FileAttributes(Attr));
    Result := 0;
  except
    on E: Exception do
      Result := E.HResult;
    else
      Result := 1;
  end;
end;

function FileIsReadOnly(const FileName: string): Boolean;
begin
  Result := (FileGetAttr(FileName) and Integer(System.IO.FileAttributes.ReadOnly)) <> 0;
end;

function FileSetReadOnly(const FileName: string; ReadOnly: Boolean): Boolean;
var
  LAttr: Integer;
begin
  LAttr := FileGetAttr(FileName);
  if LAttr and Integer(System.IO.FileAttributes.ReadOnly) = 0 then
    Result := (FileSetAttr(FileName, LAttr or Integer(System.IO.FileAttributes.ReadOnly)) = 0) and
              FileIsReadOnly(FileName)
  else
    Result := True;
end;

function DeleteFile(const FileName: string): Boolean;
begin
  Result := True;
  try
    System.IO.File.Delete(FileName);
  except
    Result := False;
  end;
  if Result then
    Result := not System.IO.File.Exists(FileName);
end;

function RenameFile(const OldName, NewName: string): Boolean;
begin
  Result := System.IO.File.Exists(OldName);
  if Result then
  begin
    System.IO.File.Move(OldName, NewName);
    Result := System.IO.File.Exists(NewName);
  end;
end;

function ChangeFileExt(const FileName, Extension: string): string;
begin
  if Length(Extension) <> 0 then
    Result := System.IO.Path.ChangeExtension(FileName, Extension)
  else
    Result := System.IO.Path.ChangeExtension(FileName, System.String(nil));
end;

function ExtractFilePath(const FileName: string): string;
var
  I: Integer;
begin
  I := LastDelimiter(PathDelim + DriveDelim, FileName);
  Result := Copy(FileName, 1, I);
end;

function ExtractFileDir(const FileName: string): string;
begin
                                                 
  Result := System.IO.Path.GetDirectoryName(FileName);
end;

function ExtractFileDrive(const FileName: string): string;
var
  Len: Integer;
begin
                                                 
  Result := System.IO.Path.GetPathRoot(FileName);
  Len := Length(Result);
  if (Len > 0) and (Result[Len] = PathDelim) then
    SetLength(Result, Len-1);
end;

function ExtractFileName(const FileName: string): string;
begin
  Result := System.IO.Path.GetFileName(FileName);
end;

function ExtractFileExt(const FileName: string): string;
begin
  Result := System.IO.Path.GetExtension(FileName);
end;

function ExpandFileName(const FileName: string): string;
begin
  Result := System.IO.Path.GetFullPath(FileName);
end;

function ExpandFileNameCase(const FileName: string;
  out MatchFound: TFilenameCaseMatch): string;
var
  FullPath, Name: string;
  NFound: Integer;
  FileArray: array of string;
  I, MatchIndex: integer;
  FirstLetterMask: string;
begin
  Result := ExpandFileName(FileName);
  FullPath := ExtractFilePath(Result);
  Name := ExtractFileName(Result);
  MatchFound := mkNone;

  if System.IO.File.Exists(Result) or System.IO.Directory.Exists(Result) then
  begin
      MatchFound := mkExactMatch;  { found an exact match }
      Exit;
  end;

  // can't find an exact match, recurse to adjust the path

  // if FullPath is not the root directory  (portable)
  if not SameFileName(FullPath, IncludeTrailingPathDelimiter(ExtractFileDrive(FullPath))) then
  begin  // Does the path need case-sensitive work?
    FullPath := ExcludeTrailingPathDelimiter(FullPath);
    FullPath := ExpandFileNameCase(FullPath, MatchFound);
    if MatchFound = mkNone then
      Exit;    // if we can't find the path, we certainly can't find the file!
    FullPath := IncludeTrailingPathDelimiter(FullPath);
  end;

  // Path is validated / adjusted.  Now for the file itself
  NFound := 0;
  MatchIndex := -1;
  { First look at all possibilities that match the first letter }
  FirstLetterMask := Name[1] + '*';
  FileArray := System.IO.Directory.GetFileSystemEntries(FullPath, FirstLetterMask);
  for I := 0 to Length(FileArray) - 1 do
  begin
    if SameStr(Name, FileArray[I]) then // exact match on filename
    begin
      if not (MatchFound in [mkSingleMatch, mkAmbiguous]) then  // path might have been inexact
        MatchFound := mkExactMatch;
      Result := FullPath + Name;
      Exit;
    end
    else if WideSameText(Name, FileArray[I]) then // inexact match on filename
    begin
       Inc(NFound);
       if MatchIndex < 0 then
         MatchIndex := I; // remember the first match
    end;
  end;
  if NFound > 0 then // found one or more inexact matches
  begin
    Result := FullPath + FileArray[MatchIndex];
    if NFound > 1 then
    begin
      MatchFound := mkAmbiguous;
      Exit;
    end;
    MatchFound := mkSingleMatch;
  end;
  { Next look at all possibilities that match the first letter except for case }
  { we only need to do this if we have no matches or 1 inexact match }
  if System.Char.IsUpper(FirstLetterMask[1]) then
    FirstLetterMask[1] := System.Char.ToLower(FirstLetterMask[1])
  else if System.Char.IsLower(FirstLetterMask[1]) then
    FirstLetterMask[1] := System.Char.ToUpper(FirstLetterMask[1])
  else
    Exit;
  FileArray := System.IO.Directory.GetFileSystemEntries(FullPath, FirstLetterMask);
  for I := 0 to Length(FileArray) - 1 do
  begin
    if WideSameText(Name, FileArray[I]) then // inexact match on filename
    begin
       Inc(NFound);
       if MatchIndex < 0 then
         MatchIndex := I; // remember the first match
    end;
  end;
  if NFound > 0 then // found one or more inexact matches
  begin
    if MatchFound <> mkSingleMatch then
      Result := FullPath + FileArray[MatchIndex];
    if NFound > 1 then
      MatchFound := mkAmbiguous
    else
      MatchFound := mkSingleMatch;
  end;
end;                                      

function GetUniversalName(const FileName: string): string;
var
  Buffer: IntPtr;
  BufSize: DWORD;
begin
  Result := FileName;
  BufSize := 1024;
  Buffer := Marshal.AllocHGlobal(BufSize);
  try
    if WNetGetUniversalName(FileName, UNIVERSAL_NAME_INFO_LEVEL,
      Buffer, BufSize) <> NO_ERROR then Exit;

    Result := TUniversalNameInfo(Marshal.PtrToStructure(Buffer,
      TypeOf(TUniversalNameInfo))).lpUniversalName;
  finally
    Marshal.FreeHGlobal(Buffer);
  end;
end;

function ExpandUNCFileName(const FileName: string): string;
begin
  { First get the local resource version of the file name }
  Result := ExpandFileName(FileName);
  if (Length(Result) >= 3) and (Result[2] = ':') and (Upcase(Result[1]) >= 'A')
    and (Upcase(Result[1]) <= 'Z') then
    Result := GetUniversalName(Result);
end;

function ExtractRelativePath(const BaseName, DestName: string): string;
var
  BasePath, DestPath: string;
  BasePos, DelimPos, MatchPos: Integer;
  LenBase, LenDest: Integer;

  function ExtractFilePathNoDrive(const FileName: string): string;
  begin
    Result := ExtractFilePath(FileName);
    Delete(Result, 1, Length(ExtractFileDrive(FileName)));
  end;

begin
  if SameFilename(ExtractFileDrive(BaseName), ExtractFileDrive(DestName)) then
  begin
    BasePath := ExtractFilePathNoDrive(BaseName);
    DestPath := ExtractFilePathNoDrive(DestName);

    LenBase := Length(BasePath);
    LenDest := Length(DestPath);

    BasePos := 0;
    while BasePos < LenBase - 1 do
    begin
      DelimPos := PosEx(PathDelim, BasePath, BasePos + 2) - 1;
      if (DelimPos > BasePos) and (DelimPos < LenDest) then
        if System.String.Compare(BasePath, BasePos, DestPath, BasePos, DelimPos - BasePos + 1, True) = 0 then
          BasePos := DelimPos
        else
          Break
      else
        Break;
    end;
    { up to BasePos matches }
    MatchPos := BasePos;
    Result := '';
    while BasePos < LenBase - 1 do
    begin
      DelimPos := PosEx(PathDelim, BasePath, BasePos + 2) - 1;
      if DelimPos > BasePos then
      begin
        Result := Result + '..' + PathDelim;   { Do not localize }
        BasePos := DelimPos;
      end
      else
        Break;
    end;
    if MatchPos < LenDest - 1 then
      Result := Result + Copy(DestPath, MatchPos + 2);
    Result := Result + ExtractFileName(DestName);
  end
  else
    Result := DestName;
end;

function ExtractShortPathName(const FileName: string): string;
var
  SB: System.Text.StringBuilder;
begin
  SB := System.Text.StringBuilder.Create(MAX_PATH);
  GetShortPathName(FileName, SB, SB.Capacity);
  Result := SB.ToString;
end;

function FileSearch(const Name, DirList: string): string;
var
  I, P, L: Integer;
  C: Char;
begin
  Result := Name;
  P := 1;
  L := Length(DirList);
  while True do
  begin
    if FileExists(Result) then Exit;
    while (P <= L) and (DirList[P] = PathSep) do Inc(P);
    if P > L then Break;
    I := P;
    while (P <= L) and (DirList[P] <> PathSep) do
    begin
      Inc(P);
    end;
    Result := Copy(DirList, I, P - I);
    C := Result[Length(Result)];
    if (C <> DriveDelim) and (C <> PathDelim) then
      Result := Result + PathDelim;
    Result := Result + Name;
  end;
  Result := '';
end;

function DirectoryExists(const Directory: string): Boolean;
begin
  Result := System.IO.Directory.Exists(Directory);
end;

function ForceDirectories(Dir: string): Boolean;
var
  LInfo: System.IO.DirectoryInfo;
begin
  LInfo := System.IO.Directory.CreateDirectory(Dir);
  Result := (LInfo <> nil) and LInfo.Exists;
end;

function GetCurrentDir: string;
begin
  Result := System.IO.Directory.GetCurrentDirectory;
end;

function SetCurrentDir(const Dir: string): Boolean;
begin
  Result := System.IO.Directory.Exists(Dir);
  if Result then
    System.IO.Directory.SetCurrentDirectory(Dir);
end;

function CreateDir(const Dir: string): Boolean;
var
  LInfo: System.IO.DirectoryInfo;
begin
  LInfo := System.IO.Directory.GetParent(Dir);
  Result := (LInfo <> nil) and LInfo.Exists;
  if Result then
  begin
    LInfo := System.IO.Directory.CreateDirectory(Dir);
    Result := (LInfo <> nil) and LInfo.Exists;
  end;
end;

function RemoveDir(const Dir: string; Recursive: Boolean): Boolean;
begin
  Result := System.IO.Directory.Exists(Dir);
  if Result then
  begin
    System.IO.Directory.Delete(Dir, Recursive);
    Result := not System.IO.Directory.Exists(Dir);
  end;
end;

function IsPathDelimiter(const S: string; Index: Integer): Boolean;
begin
  Result := (Index > 0) and (Index <= Length(S)) and (S[Index] = PathDelim);
end;

function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;
begin
  Result := False;
  if (Index <= 0) or (Index > Length(S)) then exit;
  Result := Pos(S[Index], Delimiters) >= 1;
end;

function IncludeTrailingBackslash(const S: string): string;
begin
  Result := IncludeTrailingPathDelimiter(S);
end;

function IncludeTrailingPathDelimiter(const S: string): string;
begin
  Result := S;
  if not IsPathDelimiter(Result, Length(Result)) then
    Result := Result + PathDelim;
end;

function ExcludeTrailingBackslash(const S: string): string;
begin
  Result := ExcludeTrailingPathDelimiter(S);
end;

function ExcludeTrailingPathDelimiter(const S: string): string;
begin
  Result := S;
  if IsPathDelimiter(Result, Length(Result)) then
    SetLength(Result, Length(Result)-1);
end;

function LastDelimiter(const Delimiters, S: string): Integer;
begin
  if S <> nil then
    Result := System.String(S).LastIndexOfAny(CharArrayOf(Delimiters)) + 1
  else
    Result := 0;
end;

function AnsiCompareFileName(const S1, S2: AnsiString): Integer;
begin
  Result := AnsiCompareStr(AnsiLowerCaseFileName(S1), AnsiLowerCaseFileName(S2));
end;

function AnsiCompareFileName(const S1, S2: WideString): Integer; deprecated;
begin
  Result := WideCompareStr(AnsiLowerCaseFileName(S1), AnsiLowerCaseFileName(S2));
end;

function SameFileName(const S1, S2: string): Boolean;
begin
  Result := AnsiCompareFileName(S1, S2) = 0;
end;

function AnsiLowerCaseFileName(const S: AnsiString): AnsiString;
begin
                           
  // Special processing needed for FarEast locales
  Result := AnsiLowerCase(S);
end;

function AnsiLowerCaseFileName(const S: WideString): WideString; deprecated;
begin
                           
  // Special processing needed for FarEast locales
  Result := WideLowerCase(S);
end;

function AnsiUpperCaseFileName(const S: AnsiString): AnsiString;
begin
                           
  // Special processing needed for FarEast locales
  Result := AnsiUpperCase(S);
end;

function AnsiUpperCaseFileName(const S: WideString): WideString; deprecated;
begin
                           
  // Special processing needed for FarEast locales
  Result := WideUpperCase(S);
end;

                                    
function AdjustCommaInFormat(const Format: string): string;
var
  I, Removed: Integer;
  C: Char;
  FoundComma, CommaInResult, BeforeDecimal, Scientific: Boolean;
begin
  Result := Format;
  Scientific := False;
  FoundComma := False;
  CommaInResult := False;
  BeforeDecimal := True;
  Removed := 0;
  I := 1;
  while I <= Length(Format) do
  begin
    C := Format[I];
    case C of
      '.':
        BeforeDecimal := False;
      '''', '"':
        repeat
          Inc(I);
        until (I > Length(Format)) or (Format[I] <> C);
      'e', 'E':
        Scientific := True;
      ',':
        begin
          FoundComma := True;
          if (not BeforeDecimal) or (CommaInResult) or
              (I = 1) or
              ((Format[I - 1] <> '0') and (Format[I - 1] <> '#')) or
              (I = Length(Format)) or
              ((Format[I + 1] <> '0') and (Format[I + 1] <> '#')) then
          begin
            Delete(Result, I - Removed, 1);
            Removed := Removed + 1;
          end
          else
            CommaInResult := True; // this one is ok
        end;
      '%':
        begin
          Insert('\', Result, I);
          Inc(I);
        end;
    end;
    Inc(I);
  end;
  if FoundComma and (not CommaInResult) and (not Scientific) then
    if (Result[1] = '0') or (Result[1] = '#') then
      Result := '#,' + Result
    else
      Result := '#,#' + Result;
end;

function FormatFloat(const Format: string; Value: Extended): string;
var
  LFormat: NumberFormatInfo;
begin
  LFormat := NumberFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.Clone);
  with LFormat do
  begin
    CurrencyDecimalSeparator := DecimalSeparator;
    CurrencyGroupSeparator := ThousandSeparator;
    NumberDecimalSeparator := DecimalSeparator;
    NumberGroupSeparator := ThousandSeparator;
  end;
  Result := FormatFloat(Format, Value, LFormat);
end;

function FormatFloat(const Format: string; Value: Extended;
  const FormatSettings: TFormatSettings): string;
var
  LFormat: NumberFormatInfo;
begin
  LFormat := NumberFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.Clone);
  with LFormat, FormatSettings do
  begin
    CurrencyDecimalSeparator := DecimalSeparator;
    CurrencyGroupSeparator := ThousandSeparator;
    NumberDecimalSeparator := DecimalSeparator;
    NumberGroupSeparator := ThousandSeparator;
  end;
  Result := FormatFloat(Format, Value, LFormat);
end;

function FormatFloat(const Format: string; Value: Extended;
  Provider: IFormatProvider): string;
begin
  { AdjustCommaInFormat removes any commas in the format string that would be
    interpreted as scaling flags and adds a comma if this takes them all away }
  Result := System.Double(Value).ToString(AdjustCommaInFormat(Format), Provider);
end;

function FormatCurr(const Format: string; Value: Currency): string;
var
  LFormat: NumberFormatInfo;
begin
  LFormat := NumberFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.Clone);
  with LFormat do
  begin
    CurrencyDecimalSeparator := DecimalSeparator;
    CurrencyGroupSeparator := ThousandSeparator;
    NumberDecimalSeparator := DecimalSeparator;
    NumberGroupSeparator := ThousandSeparator;
  end;
  Result := FormatCurr(Format, Value, LFormat);
end;

function FormatCurr(const Format: string; Value: Currency;
  const FormatSettings: TFormatSettings): string;
var
  LFormat: NumberFormatInfo;
begin
  LFormat := NumberFormatInfo(System.Threading.Thread.CurrentThread.CurrentCulture.NumberFormat.Clone);
  with LFormat, FormatSettings do
  begin
    CurrencyDecimalSeparator := DecimalSeparator;
    CurrencyGroupSeparator := ThousandSeparator;
    NumberDecimalSeparator := DecimalSeparator;
    NumberGroupSeparator := ThousandSeparator;
  end;
  Result := FormatCurr(Format, Value, LFormat);
end;

function FormatCurr(const Format: string; Value: Currency;
  Provider: IFormatProvider): string; overload;
begin
  { AdjustCommaInFormat removes any commas in the format string that would be
    interpreted as scaling flags and adds a comma if this takes them all away }
  Result := Value.ToString(AdjustCommaInFormat(Format), Provider);
end;

{ Raise abort exception }

procedure Abort;
begin
                                     
  raise EAbort.Create(SOperationAborted);
end;

{ Exception class }

function ExceptionHelper.GetHelpContext: Integer;
begin
  Result := StrToIntDef(HelpLink, 0);
end;

procedure ExceptionHelper.SetHelpContext(AHelpContext: Integer);
begin
  HelpLink := IntToStr(AHelpContext);
end;

class function ExceptionHelper.CreateMsg(const Msg: string): Exception;
var
  LArgTypes: array of System.Type;
  LArgs: array of System.Object;
  LConstructor: System.Reflection.ConstructorInfo;
begin
  SetLength(LArgTypes, 1);
  LArgTypes[0] := TypeOf(System.String);
  LConstructor := ClassInfo.GetConstructor(LArgTypes);
  if LConstructor <> nil then
  begin
    SetLength(LArgs, 1);
    LArgs[0] := Msg;
    Result := Exception(LConstructor.Invoke(LArgs));
  end
  else
    /// This failsafe is here just in case we could not find the correct class
    Result := Self.Create(Msg);
end;

class function ExceptionHelper.CreateFmt(const Msg: string; const Args: array of const): Exception;
begin
  Result := CreateMsg(Format(Msg, Args));
end;

class function ExceptionHelper.CreateHelp(const Msg: string; AHelpContext: Integer): Exception;
begin
  Result := CreateMsg(Msg);
  Result.HelpContext := AHelpContext;
end;

class function ExceptionHelper.CreateFmtHelp(const Msg: string; const Args: array of const;
  AHelpContext: Integer): Exception;
begin
  Result := CreateMsg(Format(Msg, Args));
  Result.HelpContext := AHelpContext;
end;

function ExceptionHelper.HResult: Integer;
var
  LPropInfo: PropertyInfo;
begin
  // We are violating the spirit of OOP here but there isn't any other way
  LPropInfo := ClassInfo.GetProperty('HResult', BindingFlags.Instance or BindingFlags.NonPublic);
  if LPropInfo = nil then
    Result := -1
  else
    Result := Convert.ToInt32(LPropInfo.GetValue(Self, nil));
end;

procedure Beep;
begin
  Windows.MessageBeep(MB_OK);
end;

procedure InitPlatformId;
var
  OSVersionInfo: TOSVersionInfo;
begin
  OSVersionInfo.dwOSVersionInfoSize := Marshal.SizeOf(TypeOf(OSVersionInfo));
  if GetVersionEx(OSVersionInfo) then
    with OSVersionInfo do
    begin
      Win32Platform := dwPlatformId;
      Win32MajorVersion := dwMajorVersion;
      Win32MinorVersion := dwMinorVersion;
      Win32BuildNumber := dwBuildNumber;
      Win32CSDVersion := szCSDVersion;
    end;
end;

function CheckOSVersion(AMajor: Integer; AMinor: Integer = 0): Boolean;
begin
  Result := (Win32MajorVersion > AMajor) or
            ((Win32MajorVersion = AMajor) and
             (Win32MinorVersion >= AMinor));
end;

function CheckWin32Version(AMajor: Integer; AMinor: Integer = 0): Boolean;
begin
  Result := CheckOSVersion(AMajor, AMinor);
end;

function GetFileVersion(const AFileName: string): Cardinal;
var
  InfoSize, Wnd: DWORD;
  VerBuf: TBytes;
  FI: TVSFixedFileInfo;
  VerSize: DWORD;
  PFI: IntPtr;
begin
  Result := Cardinal(-1);
  InfoSize := GetFileVersionInfoSize(AFileName, Wnd);
  if InfoSize <> 0 then
  begin
    SetLength(VerBuf, InfoSize);
    if GetFileVersionInfo(AFileName, Wnd, InfoSize, VerBuf) then
      if VerQueryValue(VerBuf, '\', PFI, VerSize) then
      begin
        FI := TVSFixedFileInfo(Marshal.PtrToStructure(PFI, TypeOf(TVSFixedFileInfo)));
        Result:= FI.dwFileVersionMS;
      end;
  end;
end;

procedure CheckThreadingModel(Model: System.Threading.ApartmentState);
begin
  if System.Threading.Thread.CurrentThread.ApartmentState <> Model then
    raise Exception.Create(Format(SThreadingModel, [Model]));
end;

procedure InitFileChars;
begin
  PathDelim  := System.IO.Path.DirectorySeparatorChar;
  DriveDelim := System.IO.Path.VolumeSeparatorChar;
  PathSep    := System.IO.Path.PathSeparator;
end;

constructor TMultiReadExclusiveWriteSynchronizer.Create;
begin
  inherited;
  FReaderWriterLock := System.Threading.ReaderWriterLock.Create;
end;

function TMultiReadExclusiveWriteSynchronizer.GetRevisionLevel: Integer;
begin
  Result := FReaderWriterLock.WriterSeqNum;
end;

procedure TMultiReadExclusiveWriteSynchronizer.BeginRead;
begin
  FReaderWriterLock.AcquireReaderLock(-1);
end;

procedure TMultiReadExclusiveWriteSynchronizer.EndRead;
begin
  FReaderWriterLock.ReleaseReaderLock;
end;

function TMultiReadExclusiveWriteSynchronizer.BeginWrite: Boolean;
begin
  FReaderWriterLock.AcquireWriterLock(-1);
  Result := FReaderWriterLock.IsWriterLockHeld;
end;

procedure TMultiReadExclusiveWriteSynchronizer.EndWrite;
begin
  FReaderWriterLock.ReleaseWriterLock;
end;

function InterlockedIncrement(var Addend: Integer): Integer;
begin
  Result := System.Threading.Interlocked.Increment(Addend);
end;

function InterlockedDecrement(var Addend: Integer): Integer;
begin
  Result := System.Threading.Interlocked.Decrement(Addend);
end;

function InterlockedExchange(var Target: Integer; Value: Integer): Integer;
begin
  Result := System.Threading.Interlocked.Exchange(Target, Value);
end;

function GetEnvironmentVariable(const Name: string): string;
begin
  Result := System.Environment.GetEnvironmentVariable(Name);
end;

function InternalGetDiskSpace(Drive: Char;
  var TotalSpace, FreeSpaceAvailable: Int64): Bool; overload;
begin
  Result := GetDiskFreeSpaceEx(Drive + ':\', FreeSpaceAvailable, TotalSpace, nil);
end;

function InternalGetDiskSpace(out TotalSpace, FreeSpaceAvailable: Int64): Bool; overload;
begin
  Result := GetDiskFreeSpaceEx(nil, FreeSpaceAvailable, TotalSpace, nil);
end;

function DiskFree(const Drive: string): Int64;
begin
  Result := DiskFree(Drive[1]);
end;

function DiskFree(Drive: Char): Int64;
var
  TotalSpace: Int64;
begin
  if not InternalGetDiskSpace(Drive, TotalSpace, Result) then
    Result := -1;
end;

function DiskFree(Drive: Byte): Int64;
var
  TotalSpace: Int64;
begin
  Result := -1;
  if Drive > 0 then
    Result := DiskFree(Char(Drive + $40))
  else if Drive = 0 then
    if not InternalGetDiskSpace(TotalSpace, Result) then
      Result := -1;
end;

function DiskSize(const Drive: string): Int64;
begin
  Result := DiskSize(Drive[1]);
end;

function DiskSize(Drive: Char): Int64;
var
  FreeSpace: Int64;
begin
  if not InternalGetDiskSpace(Drive, Result, FreeSpace) then
    Result := -1;
end;

function DiskSize(Drive: Byte): Int64;
var
  FreeSpace: Int64;
begin
  Result := -1;
  if Drive > 0 then
    Result := DiskSize(Char(Drive + $40))
  else if Drive = 0 then
    if not InternalGetDiskSpace(Result, FreeSpace) then
      Result := -1;
end;

{ Interface support routines }

function Supports(const Instance: TObject; const IID: TInterfaceRef; out Intf): Boolean;
begin
  Result := Instance is IID;
  if Result then
    Intf := Instance as IID;
end;

function Supports(const Instance: TObject; const IID: TInterfaceRef): Boolean;
begin
  Result := Instance is IID;
end;

function Supports(const AClass: TClass; const IID: TInterfaceRef): Boolean;
begin
  Result := AClass is IID;
end;

function CreateGUID(out Guid: Borland.Delphi.System.TGUID): HResult;
begin
  Guid := System.Guid.NewGuid;
  Result := 0;
end;

function StringToGUID(const S: string): Borland.Delphi.System.TGUID;
begin
  Result := System.Guid.Create(S);
end;

function GUIDToString(const GUID: Borland.Delphi.System.TGUID): string;
begin
  Result := GUID.ToString;
end;

function IsEqualGUID(const guid1, guid2: Borland.Delphi.System.TGUID): Boolean;
begin
   Result := guid1.Equals(guid2);
end;

{ TLanguages }

function GetLocaleData(ID: LCID; Flag: DWORD): string;
var
  Buffer: StringBuilder;
begin
  Buffer := StringBuilder.Create(1024);
  GetLocaleInfo(ID, Flag, Buffer, Buffer.Capacity);
  Result := Buffer.ToString;
end;

{ Called for each supported locale. }
function TLanguages.LocalesCallback(LocaleID: IntPtr): Integer;
var
  AID: LCID;
  ShortLangName: string;
begin
  AID := StrToInt('$' + Copy(Marshal.PtrToStringUni(LocaleID), 5, 4));
  ShortLangName := GetLocaleData(AID, LOCALE_SABBREVLANGNAME);
  if ShortLangName <> '' then
  begin
    SetLength(FSysLangs, Length(FSysLangs) + 1);
    with FSysLangs[High(FSysLangs)] do
    begin
      FName := GetLocaleData(AID, LOCALE_SLANGUAGE);
      FLCID := AID;
      FExt := ShortLangName;
    end;
  end;
  Result := 1;
end;

constructor TLanguages.Create;
begin
  inherited Create;
  FLocalesCallbackDelegate := LocalesCallback;
  EnumSystemLocales(FLocalesCallbackDelegate, LCID_SUPPORTED);
end;

function TLanguages.GetCount: Integer;
begin
  Result := High(FSysLangs) + 1;
end;

function TLanguages.GetExt(Index: Integer): string;
begin
  Result := FSysLangs[Index].FExt;
end;

function TLanguages.GetID(Index: Integer): string;
begin
  Result := HexDisplayPrefix + IntToHex(FSysLangs[Index].FLCID, 8);
end;

function TLanguages.GetLCID(Index: Integer): LCID;
begin
  Result := FSysLangs[Index].FLCID;
end;

function TLanguages.GetName(Index: Integer): string;
begin
  Result := FSysLangs[Index].FName;
end;

function TLanguages.GetNameFromLocaleID(ID: LCID): string;
var
  Index: Integer;
begin
  Index := IndexOf(ID);
  if Index <> - 1 then Result := Name[Index];
  if Result = '' then Result := sUnknown;
end;

function TLanguages.GetNameFromLCID(const ID: string): string;
begin
  Result := NameFromLocaleID[StrToIntDef(ID, 0)];
end;

function TLanguages.IndexOf(ID: LCID): Integer;
begin
  for Result := Low(FSysLangs) to High(FSysLangs) do
    if FSysLangs[Result].FLCID = ID then Exit;
  Result := -1;
end;

var
  FLanguages: TLanguages;

function Languages: TLanguages;
begin
  if FLanguages = nil then
    FLanguages := TLanguages.Create;
  Result := FLanguages;
end;

function SafeLoadLibrary(const Filename: string; ErrorMode: UINT): HMODULE;
var
  OldMode: UINT;
begin
  OldMode := SetErrorMode(ErrorMode);
  try
    Result := LoadLibrary(Filename);
  finally
    SetErrorMode(OldMode);
  end;
end;

var
  OverrideUICulture: System.Globalization.CultureInfo = nil;

procedure InitLocaleOverride;
const
  sLocaleOverrideKey = 'Software\Borland\Locales'; // do not localize
var
  Lang: System.Object;
  FileName: string;
  Key: Microsoft.Win32.RegistryKey;
  Win32Exe: Boolean;

  function GetCultureFromThreeLetterWindowsLang(const Lang: string):
    System.Globalization.CultureInfo;
  var
    Loop: Integer;
    Cultures: array of System.Globalization.CultureInfo;
  begin
    if Lang <> '' then
    begin
      if Length(Lang) = 3 then
      begin
        Cultures := System.Globalization.CultureInfo.GetCultures(
          System.Globalization.CultureTypes.SpecificCultures);
        for Loop := Low(Cultures) to High(Cultures) do
          if System.String.Compare(Cultures[Loop].ThreeLetterWindowsLanguageName, Lang, True) = 0 then
          begin
            Result := Cultures[Loop];
            Exit;
          end;
      end
      else
      begin
        Cultures := System.Globalization.CultureInfo.GetCultures(
          System.Globalization.CultureTypes.NeutralCultures);
        for Loop := Low(Cultures) to High(Cultures) do
          if System.String.Compare(Cultures[Loop].ThreeLetterWindowsLanguageName, 0, Lang, 0, 2, True) = 0 then
          begin
            Result := Cultures[Loop];
            Exit;
          end;
      end;
    end;
    Result := nil;
  end;

begin
  if not Assigned(OverrideUICulture) then
  begin
    Key := Microsoft.Win32.Registry.CurrentUser.OpenSubKey(sLocaleOverrideKey);
    if not Assigned(Key) then
      Key := Microsoft.Win32.Registry.LocalMachine.OpenSubKey(sLocaleOverrideKey);
    if Assigned(Key) then
    begin
      Win32Exe := System.Reflection.Assembly.GetEntryAssembly = nil;
      if Win32Exe then
        FileName := System.Diagnostics.Process.GetCurrentProcess.MainModule.FileName
      else
        FileName := System.Reflection.Assembly.GetEntryAssembly.Location;
      Lang := Key.GetValue(FileName);
      if not Assigned(Lang) then
        Lang := Key.GetValue(System.String.Empty);
      if (Lang is System.String) and (string(Lang) <> '') then
      begin
        if Win32Exe then
          OverrideUICulture := GetCultureFromThreeLetterWindowsLang(string(Lang));
        if not Assigned(OverrideUICulture) then
          try
            OverrideUICulture := System.Globalization.CultureInfo.Create(string(Lang));
          except
          end;
      end;
    end;
    if not Assigned(OverrideUICulture) then
      OverrideUICulture := System.Threading.Thread.CurrentThread.CurrentUICulture
    else if not System.Threading.Thread.CurrentThread.CurrentUICulture.Equals(OverrideUICulture) then
      System.Threading.Thread.CurrentThread.CurrentUICulture := OverrideUICulture;
  end;
end;

initialization
  Borland.Delphi.System.TraditionalClassNames := True;
  Borland.Delphi.System.VCLInitLocaleOverride := InitLocaleOverride;
  InitPlatformId;
  InitFileChars;
  GetFormatSettings;
end.

