
{*******************************************************}
{                                                       }
{       Delphi Runtime Library                          }
{       System Utilities Unit                           }
{                                                       }
{       Copyright (C) 1995 Borland International        }
{                                                       }
{*******************************************************}

unit SysUtils;

{$N+,P+,S-,G+}


{$C MOVEABLE PRELOAD PERMANENT}

interface

const

{ File open modes }

  fmOpenRead       = $0000;
  fmOpenWrite      = $0001;
  fmOpenReadWrite  = $0002;
  fmShareCompat    = $0000;
  fmShareExclusive = $0010;
  fmShareDenyWrite = $0020;
  fmShareDenyRead  = $0030;
  fmShareDenyNone  = $0040;

{ File attribute constants }

  faReadOnly  = $01;
  faHidden    = $02;
  faSysFile   = $04;
  faVolumeID  = $08;
  faDirectory = $10;
  faArchive   = $20;
  faAnyFile   = $3F;

{ File mode magic numbers }

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

{ Seconds and milliseconds per day }

  SecsPerDay = 24 * 60 * 60;
  MSecsPerDay = SecsPerDay * 1000;

type

{ Type conversion records }

  WordRec = record
    Lo, Hi: Byte;
  end;

  LongRec = record
    Lo, Hi: Word;
  end;

  PtrRec = record
    Ofs, Seg: Word;
  end;

  TMethod = record
    Code, Data: Pointer;
  end;

{ General arrays }

  PByteArray = ^TByteArray;
  TByteArray = array[0..32767] of Byte;

  PWordArray = ^TWordArray;
  TWordArray = array[0..16383] of Word;

{ Generic procedure pointer }

  TProcedure = procedure;

{ Generic filename type }

  TFileName = string[79];

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

  TSearchRec = record
    Fill: array[1..21] of Byte;
    Attr: Byte;
    Time: Longint;
    Size: Longint;
    Name: string[12];
  end;

{ Typed-file and untyped-file record }

  TFileRec = record
    Handle: Word;
    Mode: Word;
    RecSize: Word;
    Private: array[1..26] of Byte;
    UserData: array[1..16] of Byte;
    Name: array[0..79] of Char;
  end;

{ Text file record structure used for Text files }

  PTextBuf = ^TTextBuf;
  TTextBuf = array[0..127] of Char;
  TTextRec = record
    Handle: Word;
    Mode: Word;
    BufSize: Word;
    Private: Word;
    BufPos: Word;
    BufEnd: Word;
    BufPtr: PTextBuf;
    OpenFunc: Pointer;
    InOutFunc: Pointer;
    FlushFunc: Pointer;
    CloseFunc: Pointer;
    UserData: array[1..16] of Byte;
    Name: array[0..79] of Char;
    Buffer: TTextBuf;
  end;

{ FloatToText format codes }

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

{ FloatToDecimal result record }

  TFloatRec = record
    Exponent: Integer;
    Negative: Boolean;
    Digits: array[0..18] of Char;
  end;

{ Exceptions }

  Exception = class(TObject)
  private
    FMessage: PString;
    FHelpContext: Longint;
    function GetMessage: string;
    procedure SetMessage(const Value: string);
  public
    constructor Create(const Msg: string);
    constructor CreateFmt(const Msg: string; const Args: array of const);
    constructor CreateRes(Ident: Word);
    constructor CreateResFmt(Ident: Word; const Args: array of const);
    constructor CreateHelp(const Msg: string; AHelpContext: Longint);
    constructor CreateFmtHelp(const Msg: string; const Args: array of const;
      AHelpContext: Longint);
    constructor CreateResHelp(Ident: Word; AHelpContext: Longint);
    constructor CreateResFmtHelp(Ident: Word; const Args: array of const;
      AHelpContext: Longint);
    destructor Destroy; override;
    property HelpContext: Longint read FHelpContext write FHelpContext;
    property Message: string read GetMessage write SetMessage;
    property MessagePtr: PString read FMessage;
  end;

  ExceptClass = class of Exception;

  EAbort = class(Exception);

  EOutOfMemory = class(Exception)
  public
    destructor Destroy; override;
    procedure FreeInstance; override;
  end;

  EInOutError = class(Exception)
  public
    ErrorCode: Integer;
  end;

  EIntError = class(Exception);
  EDivByZero = class(EIntError);
  ERangeError = class(EIntError);
  EIntOverflow = class(EIntError);

  EMathError = class(Exception);
  EInvalidOp = class(EMathError);
  EZeroDivide = class(EMathError);
  EOverflow = class(EMathError);
  EUnderflow = class(EMathError);

  EInvalidPointer = class(Exception);

  EInvalidCast = class(Exception);

  EConvertError = class(Exception);

  EProcessorException = class(Exception);
  EFault = class(EProcessorException);
  EGPFault = class(EFault);
  EStackFault = class(EFault);
  EPageFault = class(EFault);
  EInvalidOpCode = class(EFault);
  EBreakpoint = class(EProcessorException);
  ESingleStep = class(EProcessorException);

{ Fault handler response }

  TFaultResponse = (frKill, frResume, frChain);

{ Fault handler function type }

  TFaultHandler = function(FaultID: Word;
    FaultAddress: Pointer): TFaultResponse;

{ Processor exception hook }

const
  ProcessorExceptHook: TFaultHandler = nil;
  HandleDebugInts: Boolean = False;

{ Null string pointer }

const
  EmptyStr: string[1] = '';
  NullStr: PString = @EmptyStr;

{ Currency and date/time formatting options }

{ CurrencyString - Defines the currency symbol used in floating-point to
  decimal conversions. The initial value is fetched from the sCurrency
  variable in the [intl] section of WIN.INI.

  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 the iCurrency variable in the [intl]
  section of WIN.INI.

  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 $'
    1 = '-$1'           5 = '-1$'           9 = '-$ 1'
    2 = '$-1'           6 = '1-$'          10 = '$ 1-'
    3 = '$1-'           7 = '1$-'

  The initial value is fetched from the iNegCurr variable in the [intl]
  section of WIN.INI.

  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 the sThousand variable in the [intl] section
  of WIN.INI.

  DecimalSeparator - The character used to separate the integer part from
  the fractional part of a number. The initial value is fetched from the
  sDecimal variable in the [intl] section of WIN.INI.

  CurrencyDecimals - The number of digits to the right of the decimal point
  in a currency amount. The initial value is fetched from the sCurrDigits
  variable in the [intl] section of WIN.INI.

  DateSeparator - The character used to separate the year, month, and day
  parts of a date value. The initial value is fetched from the sDate
  variable in the [intl] section of WIN.INI.

  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 the sShortDate variable in the [intl]
  section of WIN.INI.

  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 the sLongDate
  variable in the [intl] section of WIN.INI.

  TimeSeparator - The character used to separate the hour, minute, and
  second parts of a time value. The initial value is fetched from the sTime
  variable in the [intl] section of WIN.INI.

  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 the s1159
  variable in the [intl] section of WIN.INI.

  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 the s2359
  variable in the [intl] section of WIN.INI.

  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 the iTime and iTLZero variables in the [intl] section of WIN.INI.

  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 the iTime and iTLZero variables in the [intl] section of WIN.INI.

  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.

  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.

  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.

  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. }

var
  CurrencyString: string[7];
  CurrencyFormat: Byte;
  NegCurrFormat: Byte;
  ThousandSeparator: Char;
  DecimalSeparator: Char;
  CurrencyDecimals: Byte;
  DateSeparator: Char;
  ShortDateFormat: string[15];
  LongDateFormat: string[31];
  TimeSeparator: Char;
  TimeAMString: string[7];
  TimePMString: string[7];
  ShortTimeFormat: string[15];
  LongTimeFormat: string[31];
  ShortMonthNames: array[1..12] of string[7];
  LongMonthNames: array[1..12] of string[15];
  ShortDayNames: array[1..7] of string[7];
  LongDayNames: array[1..7] of string[15];

{ Memory management routines }

{ AllocMem allocates a block of the given size on the heap. Each byte in
  the allocated buffer is set to zero. To dispose the buffer, use the
  FreeMem standard procedure. }

function AllocMem(Size: Cardinal): Pointer;

{ ReAllocMem re-allocates a block. On entry, P points to an existing heap
  block, CurSize gives the current size of the heap block, and NewSize
  specifies the requested new size of the block. If CurSize is less than
  NewSize, the additional bytes in the new buffer are set to zero. The
  returned value is a pointer to the new block; this value is always
  different from the original pointer. }

function ReAllocMem(P: Pointer; CurSize, NewSize: Cardinal): Pointer;

{ Exit procedure handling }

{ AddExitProc adds the given procedure to the run-time library's exit
  procedure list. When an application terminates, its exit procedures are
  executed in reverse order of definition, i.e. the last procedure passed
  to AddExitProc is the first one to get executed upon termination. }

procedure AddExitProc(Proc: TProcedure);

{ CallExitProcs executes all installed exit procedures. The exit procedures
  are executed in reversed order of definition, i.e. the last one installed
  is the first one to get executed. As the procedures are executed, they
  are removed from the exit procedure chain. Thus, following a call to
  CallExitProcs, the ExitProc variable (defined in the System unit) will
  be NIL. }

procedure CallExitProcs;

{ String handling routines }

{ NewStr allocates a copy of the given string on the heap. The size of the
  allocated heap block is Length(S) + 1. If the string is empty, NewStr
  returns NullStr and doesn't allocate any heap space. To dispose the
  string, use DisposeStr. }

function NewStr(const S: String): PString;

{ DisposeStr disposes a string pointer that was previously allocated using
  NewStr. If the given pointer is NIL or points to an empty string,
  StrDispose does nothing. }

procedure DisposeStr(P: PString);

{ AssignStr assigns a new dynamically allocated string to the given string
  pointer. AssignStr corresponds to the statement "DisposeStr(P)" followed
  by the statement "P := NewStr(S)". Note that P must be NIL or contain a
  valid string pointer before calling AssignStr. In other words, AssignStr
  cannot be used to initialize a string pointer variable. }

procedure AssignStr(var P: PString; const S: string);

{ AppendStr appends S to the end of Dest. AppendStr corresponds to the
  statement "Dest := Dest + S", but is more efficient. }

procedure AppendStr(var Dest: string; const S: string);

{ UpperCase converts all ASCII characters in the given string to upper case.
  The conversion affects only 7-bit ASCII characters between 'a' and 'z'. To
  convert 8-bit international characters, use AnsiUpperCase. }

function UpperCase(const S: string): string;

{ UpperCase converts all ASCII characters in the given string to lower case.
  The conversion affects only 7-bit ASCII characters between 'A' and 'Z'. To
  convert 8-bit international characters, use AnsiLowerCase. }

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 8-bit ordinal value of each character
  and is not affected by the currently installed language driver. }

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

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

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

{ AnsiUpperCase converts all characters in the given string to upper case.
  The conversion uses the currently installed language driver. }

function AnsiUpperCase(const S: string): string;

{ AnsiLowerCase converts all characters in the given string to lower case.
  The conversion uses the currently installed language driver. }

function AnsiLowerCase(const S: string): string;

{ AnsiCompareStr compares S1 to S2, with case-sensitivity. The compare
  operation is controlled by the currently installed language driver. The
  return value is the same as for CompareStr. }

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

{ AnsiCompareText compares S1 to S2, without case-sensitivity. The compare
  operation is controlled by the currently installed language driver. The
  return value is the same as for CompareStr. }

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

{ 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): Boolean;

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

function IntToStr(Value: Longint): string;

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

function IntToHex(Value: Longint; Digits: Integer): string;

{ 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): Longint;

{ StrToIntDef converts the given string to an integer value. If the string
  doesn't contain a valid value, the value given by Default is returned. }

function StrToIntDef(const S: string; Default: Longint): Longint;

{ LoadStr loads the string resource given by Ident from the application's
  executable file. If the string resource does not exist, an empty string
  is returned. }

function LoadStr(Ident: Word): string;

{ LoadStr loads the string resource given by Ident from the application's
  executable file, and uses it as the format string in a call to the
  Format function with the given arguments. }

function FmtLoadStr(Ident: Word; const Args: array of const): string;

{ File management routines }

{ 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. If the return value is positive,
  the function was successful and the value is the file handle of the opened
  file. If the return value is negative, an error occurred and the value is
  a negative DOS error code. }

function FileOpen(const FileName: string; Mode: Word): Integer;

{ FileCreate creates a new file by the specified name. If the return value
  is positive, the function was successful and the value is the file handle
  of the new file. If the return value is negative, an error occurred and
  the value is a negative DOS error code. }

function FileCreate(const FileName: string): Integer;

{ 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: Integer; var Buffer; Count: Longint): Longint;

{ 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: Integer; const Buffer; Count: Longint): Longint;

{ 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: Integer; Offset: Longint; Origin: Integer): Longint;

{ FileClose closes the specified file. }

procedure FileClose(Handle: Integer);

{ 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): Longint;

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

function FileExists(const FileName: string): Boolean;

{ 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 negative DOS error code; a value of -18 indicates that no files were
  found. FindFirst is typically used in conjunction 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 SearchRec: TSearchRec): Integer;

{ 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 negative DOS error code; a
  value of -18 indicates that there are no more files matching the search
  criteria. }

function FindNext(var SearchRec: TSearchRec): Integer;

{ FindClose terminates a FindFirst/FindNext sequence. FindClose does nothing
  in the 16-bit version of Windows, but is required in the 32-bit version,
  so for maximum portability every FindFirst/FindNext sequence should end
  with a call to FindClose. }

procedure FindClose(var SearchRec: TSearchRec);

{ FileGetDate returns the DOS 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: Integer): Longint;

{ FileSetDate sets the DOS date-and-time stamp of the file given by Handle
  to the value given by Age. The DateTimeToFileDate function can be used to
  convert a TDateTime value to a DOS date-and-time stamp. }

procedure FileSetDate(Handle: Integer; Age: Longint);

{ 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. If the return value is negative, an error occurred and the value is
  a negative DOS error code. }

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 a negative DOS error code. }

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

{ 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 rightmost 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;

{ 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, all in upper case characters. Embedded '.'
  and '..' directory references are removed. }

function ExpandFileName(const FileName: string): string;

{ 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
  semicolons. 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;

{ 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(Drive: Byte): Longint;

{ 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(Drive: Byte): Longint;

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

function FileDateToDateTime(FileDate: Longint): TDateTime;

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

function DateTimeToFileDate(DateTime: TDateTime): Longint;

{ PChar routines }

{ StrLen returns the number of characters in Str, not counting the null
  terminator. }

function StrLen(Str: PChar): Cardinal;

{ StrEnd returns a pointer to the null character that terminates Str. }

function StrEnd(Str: PChar): PChar;

{ StrMove copies exactly Count characters from Source to Dest and returns
  Dest. Source and Dest may overlap. }

function StrMove(Dest, Source: PChar; Count: Cardinal): PChar;

{ StrCopy copies Source to Dest and returns Dest. }

function StrCopy(Dest, Source: PChar): PChar;

{ StrECopy copies Source to Dest and returns StrEnd(Dest). }

function StrECopy(Dest, Source: PChar): PChar;

{ StrLCopy copies at most MaxLen characters from Source to Dest and
  returns Dest. }

function StrLCopy(Dest, Source: PChar; MaxLen: Cardinal): PChar;

{ StrPCopy copies the Pascal style string Source into Dest and
  returns Dest. }

function StrPCopy(Dest: PChar; const Source: String): PChar;

{ StrPLCopy copies at most MaxLen characters from the Pascal style string
  Source into Dest and returns Dest. }

function StrPLCopy(Dest: PChar; const Source: string; MaxLen: Cardinal): PChar;

{ StrCat appends a copy of Source to the end of Dest and returns Dest. }

function StrCat(Dest, Source: PChar): PChar;

{ StrLCat appends at most MaxLen - StrLen(Dest) characters from Source to
  the end of Dest, and returns Dest. }

function StrLCat(Dest, Source: PChar; MaxLen: Cardinal): PChar;

{ StrComp compares Str1 to Str2. The return value is less than 0 if
  Str1 < Str2, 0 if Str1 = Str2, or greater than 0 if Str1 > Str2. }

function StrComp(Str1, Str2: PChar): Integer;

{ StrIComp compares Str1 to Str2, without case sensitivity. The return
  value is the same as StrComp. }

function StrIComp(Str1, Str2: PChar): Integer;

{ StrLComp compares Str1 to Str2, for a maximum length of MaxLen
  characters. The return value is the same as StrComp. }

function StrLComp(Str1, Str2: PChar; MaxLen: Cardinal): Integer;

{ StrLIComp compares Str1 to Str2, for a maximum length of MaxLen
  characters, without case sensitivity. The return value is the same
  as StrComp. }

function StrLIComp(Str1, Str2: PChar; MaxLen: Cardinal): Integer;

{ StrScan returns a pointer to the first occurrence of Chr in Str. If Chr
  does not occur in Str, StrScan returns NIL. The null terminator is
  considered to be part of the string. }

function StrScan(Str: PChar; Chr: Char): PChar;

{ StrRScan returns a pointer to the last occurrence of Chr in Str. If Chr
  does not occur in Str, StrRScan returns NIL. The null terminator is
  considered to be part of the string. }

function StrRScan(Str: PChar; Chr: Char): PChar;

{ StrPos returns a pointer to the first occurrence of Str2 in Str1. If
  Str2 does not occur in Str1, StrPos returns NIL. }

function StrPos(Str1, Str2: PChar): PChar;

{ StrUpper converts Str to upper case and returns Str. }

function StrUpper(Str: PChar): PChar;

{ StrLower converts Str to lower case and returns Str. }

function StrLower(Str: PChar): PChar;

{ StrPas converts Str to a Pascal style string. }

function StrPas(Str: PChar): String;

{ StrAlloc allocates a buffer of the given size on the heap. The size of
  the allocated buffer is encoded in a two byte header that immediately
  preceeds the buffer. To dispose the buffer, use StrDispose. }

function StrAlloc(Size: Cardinal): PChar;

{ StrBufSize returns the allocated size of the given buffer, not including
  the two byte header. }

function StrBufSize(Str: PChar): Cardinal;

{ StrNew allocates a copy of Str on the heap. If Str is NIL, StrNew returns
  NIL and doesn't allocate any heap space. Otherwise, StrNew makes a
  duplicate of Str, obtaining space with a call to the StrAlloc function,
  and returns a pointer to the duplicated string. To dispose the string,
  use StrDispose. }

function StrNew(Str: PChar): PChar;

{ StrDispose disposes a string that was previously allocated with StrAlloc
  or StrNew. If Str is NIL, StrDispose does nothing. }

procedure StrDispose(Str: PChar);

{ 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.

  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 the Currency Format 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. }

function Format(const Format: string; const Args: array of const): string;

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

{ StrFmt formats the argument list given by Args using the format string
  given by Format into the buffer given by Buffer. It is up to the caller to
  ensure that Buffer is large enough for the resulting string. The returned
  value is Buffer. For further details, see the description of the Format
  function. }

function StrFmt(Buffer, Format: PChar; const Args: array of const): PChar;

{ StrFmt formats the argument list given by Args using the format string
  given by Format into the buffer given by Buffer. The resulting string will
  contain no more than MaxLen characters, not including the null terminator.
  The returned value is Buffer. For further details, see the description of
  the Format function. }

function StrLFmt(Buffer: PChar; MaxLen: Cardinal; Format: PChar;
  const Args: array of const): PChar;

{ 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; BufLen: Cardinal; const Format;
  FmtLen: Cardinal; const Args: array of const): Cardinal;

{ Floating point conversion routines }

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

{ 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,
  and the Digits parameter specifies the minimum number of digits in the
  exponent (between 0 and 4).

  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 the
  Currency Format 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 DecimalSeparator and ThousandSeparator
  global variables.

  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'. }

function FloatToStrF(Value: Extended; Format: TFloatFormat;
  Precision, Digits: Integer): string;

{ FloatToText converts the given floating-point value to its decimal
  representation using the specified format, precision, and digits. The
  resulting string of characters is stored in the given buffer, and the
  returned value is the number of characters stored. The resulting string
  is not null-terminated. For further details, see the description of the
  FloatToStrF function. }

function FloatToText(Buffer: PChar; Value: Extended; Format: TFloatFormat;
  Precision, Digits: Integer): Integer;

{ 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. The default value
        of DecimalSeparator is specified in the Number Format of the
        International section in the Windows Control Panel.

  ,     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. The
        default value of ThousandSeparator is specified in the Number Format
        of the International section in the Windows Control Panel.

  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;

{ FloatToTextFmt converts the given floating-point value to its decimal
  representation using the specified format. The resulting string of
  characters is stored in the given buffer, and the returned value is the
  number of characters stored. The resulting string is not null-terminated.
  For further details, see the description of the FormatFloat function. }

function FloatToTextFmt(Buffer: PChar; Value: Extended;
  Format: PChar): Integer;

{ 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. Thousand separators and currency symbols are not
  allowed in the string. If the string doesn't contain a valid value, an
  EConvertError exception is raised. }

function StrToFloat(const S: string): Extended;

{ TextToFloat converts the null-terminated string given by Buffer to a
  floating-point value which is returned in the variable given by Value. The
  return value is True if the conversion was successful, or False if the
  string is not a valid floating-point value. For further details, see the
  description of the StrToFloat function. }

function TextToFloat(Buffer: PChar; var Value: Extended): Boolean;

{ FloatToDecimal converts a floating-point value to a decimal representation
  that is suited for further formatting. The Precision parameter specifies
  the requested number of significant digits in the result--the allowed
  range is 1..18. The Decimals parameter specifies the requested maximum
  number of digits to the left of the decimal point in the result. Precision
  and Decimals together control how the result is rounded. To produce a
  result that always has a given number of significant digits regardless of
  the magnitude of the number, specify 9999 for the Decimals parameter. The
  result of the conversion is stored in the specified TFloatRec record as
  follows:

  Exponent - Contains the magnitude of the number, i.e. the number of
  significant digits to the right of the decimal point. The Exponent field
  is negative if the absolute value of the number is less than one. If the
  number is a NAN (not-a-number), Exponent is set to -32768. If the number
  is INF or -INF (positive or negative infinity), Exponent is set to 32767.

  Negative - True if the number is negative, False if the number is zero
  or positive.

  Digits - Contains up to 18 significant digits followed by a null
  terminator. The implied decimal point (if any) is not stored in Digits.
  Trailing zeros are removed, and if the resulting number is zero, NAN, or
  INF, Digits contains nothing but the null terminator. }

procedure FloatToDecimal(var Result: TFloatRec; Value: Extended;
  Precision, Decimals: Integer);

{ Date/time support routines }

{ 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 one plus the
  number of days between 1/1/0001 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;

{ 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(Date: TDateTime; var Year, Month, Day: Word);

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

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

{ 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. }

function DayOfWeek(Date: TDateTime): Integer;

{ Date returns the current date. }

function Date: TDateTime;

{ Time returns the current time. }

function Time: TDateTime;

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

function Now: TDateTime;

{ 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(Date: TDateTime): string;

{ 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(Time: TDateTime): string;

{ 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(DateTime: TDateTime): string;

{ 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 mean 1900 to 1999. If the given string
  does not contain a valid date, an EConvertError exception is raised. }

function StrToDate(const S: string): TDateTime;

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

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

{ 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.

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

  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. The am/pm specifier can use lower, upper, or mixed
          case, and the result is displayed accordingly.

  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. 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; DateTime: TDateTime): string;

{ 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;
  DateTime: TDateTime);


{ Initialization file support }

function GetProfileStr(Section, Entry: PChar; const Default: string): string;
function GetProfileChar(Section, Entry: PChar; Default: Char): Char;


procedure GetFormatSettings;

{ Exception handling routines }

function ExceptObject: TObject;
function ExceptAddr: Pointer;

procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer);

procedure Abort;

procedure OutOfMemoryError;


procedure DefaultExceptHandler(FaultID: Word; ErrorAddr: Pointer);
procedure EnableExceptionHandler(Enable: Boolean);


implementation

{$R SYSUTILS.RES}

uses WinTypes, WinProcs, ToolHelp;

{$I SYSUTILS.INC}

{ Utility routines }

function LongMul(I, J: Word): Longint; assembler;
asm
        MOV     AX,I
        MUL     J
end;

procedure DivMod(Dividend: Longint; Divisor: Word;
  var Result, Remainder: Word); assembler;
asm
        MOV     AX,Dividend.Word[0]
        MOV     DX,Dividend.Word[2]
        DIV     Divisor
        LES     DI,Result
        MOV     ES:[DI],AX
        LES     DI,Remainder
        MOV     ES:[DI],DX
end;

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

{ Memory management routines }

function AllocMem(Size: Cardinal): Pointer;
begin
  GetMem(Result, Size);
  FillChar(Result^, Size, 0);
end;

function ReAllocMem(P: Pointer; CurSize, NewSize: Cardinal): Pointer;
begin
  Result := nil;
  if NewSize <> 0 then
  begin
    GetMem(Result, NewSize);
    if NewSize > CurSize then
    begin
      FillChar(PChar(Result)[CurSize], NewSize - CurSize, 0);
      NewSize := CurSize;
    end;
    if NewSize <> 0 then Move(P^, Result^, NewSize);
  end;
  if CurSize <> 0 then FreeMem(P, CurSize);
end;

{ Exit procedure handling }

type
  PExitProcInfo = ^TExitProcInfo;
  TExitProcInfo = record
    Next: PExitProcInfo;
    SaveExit: Pointer;
    Proc: TProcedure;
  end;

const
  ExitProcList: PExitProcInfo = nil;

procedure DoExitProc; far;
var
  P: PExitProcInfo;
  Proc: TProcedure;
begin
  P := ExitProcList;
  ExitProcList := P^.Next;
  ExitProc := P^.SaveExit;
  Proc := P^.Proc;
  Dispose(P);
  Proc;
end;

procedure AddExitProc(Proc: TProcedure);
var
  P: PExitProcInfo;
begin
  New(P);
  P^.Next := ExitProcList;
  P^.SaveExit := ExitProc;
  P^.Proc := Proc;
  ExitProcList := P;
  ExitProc := @DoExitProc;
end;

procedure CallExitProcs;
var
  Proc: TProcedure;
begin
  while ExitProc <> nil do
  begin
    @Proc := ExitProc;
    ExitProc := nil;
    InOutRes := 0;
    Proc;
  end;
end;

{ String handling routines }

function NewStr(const S: String): PString;
begin
  if S = '' then Result := NullStr else
  begin
    GetMem(Result, Length(S) + 1);
    Result^ := S;
  end;
end;

procedure DisposeStr(P: PString);
begin
  if (P <> nil) and (P^ <> '') then FreeMem(P, Length(P^) + 1);
end;

procedure AssignStr(var P: PString; const S: string);
var
  Temp: PString;
begin
  Temp := P;
  P := NewStr(S);
  DisposeStr(Temp);
end;

procedure AppendStr(var Dest: string; const S: string); assembler;
asm
        LES     DI,Dest
        MOV     BL,ES:[DI]
        XOR     BH,BH
        MOV     CX,Dest.Word[-2]
        SUB     CX,BX
        JBE     @@2
        PUSH    DS
        LDS     SI,S
        CLD
        LODSB
        XOR     AH,AH
        CMP     CX,AX
        JB      @@1
        MOV     CX,AX
@@1:    ADD     ES:[DI],CL
        LEA     DI,[DI+BX+1]
        REP     MOVSB
        POP     DS
@@2:
end;

function UpperCase(const S: string): string; assembler;
asm
        PUSH    DS
        LDS     SI,S
        LES     DI,Result
        CLD
        LODSB
        STOSB
        MOV     CL,AL
        XOR     CH,CH
        JCXZ    @@3
@@1:    LODSB
        CMP     AL,'a'
        JB      @@2
        CMP     AL,'z'
        JA      @@2
        SUB     AL,20H
@@2:    STOSB
        LOOP    @@1
@@3:    POP     DS
end;

function LowerCase(const S: string): string; assembler;
asm
        PUSH    DS
        LDS     SI,S
        LES     DI,Result
        CLD
        LODSB
        STOSB
        MOV     CL,AL
        XOR     CH,CH
        JCXZ    @@3
@@1:    LODSB
        CMP     AL,'A'
        JB      @@2
        CMP     AL,'Z'
        JA      @@2
        ADD     AL,20H
@@2:    STOSB
        LOOP    @@1
@@3:    POP     DS
end;

function CompareStr(const S1, S2: string): Integer; assembler;
asm
        PUSH    DS
        LDS     SI,S1
        LES     DI,S2
        LODSB
        XOR     AH,AH
        MOV     DL,ES:[DI]
        XOR     DH,DH
        INC     DI
        MOV     CL,AL
        CMP     CL,DL
        JBE     @@1
        MOV     CL,DL
@@1:    XOR     CH,CH
        REPE    CMPSB
        JE      @@2
        MOV     AL,DS:[SI-1]
        MOV     DL,ES:[DI-1]
@@2:    SUB     AX,DX
        POP     DS
end;

function CompareText(const S1, S2: string): Integer; assembler;
asm
        PUSH    DS
        LDS     SI,S1
        LES     DI,S2
        LODSB
        XOR     AH,AH
        MOV     DL,ES:[DI]
        XOR     DH,DH
        INC     DI
        MOV     CL,AL
        CMP     CL,DL
        JBE     @@1
        MOV     CL,DL
@@1:    XOR     CH,CH
@@2:    REPE    CMPSB
        JE      @@5
        MOV     BL,DS:[SI-1]
        CMP     BL,'a'
        JB      @@3
        CMP     BL,'z'
        JA      @@3
        SUB     BL,20H
@@3:    MOV     BH,ES:[DI-1]
        CMP     BH,'a'
        JB      @@4
        CMP     BH,'z'
        JA      @@4
        SUB     BH,20H
@@4:    CMP     BL,BH
        JE      @@2
        MOV     AL,BL
        MOV     DL,BH
@@5:    SUB     AX,DX
        POP     DS
end;

function AnsiUpperCase(const S: string): string;
begin
  Result := S;
  if Result <> '' then AnsiUpperBuff(@Result[1], Length(Result));
end;

function AnsiLowerCase(const S: string): string;
begin
  Result := S;
  if Result <> '' then AnsiLowerBuff(@Result[1], Length(Result));
end;

function AnsiCompareStr(const S1, S2: string): Integer;
var
  Buf1, Buf2: array[0..255] of Char;
begin
  Result := lstrcmp(StrPCopy(Buf1, S1), StrPCopy(Buf2, S2));
end;

function AnsiCompareText(const S1, S2: string): Integer;
var
  Buf1, Buf2: array[0..255] of Char;
begin
  Result := lstrcmpi(StrPCopy(Buf1, S1), StrPCopy(Buf2, S2));
end;

function IsValidIdent(const Ident: string): Boolean;
const
  Alpha = ['A'..'Z', 'a'..'z', '_'];
  AlphaNumeric = Alpha + ['0'..'9'];
var
  I: Integer;
begin
  Result := False;
  if (Ident = '') or not (Ident[1] in Alpha) then Exit;
  for I := 2 to Length(Ident) do if not (Ident[I] in AlphaNumeric) then Exit;
  Result := True;
end;

function IntToStr(Value: Longint): string;
begin
  FmtStr(Result, '%d', [Value]);
end;

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

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

function StrToIntDef(const S: string; Default: Longint): Longint;
var
  E: Integer;
begin
  Val(S, Result, E);
  if E <> 0 then Result := Default;
end;

function LoadStr(Ident: Word): string;
begin
  Result[0] := Char(LoadString(HInstance, Ident, @Result[1], 254));
end;

function FmtLoadStr(Ident: Word; const Args: array of const): string;
begin
  FmtStr(Result, LoadStr(Ident), Args);
end;

{ File management routines }

type
  TFileNameBuf = array[0..79] of Char;

procedure CopyFileName(Dest: PChar; const Source: string);
begin
  AnsiToOem(StrPLCopy(Dest, Source, SizeOf(TFileNameBuf) - 1), Dest);
end;

function FileOpen(const FileName: string; Mode: Word): Integer; assembler;
var
  FileNameBuf: TFileNameBuf;
asm
        LEA     DI,FileNameBuf
        PUSH    SS
        PUSH    DI
        PUSH    FileName.Word[2]
        PUSH    FileName.Word[0]
        CALL    CopyFileName
        PUSH    DS
        LEA     DX,FileNameBuf
        PUSH    SS
        POP     DS
        MOV     AL,Mode.Byte[0]
        MOV     AH,3DH
        INT     21H
        POP     DS
        JNC     @@1
        NEG     AX
@@1:
end;

function FileCreate(const FileName: string): Integer; assembler;
var
  FileNameBuf: TFileNameBuf;
asm
        LEA     DI,FileNameBuf
        PUSH    SS
        PUSH    DI
        PUSH    FileName.Word[2]
        PUSH    FileName.Word[0]
        CALL    CopyFileName
        PUSH    DS
        LEA     DX,FileNameBuf
        PUSH    SS
        POP     DS
        XOR     CX,CX
        MOV     AH,3CH
        INT     21H
        POP     DS
        JNC     @@1
        NEG     AX
@@1:
end;


function FileRead(Handle: Integer; var Buffer; Count: Longint): Longint;
external 'KERNEL' index 349; { _hread }

function FileWrite(Handle: Integer; const Buffer; Count: Longint): Longint;
external 'KERNEL' index 350; { _hwrite }


function FileSeek(Handle: Integer; Offset: Longint; Origin: Integer): Longint;
external 'KERNEL' index 84; { _llseek }

procedure FileClose(Handle: Integer);
external 'KERNEL' index 81; { _lclose }

function FileAge(const FileName: string): Longint; assembler;
var
  FileNameBuf: TFileNameBuf;
  FindRec: array[0..47] of Byte;
asm
        LEA     DI,FileNameBuf
        PUSH    SS
        PUSH    DI
        PUSH    FileName.Word[2]
        PUSH    FileName.Word[0]
        CALL    CopyFileName
        PUSH    DS
        PUSH    SS
        POP     DS
        LEA     DX,FindRec
        MOV     AH,1AH
        INT     21H
        LEA     DX,FileNameBuf
        XOR     CX,CX
        MOV     AH,4EH
        INT     21H
        POP     DS
        MOV     AX,FindRec.Word[22]
        MOV     DX,FindRec.Word[24]
        JNC     @@1
        MOV     AX,-1
        CWD
@@1:
end;

function FileExists(const FileName: string): Boolean;
begin
  Result := FileAge(FileName) <> -1;
end;

function FileGetDate(Handle: Integer): Longint; assembler;
asm
        MOV     AX,5700H
        MOV     BX,Handle
        INT     21H
        XCHG    AX,CX
end;

procedure FileSetDate(Handle: Integer; Age: Longint); assembler;
asm
        MOV     AX,5701H
        MOV     BX,Handle
        MOV     CX,Age.Word[0]
        MOV     DX,Age.Word[2]
        INT     21H
end;

function FileGetAttr(const FileName: string): Integer; assembler;
var
  FileNameBuf: TFileNameBuf;
asm
        LEA     DI,FileNameBuf
        PUSH    SS
        PUSH    DI
        PUSH    FileName.Word[2]
        PUSH    FileName.Word[0]
        CALL    CopyFileName
        PUSH    DS
        PUSH    SS
        POP     DS
        LEA     DX,FileNameBuf
        MOV     AX,4300H
        INT     21H
        POP     DS
        JNC     @@1
        NEG     AX
        JMP     @@2
@@1:    XCHG    AX,CX
@@2:
end;

function FileSetAttr(const FileName: string; Attr: Integer): Integer; assembler;
var
  FileNameBuf: TFileNameBuf;
asm
        LEA     DI,FileNameBuf
        PUSH    SS
        PUSH    DI
        PUSH    FileName.Word[2]
        PUSH    FileName.Word[0]
        CALL    CopyFileName
        PUSH    DS
        PUSH    SS
        POP     DS
        LEA     DX,FileNameBuf
        MOV     CX,Attr
        MOV     AX,4301H
        INT     21H
        POP     DS
        JC      @@1
        XOR     AX,AX
@@1:    NEG     AX
end;

{ Convert TSearchRec.Name from a PChar to a string }

function ConvertName(Name: Pointer): string; near;
begin
  OemToAnsi(Name, Name);
  Result := StrPas(Name);
end;

function FindFirst(const Path: string; Attr: Integer;
  var SearchRec: TSearchRec): Integer; assembler;
var
  PathBuf: TFileNameBuf;
asm
        PUSH    DS
        LDS     DX,SearchRec
        MOV     AH,1AH
        INT     21H
        POP     DS
        LEA     DI,PathBuf
        PUSH    SS
        PUSH    DI
        PUSH    Path.Word[2]
        PUSH    Path.Word[0]
        CALL    CopyFileName
        PUSH    DS
        PUSH    SS
        POP     DS
        LEA     DX,PathBuf
        MOV     CX,Attr
        MOV     AH,4EH
        INT     21H
        POP     DS
        JC      @@1
        LES     DI,SearchRec
        ADD     DI,OFFSET TSearchRec.Name
        PUSH    ES
        PUSH    DI
        PUSH    ES
        PUSH    DI
        CALL    ConvertName
        ADD     SP,4
        XOR     AX,AX
@@1:    NEG     AX
end;

function FindNext(var SearchRec: TSearchRec): Integer; assembler;
asm
        PUSH    DS
        LDS     DX,SearchRec
        MOV     AH,1AH
        INT     21H
        POP     DS
        MOV     AH,4FH
        INT     21H
        JC      @@1
        LES     DI,SearchRec
        ADD     DI,OFFSET TSearchRec.Name
        PUSH    ES
        PUSH    DI
        PUSH    ES
        PUSH    DI
        CALL    ConvertName
        ADD     SP,4
        XOR     AX,AX
@@1:    NEG     AX
end;

{ The following function is a no-op in WIN16, but must be called in WIN32.
  In order to maintain maximum portability, call this procedure after
  completing a FindFirst/FindNext sequence. }

procedure FindClose(var SearchRec: TSearchRec);
begin
end;

function DeleteFile(const FileName: string): Boolean; assembler;
var
  FileNameBuf: TFileNameBuf;
asm
        LEA     DI,FileNameBuf
        PUSH    SS
        PUSH    DI
        PUSH    FileName.Word[2]
        PUSH    FileName.Word[0]
        CALL    CopyFileName
        PUSH    DS
        LEA     DX,FileNameBuf
        PUSH    SS
        POP     DS
        MOV     AH,41H
        INT     21H
        POP     DS
        SBB     AX,AX
        INC     AX
end;

function RenameFile(const OldName, NewName: string): Boolean; assembler;
var
  OldNameBuf, NewNameBuf: TFileNameBuf;
asm
        LEA     DI,OldNameBuf
        PUSH    SS
        PUSH    DI
        PUSH    OldName.Word[2]
        PUSH    OldName.Word[0]
        CALL    CopyFileName
        LEA     DI,NewNameBuf
        PUSH    SS
        PUSH    DI
        PUSH    NewName.Word[2]
        PUSH    NewName.Word[0]
        CALL    CopyFileName
        PUSH    DS
        LEA     DX,OldNameBuf
        PUSH    SS
        POP     DS
        LEA     DI,NewNameBuf
        PUSH    SS
        POP     ES
        MOV     AH,56H
        INT     21H
        POP     DS
        SBB     AX,AX
        INC     AX
end;

function ChangeFileExt(const FileName, Extension: string): string;
var
  I: Integer;
begin
  I := Length(FileName);
  while (I > 0) and not (FileName[I] in ['.', '\', ':']) do Dec(I);
  if (I = 0) or (FileName[I] <> '.') then I := 256;
  Result := Copy(FileName, 1, I - 1) + Extension;
end;

function ExtractFilePath(const FileName: string): string;
var
  I: Integer;
begin
  I := Length(FileName);
  while (I > 0) and not (FileName[I] in ['\', ':']) do Dec(I);
  Result := Copy(FileName, 1, I);
end;

function ExtractFileName(const FileName: string): string;
var
  I: Integer;
begin
  I := Length(FileName);
  while (I > 0) and not (FileName[I] in ['\', ':']) do Dec(I);
  Result := Copy(FileName, I + 1, 255);
end;

function ExtractFileExt(const FileName: string): string;
var
  I: Integer;
begin
  I := Length(FileName);
  while (I > 0) and not (FileName[I] in ['.', '\', ':']) do Dec(I);
  if (I > 0) and (FileName[I] = '.') then
    Result := Copy(FileName, I, 255) else
    Result := '';
end;

function ExpandFileName(const FileName: string): string; assembler;
asm
        PUSH    DS
        LDS     SI,FileName
        CLD
        LODSB
        XOR     AH,AH
        XCHG    AX,CX
        ADD     CX,SI
        LES     DI,Result
        INC     DI
        LODSW
        CMP     SI,CX
        JA      @@1
        CMP     AH,':'
        JE      @@2
@@1:    DEC     SI
        DEC     SI
        MOV     AH,19H                  { Get current drive }
        INT     21H
        ADD     AL,'A'
        MOV     AH,':'
@@2:    STOSW
        CMP     SI,CX
        JE      @@21
        CMP     BYTE PTR [SI],'\'
        JE      @@3
@@21:   AND     AL,0DFH
        SUB     AL,'A'-1
        MOV     DL,AL
        MOV     AL,'\'
        STOSB
        PUSH    SI
        PUSH    DS
        MOV     AH,47H                  { Get current directory }
        MOV     SI,DI
        PUSH    ES
        POP     DS
        INT     21H
        POP     DS
        POP     SI
        JC      @@3
        CMP     BYTE PTR ES:[DI],0
        JE      @@3
        PUSH    CX
        PUSH    ES
        PUSH    ES
        PUSH    DI
        PUSH    ES
        PUSH    DI
        CALL    OemToAnsi
        POP     ES
        MOV     CX,-1
        XOR     AL,AL
        REPNE   SCASB
        DEC     DI
        MOV     AL,'\'
        STOSB
        POP     CX
@@3:    SUB     CX,SI
        REP     MOVSB
        XOR     AL,AL
        STOSB
        LES     DI,Result
        INC     DI
        LDS     SI,Result
        INC     SI
        MOV     CX,-1
@@4:    LODSB
        OR      AL,AL
        JE      @@6
        CMP     AL,'\'
        JE      @@6
        CMP     AL,'.'
        JE      @@51
        JCXZ    @@4
        DEC     CX
@@5:    STOSB
        JMP     @@4
@@51:   MOV     CX,3
        JMP     @@5
@@6:    CMP     WORD PTR [DI-2],'.\'
        JNE     @@7
        DEC     DI
        DEC     DI
        JMP     @@9
@@7:    CMP     WORD PTR [DI-2],'..'
        JNE     @@9
        CMP     BYTE PTR [DI-3],'\'
        JNE     @@9
        SUB     DI,3
        CMP     BYTE PTR [DI-1],':'
        JE      @@9
@@8:    DEC     DI
        CMP     BYTE PTR [DI],'\'
        JNE     @@8
@@9:    MOV     CX,8
        OR      AL,AL
        JNE     @@5
        CMP     BYTE PTR [DI-1],':'
        JNE     @@10
        MOV     AL,'\'
        STOSB
@@10:   LEA     AX,[DI-1]
        LES     DI,Result
        SUB     AX,DI
        STOSB
        PUSH    ES
        PUSH    DI
        PUSH    AX
        CALL    AnsiUpperBuff
        POP     DS
end;

function FileSearch(const Name, DirList: string): string;
var
  I, P: Integer;
begin
  Result := Name;
  P := 1;
  while True do
  begin
    if FileExists(Result) then Exit;
    if P > Length(DirList) then Break;
    I := P;
    while (P <= Length(DirList)) and (DirList[P] <> ';') do Inc(P);
    Result := Copy(DirList, I, P - I);
    if not (Result[Length(Result)] in [':', '\']) then
      Result := Result + '\';
    Result := Result + Name;
    Inc(P);
  end;
  Result := '';
end;

function DiskFree(Drive: Byte): Longint; assembler;
asm
        MOV     DL,Drive
        MOV     AH,36H
        INT     21H
        MOV     DX,AX
        CMP     AX,0FFFFH
        JE      @@1
        MUL     CX
        MUL     BX
@@1:
end;

function DiskSize(Drive: Byte): Longint; assembler;
asm
        MOV     DL,Drive
        MOV     AH,36H
        INT     21H
        MOV     BX,DX
        MOV     DX,AX
        CMP     AX,0FFFFH
        JE      @@1
        MUL     CX
        MUL     BX
@@1:
end;

function FileDateToDateTime(FileDate: Longint): TDateTime;
begin
  Result :=
    EncodeDate(
      LongRec(FileDate).Hi shr 9 + 1980,
      LongRec(FileDate).Hi shr 5 and 15,
      LongRec(FileDate).Hi and 31) +
    EncodeTime(
      LongRec(FileDate).Lo shr 11,
      LongRec(FileDate).Lo shr 5 and 63,
      LongRec(FileDate).Lo and 31 shl 1, 0);
end;

function DateTimeToFileDate(DateTime: TDateTime): Longint;
var
  Year, Month, Day, Hour, Min, Sec, MSec: Word;
begin
  DecodeDate(DateTime, Year, Month, Day);
  if (Year < 1980) or (Year > 2099) then Result := 0 else
  begin
    DecodeTime(DateTime, Hour, Min, Sec, MSec);
    LongRec(Result).Lo := (Sec shr 1) or (Min shl 5) or (Hour shl 11);
    LongRec(Result).Hi := Day or (Month shl 5) or ((Year - 1980) shl 9);
  end;
end;

{ PChar routines }

function StrLen(Str: PChar): Cardinal; assembler;
asm
        CLD
        LES     DI,Str
        MOV     CX,0FFFFH
        XOR     AL,AL
        REPNE   SCASB
        MOV     AX,0FFFEH
        SUB     AX,CX
end;

function StrEnd(Str: PChar): PChar; assembler;
asm
        CLD
        LES     DI,Str
        MOV     CX,0FFFFH
        XOR     AL,AL
        REPNE   SCASB
        MOV     AX,DI
        MOV     DX,ES
        DEC     AX
end;

function StrMove(Dest, Source: PChar; Count: Cardinal): PChar; assembler;
asm
        PUSH    DS
        CLD
        LDS     SI,Source
        LES     DI,Dest
        MOV     AX,DI
        MOV     DX,ES
        MOV     CX,Count
        CMP     SI,DI
        JAE     @@1
        STD
        ADD     SI,CX
        ADD     DI,CX
        DEC     SI
        DEC     DI
@@1:    REP     MOVSB
        CLD
        POP     DS
end;

function StrCopy(Dest, Source: PChar): PChar; assembler;
asm
        PUSH    DS
        CLD
        LES     DI,Source
        MOV     CX,0FFFFH
        XOR     AL,AL
        REPNE   SCASB
        NOT     CX
        LDS     SI,Source
        LES     DI,Dest
        MOV     AX,DI
        MOV     DX,ES
        REP     MOVSB
        POP     DS
end;

function StrECopy(Dest, Source: PChar): PChar; assembler;
asm
        PUSH    DS
        CLD
        LES     DI,Source
        MOV     CX,0FFFFH
        XOR     AL,AL
        REPNE   SCASB
        NOT     CX
        LDS     SI,Source
        LES     DI,Dest
        REP     MOVSB
        MOV     AX,DI
        MOV     DX,ES
        DEC     AX
        POP     DS
end;

function StrLCopy(Dest, Source: PChar; MaxLen: Cardinal): PChar; assembler;
asm
        PUSH    DS
        CLD
        LES     DI,Source
        MOV     CX,MaxLen
        MOV     BX,CX
        XOR     AL,AL
        REPNE   SCASB
        SUB     BX,CX
        MOV     CX,BX
        LDS     SI,Source
        LES     DI,Dest
        MOV     BX,DI
        MOV     DX,ES
        REP     MOVSB
        STOSB
        XCHG    AX,BX
        POP     DS
end;

function StrPCopy(Dest: PChar; const Source: String): PChar; assembler;
asm
        PUSH    DS
        CLD
        LDS     SI,Source
        LES     DI,Dest
        MOV     BX,DI
        MOV     DX,ES
        LODSB
        XOR     AH,AH
        XCHG    AX,CX
        REP     MOVSB
        XOR     AL,AL
        STOSB
        XCHG    AX,BX
        POP     DS
end;

function StrPLCopy(Dest: PChar; const Source: string;
  MaxLen: Cardinal): PChar; assembler;
asm
        PUSH    DS
        CLD
        LDS     SI,Source
        LES     DI,Dest
        MOV     CX,MaxLen
        MOV     BX,DI
        MOV     DX,ES
        LODSB
        XOR     AH,AH
        CMP     AX,CX
        JA      @@1
        XCHG    AX,CX
@@1:    REP     MOVSB
        XOR     AL,AL
        STOSB
        XCHG    AX,BX
        POP     DS
end;

function StrCat(Dest, Source: PChar): PChar; assembler;
asm
        PUSH    Dest.Word[2]
        PUSH    Dest.Word[0]
        PUSH    CS
        CALL    NEAR PTR StrEnd
        PUSH    DX
        PUSH    AX
        PUSH    Source.Word[2]
        PUSH    Source.Word[0]
        PUSH    CS
        CALL    NEAR PTR StrCopy
        MOV     AX,Dest.Word[0]
        MOV     DX,Dest.Word[2]
end;

function StrLCat(Dest, Source: PChar; MaxLen: Cardinal): PChar; assembler;
asm
        PUSH    Dest.Word[2]
        PUSH    Dest.Word[0]
        PUSH    CS
        CALL    NEAR PTR StrEnd
        MOV     CX,Dest.Word[0]
        ADD     CX,MaxLen
        SUB     CX,AX
        JBE     @@1
        PUSH    DX
        PUSH    AX
        PUSH    Source.Word[2]
        PUSH    Source.Word[0]
        PUSH    CX
        PUSH    CS
        CALL    NEAR PTR StrLCopy
@@1:    MOV     AX,Dest.Word[0]
        MOV     DX,Dest.Word[2]
end;

function StrComp(Str1, Str2: PChar): Integer; assembler;
asm
        PUSH    DS
        CLD
        LES     DI,Str2
        MOV     SI,DI
        MOV     CX,0FFFFH
        XOR     AX,AX
        CWD
        REPNE   SCASB
        NOT     CX
        MOV     DI,SI
        LDS     SI,Str1
        REPE    CMPSB
        MOV     AL,DS:[SI-1]
        MOV     DL,ES:[DI-1]
        SUB     AX,DX
        POP     DS
end;

function StrIComp(Str1, Str2: PChar): Integer; assembler;
asm
        PUSH    DS
        CLD
        LES     DI,Str2
        MOV     SI,DI
        MOV     CX,0FFFFH
        XOR     AX,AX
        CWD
        REPNE   SCASB
        NOT     CX
        MOV     DI,SI
        LDS     SI,Str1
@@1:    REPE    CMPSB
        JE      @@4
        MOV     AL,DS:[SI-1]
        CMP     AL,'a'
        JB      @@2
        CMP     AL,'z'
        JA      @@2
        SUB     AL,20H
@@2:    MOV     DL,ES:[DI-1]
        CMP     DL,'a'
        JB      @@3
        CMP     DL,'z'
        JA      @@3
        SUB     DL,20H
@@3:    SUB     AX,DX
        JE      @@1
@@4:    POP     DS
end;

function StrLComp(Str1, Str2: PChar; MaxLen: Cardinal): Integer; assembler;
asm
        PUSH    DS
        CLD
        LES     DI,Str2
        MOV     SI,DI
        MOV     AX,MaxLen
        MOV     CX,AX
        JCXZ    @@1
        XCHG    AX,BX
        XOR     AX,AX
        CWD
        REPNE   SCASB
        SUB     BX,CX
        MOV     CX,BX
        MOV     DI,SI
        LDS     SI,Str1
        REPE    CMPSB
        MOV     AL,DS:[SI-1]
        MOV     DL,ES:[DI-1]
        SUB     AX,DX
@@1:    POP     DS
end;

function StrLIComp(Str1, Str2: PChar; MaxLen: Cardinal): Integer; assembler;
asm
        PUSH    DS
        CLD
        LES     DI,Str2
        MOV     SI,DI
        MOV     AX,MaxLen
        MOV     CX,AX
        JCXZ    @@4
        XCHG    AX,BX
        XOR     AX,AX
        CWD
        REPNE   SCASB
        SUB     BX,CX
        MOV     CX,BX
        MOV     DI,SI
        LDS     SI,Str1
@@1:    REPE    CMPSB
        JE      @@4
        MOV     AL,DS:[SI-1]
        CMP     AL,'a'
        JB      @@2
        CMP     AL,'z'
        JA      @@2
        SUB     AL,20H
@@2:    MOV     DL,ES:[DI-1]
        CMP     DL,'a'
        JB      @@3
        CMP     DL,'z'
        JA      @@3
        SUB     DL,20H
@@3:    SUB     AX,DX
        JE      @@1
@@4:    POP     DS
end;

function StrScan(Str: PChar; Chr: Char): PChar; assembler;
asm
        CLD
        LES     DI,Str
        MOV     SI,DI
        MOV     CX,0FFFFH
        XOR     AL,AL
        REPNE   SCASB
        NOT     CX
        MOV     DI,SI
        MOV     AL,Chr
        REPNE   SCASB
        MOV     AX,0
        CWD
        JNE     @@1
        MOV     AX,DI
        MOV     DX,ES
        DEC     AX
@@1:
end;

function StrRScan(Str: PChar; Chr: Char): PChar; assembler;
asm
        CLD
        LES     DI,Str
        MOV     CX,0FFFFH
        XOR     AL,AL
        REPNE   SCASB
        NOT     CX
        STD
        DEC     DI
        MOV     AL,Chr
        REPNE   SCASB
        MOV     AX,0
        CWD
        JNE     @@1
        MOV     AX,DI
        MOV     DX,ES
        INC     AX
@@1:    CLD
end;

function StrPos(Str1, Str2: PChar): PChar; assembler;
asm
        PUSH    DS
        CLD
        XOR     AL,AL
        LES     DI,Str2
        MOV     CX,0FFFFH
        REPNE   SCASB
        NOT     CX
        DEC     CX
        JE      @@2
        MOV     DX,CX
        MOV     BX,ES
        MOV     DS,BX
        LES     DI,Str1
        MOV     BX,DI
        MOV     CX,0FFFFH
        REPNE   SCASB
        NOT     CX
        SUB     CX,DX
        JBE     @@2
        MOV     DI,BX
@@1:    MOV     SI,Str2.Word[0]
        LODSB
        REPNE   SCASB
        JNE     @@2
        MOV     AX,CX
        MOV     BX,DI
        MOV     CX,DX
        DEC     CX
        REPE    CMPSB
        MOV     CX,AX
        MOV     DI,BX
        JNE     @@1
        MOV     AX,DI
        MOV     DX,ES
        DEC     AX
        JMP     @@3
@@2:    XOR     AX,AX
        MOV     DX,AX
@@3:    POP     DS
end;

function StrUpper(Str: PChar): PChar; assembler;
asm
        PUSH    DS
        CLD
        LDS     SI,Str
        MOV     BX,SI
        MOV     DX,DS
@@1:    LODSB
        OR      AL,AL
        JE      @@2
        CMP     AL,'a'
        JB      @@1
        CMP     AL,'z'
        JA      @@1
        SUB     AL,20H
        MOV     [SI-1],AL
        JMP     @@1
@@2:    XCHG    AX,BX
        POP     DS
end;

function StrLower(Str: PChar): PChar; assembler;
asm
        PUSH    DS
        CLD
        LDS     SI,Str
        MOV     BX,SI
        MOV     DX,DS
@@1:    LODSB
        OR      AL,AL
        JE      @@2
        CMP     AL,'A'
        JB      @@1
        CMP     AL,'Z'
        JA      @@1
        ADD     AL,20H
        MOV     [SI-1],AL
        JMP     @@1
@@2:    XCHG    AX,BX
        POP     DS
end;

function StrPas(Str: PChar): String; assembler;
asm
        PUSH    DS
        CLD
        LES     DI,Str
        MOV     CX,256
        XOR     AL,AL
        REPNE   SCASB
        NOT     CL
        LDS     SI,Str
        LES     DI,@Result
        MOV     AL,CL
        STOSB
        REP     MOVSB
        POP     DS
end;

function StrAlloc(Size: Cardinal): PChar;
begin
  Inc(Size, 2);
  GetMem(Result, Size);
  Word(Pointer(Result)^) := Size;
  Inc(Result, 2);
end;

function StrBufSize(Str: PChar): Cardinal;
begin
  Dec(Str, 2);
  Result := Word(Pointer(Str)^) - 2;
end;

function StrNew(Str: PChar): PChar;
var
  Size: Cardinal;
begin
  if Str = nil then Result := nil else
  begin
    Size := StrLen(Str) + 1;
    Result := StrMove(StrAlloc(Size), Str, Size);
  end;
end;

procedure StrDispose(Str: PChar);
begin
  if Str <> nil then
  begin
    Dec(Str, 2);
    FreeMem(Str, Word(Pointer(Str)^));
  end;
end;

{ String formatting routines }

{$L SFMT.OBW}

function FormatBuf(var Buffer; BufLen: Cardinal; const Format; FmtLen: Cardinal;
  const Args: array of const): Cardinal; external;

procedure FormatError(ErrorCode: Integer; Format: PChar; FmtLen: Cardinal);
var
  Buffer: array[0..31] of Char;
begin
  if FmtLen > 31 then FmtLen := 31;
  StrMove(Buffer, Format, FmtLen);
  Buffer[FmtLen] := #0;
  ConvertError(FmtLoadStr(SInvalidFormat + ErrorCode, [Buffer]));
end;

function StrFmt(Buffer, Format: PChar; const Args: array of const): PChar;
begin
  Buffer[FormatBuf(Buffer^, 65535, Format^, StrLen(Format), Args)] := #0;
  Result := Buffer;
end;

function StrLFmt(Buffer: PChar; MaxLen: Cardinal; Format: PChar;
  const Args: array of const): PChar;
begin
  Buffer[FormatBuf(Buffer^, MaxLen, Format^, StrLen(Format), Args)] := #0;
  Result := Buffer;
end;

function Format(const Format: string; const Args: array of const): string;
begin
  Result[0] := Chr(FormatBuf(Result[1], High(Result), Format[1],
    Length(Format), Args));
end;

procedure FmtStr(var Result: string; const Format: string;
  const Args: array of const);
begin
  Result[0] := Chr(FormatBuf(Result[1], High(Result), Format[1],
    Length(Format), Args));
end;

{ Floating point conversion routines }

{$L FFMT.OBW}

procedure FloatToDecimal(var Result: TFloatRec; Value: Extended;
  Precision, Decimals: Integer); external;

function FloatToText(Buffer: PChar; Value: Extended; Format: TFloatFormat;
  Precision, Digits: Integer): Integer; external;

function FloatToTextFmt(Buffer: PChar; Value: Extended;
  Format: PChar): Integer; external;

function TextToFloat(Buffer: PChar; var Value: Extended): Boolean; external;

function FloatToStr(Value: Extended): string;
begin
  Result[0] := Chr(FloatToText(@Result[1], Value, ffGeneral, 15, 0));
end;

function FloatToStrF(Value: Extended; Format: TFloatFormat;
  Precision, Digits: Integer): string;
begin
  Result[0] := Chr(FloatToText(@Result[1], Value, Format, Precision, Digits));
end;

function FormatFloat(const Format: string; Value: Extended): string;
var
  Buffer: array[0..223] of Char;
begin
  Result[0] := Chr(FloatToTextFmt(@Result[1], Value, StrPLCopy(Buffer,
    Format, SizeOf(Buffer) - 1)));
end;

function StrToFloat(const S: string): Extended;
var
  Buffer: array[0..63] of Char;
begin
  if not TextToFloat(StrPLCopy(Buffer, S, SizeOf(Buffer) - 1), Result) then
    ConvertError(FmtLoadStr(SInvalidFloat, [S]));
end;

{ Date/time support routines }

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

{ Time encoding and decoding }

function DoEncodeTime(Hour, Min, Sec, MSec: Word; var Time: TDateTime): Boolean;
begin
  Result := False;
  if (Hour < 24) and (Min < 60) and (Sec < 60) and (MSec < 1000) then
  begin
    Time := (LongMul(Hour * 60 + Min, 60000) + Sec * 1000 + MSec) / MSecsPerDay;
    Result := True;
  end;
end;

function EncodeTime(Hour, Min, Sec, MSec: Word): TDateTime;
begin
  if not DoEncodeTime(Hour, Min, Sec, MSec, Result) then
    ConvertError(LoadStr(STimeEncodeError));
end;

procedure DecodeTime(Time: TDateTime; var Hour, Min, Sec, MSec: Word);
var
  MinCount, MSecCount: Word;
begin
  DivMod(Trunc(Frac(Time + 0.5 / MSecsPerDay) * MSecsPerDay), 60000,
    MinCount, MSecCount);
  DivMod(MinCount, 60, Hour, Min);
  DivMod(MSecCount, 1000, Sec, MSec);
end;

{ Date encoding and decoding }

function IsLeapYear(Year: Word): Boolean;
begin
  Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
end;

function GetDayTable(Year: Word): PDayTable;
const
  DayTable1: TDayTable = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  DayTable2: TDayTable = (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  DayTables: array[Boolean] of PDayTable = (@DayTable1, @DayTable2);
begin
  Result := DayTables[IsLeapYear(Year)];
end;

function DoEncodeDate(Year, Month, Day: Word; var Date: TDateTime): Boolean;
var
  I: Word;
  DayTable: PDayTable;
begin
  Result := False;
  DayTable := GetDayTable(Year);
  if (Year >= 1) and (Year <= 9999) and (Month >= 1) and (Month <= 12) and
    (Day >= 1) and (Day <= DayTable^[Month]) then
  begin
    for I := 1 to Month - 1 do Inc(Day, DayTable^[I]);
    I := Year - 1;
    Date := LongMul(I, 365) + (Day + I div 4 - I div 100 + I div 400);
    Result := True;
  end;
end;

function EncodeDate(Year, Month, Day: Word): TDateTime;
begin
  if not DoEncodeDate(Year, Month, Day, Result) then
    ConvertError(LoadStr(SDateEncodeError));
end;

procedure DecodeDate(Date: TDateTime; var Year, Month, Day: Word);
const
  D1 = 365;
  D4 = D1 * 4 + 1;
  D100 = D4 * 25 - 1;
  D400 = D100 * 4 + 1;
var
  Y, M, D, I: Word;
  T: Longint;
  DayTable: PDayTable;
begin
  T := Trunc(Date + 0.5 / MSecsPerDay);
  if T <= 0 then
  begin
    Year := 0;
    Month := 0;
    Day := 0;
  end else
  begin
    Dec(T);
    Y := 1;
    while T >= D400 do
    begin
      Dec(T, D400);
      Inc(Y, 400);
    end;
    DivMod(T, D100, I, D);
    if I = 4 then
    begin
      Dec(I);
      Inc(D, D100);
    end;
    Inc(Y, I * 100);
    DivMod(D, D4, I, D);
    Inc(Y, I * 4);
    DivMod(D, D1, I, D);
    if I = 4 then
    begin
      Dec(I);
      Inc(D, D1);
    end;
    Inc(Y, I);
    DayTable := GetDayTable(Y);
    M := 1;
    while True do
    begin
      I := DayTable^[M];
      if D < I then Break;
      Dec(D, I);
      Inc(M);
    end;
    Year := Y;
    Month := M;
    Day := D + 1;
  end;
end;

function DayOfWeek(Date: TDateTime): Integer;
begin
  Result := Trunc(Date + 0.5 / MSecsPerDay) mod 7 + 1;
end;

function Date: TDateTime;
var
  Year: Word;
  Month, Day: Byte;
begin
  asm
        MOV     AH,2AH
        INT     21H
        MOV     Year,CX
        MOV     Month,DH
        MOV     Day,DL
  end;
  Result := EncodeDate(Year, Month, Day);
end;

function Time: TDateTime;
var
  Hour, Min, Sec, HSec: Byte;
begin
  asm
        MOV     AH,2CH
        INT     21H
        MOV     Hour,CH
        MOV     Min,CL
        MOV     Sec,DH
        MOV     HSec,DL
  end;
  Result := EncodeTime(Hour, Min, Sec, HSec * 10);
end;

function Now: TDateTime;
begin
  Result := Date + Time;
end;

function CurrentYear: Word; assembler;
asm
        MOV     AH,2AH
        INT     21H
        MOV     AX,CX
end;

{ Date/time to string conversions }

procedure DateTimeToString(var Result: string; const Format: string;
  DateTime: TDateTime);

  procedure AppendString(const S: string);
  begin
    AppendStr(Result, S);
  end;

  procedure AppendChar(Ch: Char);
  begin
    if Length(Result) < 255 then
    begin
      Inc(Result[0]);
      Result[Length(Result)] := Ch;
    end;
  end;

  procedure AppendNumber(Number, Digits: Integer);
  begin
    AppendStr(Result, SysUtils.Format('%.*d', [Digits, Number]));
  end;

  procedure AppendDateTime; forward;

  procedure AppendFormat(const Format: string);
  var
    Starter, Token, LastToken: Char;
    DateDecoded, TimeDecoded, Use12HourClock, BetweenQuotes: Boolean;
    I, Pos, Len, Count: Integer;
    Year, Month, Day, Hour, Min, Sec, MSec, H: Word;

    procedure GetCount;
    var
      I: Integer;
    begin
      I := Pos;
      while (Pos <= Len) and (Format[Pos] = Starter) do Inc(Pos);
      Count := Pos - I + 1;
    end;

    procedure GetDate;
    begin
      if not DateDecoded then
      begin
        DecodeDate(DateTime, Year, Month, Day);
        DateDecoded := True;
      end;
    end;

    procedure GetTime;
    begin
      if not TimeDecoded then
      begin
        DecodeTime(DateTime, Hour, Min, Sec, MSec);
        TimeDecoded := True;
      end;
    end;

  begin
    Pos := 1;
    Len := Length(Format);
    LastToken := ' ';
    DateDecoded := False;
    TimeDecoded := False;
    while Pos <= Len do
    begin
      Starter := Format[Pos];
      Inc(Pos);
      Token := Starter;
      if Token in ['a'..'z'] then Dec(Token, 32);
      if Token in ['A'..'Z'] then
      begin
        if (Token = 'M') and (LastToken = 'H') then Token := 'N';
        LastToken := Token;
      end;
      case Token of
        'Y':
          begin
            GetCount;
            GetDate;
            if Count <= 2 then
              AppendNumber(Year mod 100, 2) else
              AppendNumber(Year, 4);
          end;
        'M':
          begin
            GetCount;
            GetDate;
            case Count of
              1, 2: AppendNumber(Month, Count);
              3: AppendString(ShortMonthNames[Month]);
            else
              AppendString(LongMonthNames[Month]);
            end;
          end;
        'D':
          begin
            GetCount;
            case Count of
              1, 2:
                begin
                  GetDate;
                  AppendNumber(Day, Count);
                end;
              3: AppendString(ShortDayNames[DayOfWeek(DateTime)]);
              4: AppendString(LongDayNames[DayOfWeek(DateTime)]);
              5: AppendFormat(ShortDateFormat);
            else
              AppendFormat(LongDateFormat);
            end;
          end;
        'H':
          begin
            GetCount;
            GetTime;
            Use12HourClock := False;
            BetweenQuotes := False;
            I := Pos;
            while I <= Len do
            begin
              case Format[I] of
                'A', 'a':
                  if not BetweenQuotes then
                  begin
                    Use12HourClock := True;
                    Break;
                  end;
                'H', 'h':
                  Break;
                '''', '"': BetweenQuotes := not BetweenQuotes;
              end;
              Inc(I);
            end;
            H := Hour;
            if Use12HourClock then
              if H = 0 then H := 12 else if H > 12 then Dec(H, 12);
            if Count > 2 then Count := 2;
            AppendNumber(H, Count);
          end;
        'N':
          begin
            GetCount;
            GetTime;
            if Count > 2 then Count := 2;
            AppendNumber(Min, Count);
          end;
        'S':
          begin
            GetCount;
            GetTime;
            if Count > 2 then Count := 2;
            AppendNumber(Sec, Count);
          end;
        'T':
          begin
            GetCount;
            if Count = 1 then
              AppendFormat(ShortTimeFormat) else
              AppendFormat(LongTimeFormat);
          end;
        'A':
          begin
            GetTime;
            I := Pos - 1;
            if CompareText(Copy(Format, I, 5), 'AM/PM') = 0 then
            begin
              if Hour >= 12 then Inc(I, 3);
              AppendString(Copy(Format, I, 2));
              Inc(Pos, 4);
            end else
            if CompareText(Copy(Format, I, 3), 'A/P') = 0 then
            begin
              if Hour >= 12 then Inc(I, 2);
              AppendChar(Format[I]);
              Inc(Pos, 2);
            end else
            if CompareText(Copy(Format, I, 4), 'AMPM') = 0 then
            begin
              if Hour < 12 then
                AppendString(TimeAMString) else
                AppendString(TimePMString);
              Inc(Pos, 3);
            end else
            AppendChar(Starter);
          end;
        'C':
          begin
            GetCount;
            AppendDateTime;
          end;
        '/':
          AppendChar(DateSeparator);
        ':':
          AppendChar(TimeSeparator);
        '''', '"':
          begin
            I := Pos;
            while (Pos <= Len) and (Format[Pos] <> Starter) do Inc(Pos);
            AppendString(Copy(Format, I, Pos - I));
            if Pos <= Len then Inc(Pos);
          end;
      else
        AppendChar(Starter);
      end;
    end;
  end;

  procedure AppendDateTime;
  begin
    AppendFormat(ShortDateFormat);
    if Trunc(Frac(DateTime + 0.5 / MSecsPerDay) * SecsPerDay) <> 0 then
    begin
      AppendChar(' ');
      AppendFormat(LongTimeFormat);
    end;
  end;

begin
  Result := '';
  if Format <> '' then AppendFormat(Format) else AppendDateTime;
end;

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

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

function DateTimeToStr(DateTime: TDateTime): string;
begin
  DateTimeToString(Result, '', DateTime);
end;

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

{ String to date/time conversions }

type
  TDateOrder = (doMDY, doDMY, doYMD);

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): Boolean;
var
  I: Integer;
  N: Word;
begin
  Result := False;
  ScanBlanks(S, Pos);
  I := Pos;
  N := 0;
  while (I <= Length(S)) and (S[I] in ['0'..'9']) and (N < 1000) do
  begin
    N := N * 10 + (Ord(S[I]) - Ord('0'));
    Inc(I);
  end;
  if I > Pos then
  begin
    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;

function ScanChar(const S: string; var Pos: Integer; Ch: Char): Boolean;
begin
  Result := False;
  ScanBlanks(S, Pos);
  if (Pos <= Length(S)) and (S[Pos] = Ch) then
  begin
    Inc(Pos);
    Result := True;
  end;
end;

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

function ScanDate(const S: string; var Pos: Integer;
  var Date: TDateTime): Boolean;
var
  DateOrder: TDateOrder;
  I: Integer;
  N1, N2, N3, Y, M, D: Word;
begin
  Result := False;
  DateOrder := GetDateOrder(ShortDateFormat);
  if not (ScanNumber(S, Pos, N1) and ScanChar(S, Pos, DateSeparator) and
    ScanNumber(S, Pos, N2)) then Exit;
  if ScanChar(S, Pos, DateSeparator) then
  begin
    if not ScanNumber(S, Pos, N3) then Exit;
    case DateOrder of
      doMDY: begin Y := N3; M := N1; D := N2; end;
      doDMY: begin Y := N3; M := N2; D := N1; end;
      doYMD: begin Y := N1; M := N2; D := N3; end;
    end;
    if Y <= 99 then Inc(Y, 1900);
  end else
  begin
    Y := CurrentYear;
    if DateOrder = doDMY then
    begin
      D := N1; M := N2;
    end else
    begin
      M := N1; D := N2;
    end;
  end;
  ScanBlanks(S, Pos);
  Result := DoEncodeDate(Y, M, D, Date);
end;

function ScanTime(const S: string; var Pos: Integer;
  var Time: TDateTime): Boolean;
var
  BaseHour: Integer;
  Hour, Min, Sec: Word;
begin
  Result := False;
  if not (ScanNumber(S, Pos, Hour) and ScanChar(S, Pos, TimeSeparator) and
    ScanNumber(S, Pos, Min)) then Exit;
  Sec := 0;
  if ScanChar(S, Pos, TimeSeparator) then
    if not ScanNumber(S, Pos, Sec) then Exit;
  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
  begin
    if (Hour = 0) or (Hour > 12) then Exit;
    if Hour = 12 then Hour := 0;
    Inc(Hour, BaseHour);
  end;
  ScanBlanks(S, Pos);
  Result := DoEncodeTime(Hour, Min, Sec, 0, Time);
end;

function StrToDate(const S: string): TDateTime;
var
  Pos: Integer;
begin
  Pos := 1;
  if not ScanDate(S, Pos, Result) or (Pos <= Length(S)) then
    ConvertError(FmtLoadStr(SInvalidDate, [S]));
end;

function StrToTime(const S: string): TDateTime;
var
  Pos: Integer;
begin
  Pos := 1;
  if not ScanTime(S, Pos, Result) or (Pos <= Length(S)) then
    ConvertError(FmtLoadStr(SInvalidTime, [S]));
end;

function StrToDateTime(const S: string): TDateTime;
var
  Pos: Integer;
  Date, Time: TDateTime;
begin
  Pos := 1;
  Time := 0;
  if not ScanDate(S, Pos, Date) or not ((Pos > Length(S)) or
    ScanTime(S, Pos, Time)) then
    ConvertError(FmtLoadStr(SInvalidDateTime, [S]));
  Result := Date + Time;
end;


{ Initialization file support }

function GetProfileStr(Section, Entry: PChar; const Default: string): string;
var
  CDefault: array[0..255] of Char;
begin
  Result[0] := Chr(GetProfileString(Section, Entry,
    StrPCopy(CDefault, Default), @Result[1], 255));
end;

function GetProfileChar(Section, Entry: PChar; Default: Char): Char;
var
  CDefault, CResult: array[0..1] of Char;
begin
  CDefault[0] := Default;
  CDefault[1] := #0;
  if GetProfileString(Section, Entry, CDefault, CResult, 2) <> 0 then
    Result := CResult[0] else
    Result := Default;
end;


procedure GetMonthDayNames;
var
  I: Integer;
begin
  for I := 1 to 12 do
  begin
    ShortMonthNames[I] := LoadStr(I + (SShortMonthNames - 1));
    LongMonthNames[I] := LoadStr(I + (SLongMonthNames - 1));
  end;
  for I := 1 to 7 do
  begin
    ShortDayNames[I] := LoadStr(I + (SShortDayNames - 1));
    LongDayNames[I] := LoadStr(I + (SLongDayNames - 1));
  end;
end;

procedure GetFormatSettings;
const
  SIntl = 'intl';
var
  HourFormat, TimePostfix: string[7];
begin
  CurrencyString := GetProfileStr(SIntl, 'sCurrency', '');
  CurrencyFormat := GetProfileInt(SIntl, 'iCurrency', 0);
  NegCurrFormat := GetProfileInt(SIntl, 'iNegCurr', 0);
  ThousandSeparator := GetProfileChar(SIntl, 'sThousand', ',');
  DecimalSeparator := GetProfileChar(SIntl, 'sDecimal', '.');
  CurrencyDecimals := GetProfileInt(SIntl, 'iCurrDigits', 2);
  DateSeparator := GetProfileChar(SIntl, 'sDate', '/');
  ShortDateFormat := GetProfileStr(SIntl, 'sShortDate', 'm/d/yy');
  LongDateFormat := GetProfileStr(SIntl, 'sLongDate', 'mmmm d, yyyy');
  TimeSeparator := GetProfileChar(SIntl, 'sTime', ':');
  TimeAMString := GetProfileStr(SIntl, 's1159', 'am');
  TimePMString := GetProfileStr(SIntl, 's2359', 'pm');
  if GetProfileInt(SIntl, 'iTLZero', 0) = 0 then
    HourFormat := 'h' else
    HourFormat := 'hh';
  if GetProfileInt(SIntl, 'iTime', 0) = 0 then
    TimePostfix := ' AMPM' else
    TimePostfix := '';
  ShortTimeFormat := HourFormat + ':mm' + TimePostfix;
  LongTimeFormat := HourFormat + ':mm:ss' + TimePostfix;
end;

{ Exception handling routines }

type
  TRaiseFrame = record
    Next: Word;
    ExceptAddr: Pointer;
    ExceptObject: TObject;
  end;

var
  OutOfMemory: EOutOfMemory;

{ Return current exception object }

function ExceptObject: TObject; assembler;
asm
        XOR     AX,AX
        CWD
        MOV     BX,RaiseList
        OR      BX,BX
        JE      @@1
        MOV     AX,SS:[BX].TRaiseFrame.ExceptObject.Word[0]
        MOV     DX,SS:[BX].TRaiseFrame.ExceptObject.Word[2]
@@1:
end;

{ Return current exception address }

function ExceptAddr: Pointer; assembler;
asm
        XOR     AX,AX
        CWD
        MOV     BX,RaiseList
        OR      BX,BX
        JE      @@1
        MOV     AX,SS:[BX].TRaiseFrame.ExceptAddr.Word[0]
        MOV     DX,SS:[BX].TRaiseFrame.ExceptAddr.Word[2]
@@1:
end;

{ Convert physical address to logical address }

function ConvertAddr(Address: Pointer): Pointer; assembler;
asm
        MOV     AX,Address.Word[0]
        MOV     DX,Address.Word[2]
        MOV     CX,DX                   { Don't convert 0000:0000 }
        OR      CX,AX
        JE      @@1
        CMP     DX,0FFFFH               { Don't convert FFFF:xxxx }
        JE      @@1
        MOV     ES,DX
        MOV     DX,ES:Word[0]
@@1:
end;

{ Get module name and segment index of the owner of this segment }


procedure GetModNameAndLogAddr(var ModName: TFileName; var Seg: Word);
var
  GlobalEntry: TGlobalEntry;
  ModEntry: TModuleEntry;
begin
  ModName := '';
  GlobalEntry.dwSize := SizeOf(GlobalEntry);
  if GlobalEntryHandle(@GlobalEntry, THandle(Seg)) then
  begin
    ModEntry.dwSize := SizeOf(ModEntry);
    if ModuleFindHandle(@ModEntry, GlobalEntry.hOwner) <> 0 then
    begin
      ModName := StrPas(StrRScan(ModEntry.szExePath, '\') + 1);
      if GlobalEntry.wType in [GT_CODE, GT_DATA, GT_DGROUP] then
        Seg := GlobalEntry.wData;
    end;
  end;
end;


{ Display exception message box }


procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer);
var
  MsgPtr: PString;
  MsgEnd: PChar;
  ModuleName: array[0..15] of Char;
  ExceptName: string[31];
  Temp: array[0..63] of Char;
  Buffer: array[0..255] of Char;
  GlobalEntry: TGlobalEntry;
  hMod: THandle;
begin
  ExceptName := ExceptObject.ClassName;
  hMod := HInstance;
  GlobalEntry.dwSize := SizeOf(GlobalEntry);
  if GlobalEntryHandle(@GlobalEntry, THandle(PtrRec(ExceptAddr).Seg)) then
  with GlobalEntry do
  begin
    hMod := hOwner;
    if wType in [GT_CODE, GT_DATA, GT_DGROUP] then
      PtrRec(ExceptAddr).Seg := wData;
  end else
    ExceptAddr := ConvertAddr(ExceptAddr);
  GetModuleFileName(hMod, Buffer, SizeOf(Buffer));
  StrCopy(ModuleName, StrRScan(Buffer, '\') + 1);
  MsgPtr := NullStr;
  MsgEnd := '';
  if ExceptObject is Exception then
  begin
    MsgPtr := Exception(ExceptObject).MessagePtr;
    if (MsgPtr^ <> '') and (MsgPtr^[Length(MsgPtr^)] <> '.') then
      MsgEnd := '.';
  end;
  LoadString(HInstance, SException, Temp, SizeOf(Temp));
  StrFmt(Buffer, Temp, [ExceptName, ModuleName, ExceptAddr, MsgPtr^, MsgEnd]);
  LoadString(HInstance, SExceptTitle, Temp, SizeOf(Temp));
  MessageBox(0, Buffer, Temp, mb_Ok + mb_IconHand + mb_SystemModal);
end;


{ Get return address of caller }

function ReturnAddr: Pointer; assembler;
asm
        MOV     AX,[BP].Word[2]
        MOV     DX,[BP].Word[4]
end;

{ Raise abort exception }

procedure Abort;
begin
  raise EAbort.CreateRes(SOperationAborted) at ReturnAddr;
end;

{ Raise out of memory exception }

procedure OutOfMemoryError;
begin
  raise OutOfMemory at ReturnAddr;
end;

{ Exception class }

constructor Exception.Create(const Msg: string);
begin
  FMessage := NewStr(Msg);
end;

constructor Exception.CreateFmt(const Msg: string;
  const Args: array of const);
begin
  FMessage := NewStr(Format(Msg, Args));
end;

constructor Exception.CreateRes(Ident: Word);
begin
  FMessage := NewStr(LoadStr(Ident));
end;

constructor Exception.CreateResFmt(Ident: Word; const Args: array of const);
begin
  FMessage := NewStr(Format(LoadStr(Ident), Args));
end;

constructor Exception.CreateHelp(const Msg: string; AHelpContext: Longint);
begin
  FMessage := NewStr(Msg);
  FHelpContext := AHelpContext;
end;

constructor Exception.CreateFmtHelp(const Msg: string; const Args: array of const;
  AHelpContext: Longint);
begin
  FMessage := NewStr(Format(Msg, Args));
  FHelpContext := AHelpContext;
end;

constructor Exception.CreateResHelp(Ident: Word; AHelpContext: Longint);
begin
  FMessage := NewStr(LoadStr(Ident));
  FHelpContext := AHelpContext;
end;

constructor Exception.CreateResFmtHelp(Ident: Word; const Args: array of const;
  AHelpContext: Longint);
begin
  FMessage := NewStr(Format(LoadStr(Ident), Args));
  FHelpContext := AHelpContext;
end;

destructor Exception.Destroy;
begin
  DisposeStr(FMessage);
end;

function Exception.GetMessage: string;
begin
  Result := FMessage^;
end;

procedure Exception.SetMessage(const Value: string);
begin
  AssignStr(FMessage, Value);
end;

{ EOutOfMemory class }

destructor EOutOfMemory.Destroy;
begin
end;

procedure EOutOfMemory.FreeInstance;
begin
end;

{ Create I/O exception }

function CreateInOutError: EInOutError;
type
  TErrorRec = record
    Code: Integer;
    Ident: Word;
  end;
const
  ErrorMap: array[0..7] of TErrorRec = (
    (Code: 2; Ident: SFileNotFound),
    (Code: 3; Ident: SInvalidFilename),
    (Code: 4; Ident: STooManyOpenFiles),
    (Code: 5; Ident: SAccessDenied),
    (Code: 15; Ident: SInvalidDrive),
    (Code: 100; Ident: SEndOfFile),
    (Code: 101; Ident: SDiskFull),
    (Code: 106; Ident: SInvalidInput));
var
  I: Integer;
begin
  I := Low(ErrorMap);
  while (I <= High(ErrorMap)) and (ErrorMap[I].Code <> InOutRes) do Inc(I);
  if I <= High(ErrorMap) then
    Result := EInOutError.CreateRes(ErrorMap[I].Ident) else
    Result := EInOutError.CreateResFmt(SInOutError, [InOutRes]);
  Result.ErrorCode := InOutRes;
  InOutRes := 0;
end;


const
  Flags   = $10;
  FaultCS = $0E;
  FaultIP = $0C;
  IntrNum = $08;
  AXParam = $06;
  LowStackFlag = $8000;

const
  TaskID: THandle = 0;
  ProcInst: TFarProc = nil;
  Recurse: Word = 0;


{ RTL error handler }

procedure ErrorHandler(ErrorCode: Integer; ErrorAddr: Pointer); far;
type
  TExceptRec = record
    EClass: ExceptClass;
    EIdent: Word;
  end;
const
  ExceptMap: array[2..16] of TExceptRec = (
    (EClass: EInvalidPointer; EIdent: SInvalidPointer),
    (EClass: EDivByZero; EIdent: SDivByZero),
    (EClass: ERangeError; EIdent: SRangeError),
    (EClass: EIntOverflow; EIdent: SIntOverflow),
    (EClass: EInvalidOp; EIdent: SInvalidOp),
    (EClass: EZeroDivide; EIdent: SZeroDivide),
    (EClass: EOverflow; EIdent: SOverflow),
    (EClass: EUnderflow; EIdent: SUnderflow),
    (EClass: EInvalidCast; EIdent: SInvalidCast),
    (EClass: ESingleStep; EIdent: SSingleStep),
    (EClass: EBreakpoint; EIdent: SBreakpoint),
    (EClass: EInvalidOpCode; EIdent: SInvalidOpCode),
    (EClass: EStackFault; EIdent: SStackFault),
    (EClass: EGPFault; EIdent: SGPFault),
    (EClass: EPageFault; EIdent: SPageFault));
var
  E: Exception;
  ModName: TFileName;
  LogicalAddr: Pointer;
begin
  case ErrorCode of
    1: E := OutOfMemory;
    2,4..10: with ExceptMap[ErrorCode] do E := EClass.CreateRes(EIdent);
    3,11..16:
      with ExceptMap[ErrorCode] do
      begin
        LogicalAddr := ErrorAddr;
        GetModNameAndLogAddr(ModName, PtrRec(LogicalAddr).Seg);
        if ModName <> '' then
          E := EClass.CreateResFmt(SModuleException,
            [LoadStr(EIdent), ModName, LogicalAddr])
        else E := EClass.CreateResFmt(SAddressException,
          [LoadStr(EIdent), LogicalAddr]);
      end;
  else
    E := CreateInOutError;
  end;
  raise E at ErrorAddr;
end;

{ RTL exception handler }

procedure ExceptHandler(ExceptObject: TObject; ExceptAddr: Pointer); far;
begin
  ShowException(ExceptObject, ExceptAddr);
  Halt(1);
end;


procedure FaultToError; near; assembler;
asm
        DB      3               { 0 - Div by zero exception }
        DB      11              { 1 - Single Step interrupt }
        DB      0               { 2 }
        DB      12              { 3 - Breakpoint interupt }
        DB      0               { 4 }
        DB      0               { 5 }
        DB      13              { 6 - Invalid OpCode exception }
        DB      0               { 7 }
        DB      0               { 8 }
        DB      0               { 9 }
        DB      0               { 10 }
        DB      0               { 11 }
        DB      14              { 12 - Stack fault exception }
        DB      15              { 13 - General protection fault }
        DB      16              { 14 - Bad Page Fault exception }
end;

{ Default processor exception handler }

procedure DefaultExceptHandler(FaultID: Word; ErrorAddr: Pointer); assembler;
asm
        MOV     AX,FaultID
        MOV     BX,OFFSET FaultToError
        SEGCS
        XLAT
        INC     ErrorAddr.Word[0]
        PUSH    AX
        PUSH    ErrorAddr.Word[2]
        PUSH    ErrorAddr.Word[0]
        CALL    ErrorHandler
end;

{ Hardware exception Handler }

procedure InterruptCallback; far; assembler;
asm
        PUSH    BP
        MOV     BP,SP
        PUSHA
        PUSH    ES
        PUSH    DS
        MOV     DS,AX

        TEST    WORD PTR [BP].IntrNum,LowStackFlag
        JNZ     @@4

        CALL    GetCurrentTask
        OR      AX,AX
        JZ      @@3
        CMP     AX,TaskID
        JNE     @@3

        MOV     AX,WORD PTR [BP].IntrNum
        CMP     AX,15
        JAE     @@4
        CMP     HandleDebugInts,0              { Don't normally handle debugger }
        JNE     @@1                            { interrupts                     }
        CMP     AX,1
        JE      @@4
        CMP     AX,3
        JE      @@4
@@1:    MOV     BX,OFFSET FaultToError
        SEGCS
        XLAT
        OR      AX,AX
        JE      @@3
        PUSH    AX
        MOV     AX,ProcessorExceptHook.Word[0]
        OR      AX,ProcessorExceptHook.Word[2]
        POP     AX
        JE      @@2
        PUSH    [BP].IntrNum.Word[0]
        PUSH    [BP].FaultCS.Word[0]
        PUSH    [BP].FaultIP.Word[0]
        CALL    DWORD PTR ProcessorExceptHook
        OR      AL,AL
        JE      @@5
        DEC     AL
        JE      @@6
        JMP     @@4
@@2:    CMP     Recurse,0
        JNE     @@5
        INC     Recurse
        XCHG    AX,[BP].Flags
        INC     [BP].FaultIP.Word[0]
        MOV     SP,BP
        POP     BP
        ADD     SP,6
        DEC     Recurse
        JMP     ErrorHandler

@@3:    DEC     Recurse
@@4:    POP     DS
        POP     ES
        POPA
        MOV     SP,BP
        POP     BP
        RETF

@@5:    PUSH    TaskID
        PUSH    NO_UAE_BOX
        CALL    TerminateApp

@@6:    POP     DS
        POP     ES
        POPA
        MOV     SP,BP
        POP     BP
        ADD     SP,10
        IRET
end;

{ Handler to set/clear the flag to tell the debugger that we want Hardware
  exceptions }

const
  DebuggerHook  = $24; { Offset in DS of pointer to debugger data }
  WantException = $2E; { Offset in debugger data to flag byte }

procedure SetDebuggerFlag(Value: Boolean); assembler;
asm
        LES     DI,DWORD PTR DS:DebuggerHook
        MOV     AX,ES
        OR      AX,DI
        JE      @@1
        MOV     AL,Value
        MOV     ES:[DI].WantException.Byte[0],AL
@@1:
end;

{ Exception handling initialization }

procedure EnableExceptionHandler(Enable: Boolean);
begin
  if PrefixSeg <> 0 then
    if Enable and (ProcInst = nil) then
    begin
      ProcInst := MakeProcInstance(@InterruptCallBack, HInstance);
      InterruptRegister(0, TIntCallBack(ProcInst));
      SetDebuggerFlag(True);
    end else if not Enable and (ProcInst <> nil) then
    begin
      SetDebuggerFlag(False);
      InterruptUnRegister(0);
      FreeProcInstance(ProcInst);
      ProcInst := nil;
    end;
end;

var
  SaveExit: Pointer;

procedure DoneExceptions; far;
begin
  EnableExceptionHandler(False);
  ExitProc := SaveExit;
end;

procedure InitExceptions;
begin
  TaskID := GetCurrentTask;
  OutOfMemory := EOutOfMemory.CreateRes(SOutOfMemory);
  ErrorProc := @ErrorHandler;
  ExceptProc := @ExceptHandler;
  ExceptionClass := Exception;
  SaveExit := ExitProc;
  ExitProc := @DoneExceptions;
  EnableExceptionHandler(True);
end;


begin
  InitExceptions;
  GetMonthDayNames;
  GetFormatSettings;
end.
