home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibdemo3.zip / SOURCE.DAT / SOURCE / SPCC / SYSUTILS.PAS < prev    next >
Pascal/Delphi Source File  |  1998-05-19  |  167KB  |  5,649 lines

  1.  
  2. {╔══════════════════════════════════════════════════════════════════════════╗
  3.  ║                                                                          ║
  4.  ║     Sibyl Portable Component Classes                                     ║
  5.  ║                                                                          ║
  6.  ║     Copyright (C) 1995,97 SpeedSoft Germany,   All rights reserved.      ║
  7.  ║                                                                          ║
  8.  ╚══════════════════════════════════════════════════════════════════════════╝}
  9.  
  10. {*******************************************************}
  11. {                                                       }
  12. { System Utilities Unit (Delphi compatible)             }
  13. {                                                       }
  14. { (C) 1995-96 Joerg Pleumann                            }
  15. { (C) 1996    SpeedSoft                                 }
  16. {                                                       }
  17. { Please mail All bugs And suggestions To:              }
  18. {                                                       }
  19. { Internet: sa021pl @ uni-duisburg.de                   }
  20. { FidoNet:  Joerg Pleumann @ 2:2448/136.6               }
  21. {                                                       }
  22. {*******************************************************}
  23.  
  24. Unit SysUtils;
  25.  
  26.  
  27. Interface
  28.  
  29. { define Compiler symbol GUI To Include FUNCTIONs from
  30.   OS/2 PM API. If you need A Version Of SysUtils that
  31.   Uses only OS/2 base API FUNCTIONs (And therefore lacks
  32.   Some features), comment This Line out And recompile the
  33.   Unit. Change This To produce programs that Run without
  34.   the OS/2 PM being Active (may also need changes In
  35.   System Unit). Normally you shouldn't Change This. }
  36.  
  37. {$DEFINE GUI}
  38.  
  39. {$IFDEF OS2}
  40.   {$IFDEF GUI}
  41. Uses
  42.   Os2Def,BseDos, BseErr, PmWin, PMSHL;
  43.   {$ELSE GUI}
  44. Uses
  45.   Os2Def,BseDos, BseErr;
  46.   {$ENDIF GUI}
  47. {$ENDIF OS2}
  48.  
  49. {$IFDEF Win95}
  50. Uses
  51.   WinNt, WinBase, WinUser;
  52. {$ENDIF Win95}
  53.  
  54. { constants For SPCC Notification And Error Messages And Month / Day Names. }
  55. {$I SPCC.Inc}
  56.  
  57. Type
  58.   { Pointer To floating Point Value. }
  59.   PExtended = ^Extended;
  60.  
  61. Type
  62.   //Override Exception definition from System To allow formatted Create...
  63.   Exception=Class(SysException)
  64.      Public
  65.          Constructor CreateFmt(Const Msg:String;Const Args:Array Of Const);
  66.          Constructor CreateRes(Ident:Word);
  67.          Constructor CreateResFmt(Ident:Word;Const Args:Array Of Const);
  68.          Constructor CreateResNLS(Ident:Word);
  69.          Constructor CreateResNLSFmt(Ident:Word;Const Args:Array Of Const);
  70.          Constructor CreateHelp(Const Msg:String;AHelpContext:LongInt);
  71.          Constructor CreateFmtHelp(Const Msg:String;Const Args:Array Of Const;AHelpContext:LongInt);
  72.          Constructor CreateResHelp(Ident:Word;AHelpContext:LongInt);
  73.          Constructor CreateResFmtHelp(Ident:Word;Const Args:Array Of Const;AHelpContext:LongInt);
  74.          Constructor CreateResNLSHelp(Ident:Word;AHelpContext:LongInt);
  75.          Constructor CreateResNLSFmtHelp(Ident:Word;Const Args:Array Of Const;AHelpContext:LongInt);
  76.   End;
  77.  
  78.   ExceptClass = Class Of Exception;
  79.  
  80.   EConvertError = Class(Exception);
  81.  
  82. Const
  83.  
  84. { File Open modes - A legal File Open Mode Is A logical combination
  85.   Of an Open Mode And A sharing Mode. Please note that OS/2 Normally
  86.   doesn't allow fmShareCompat, but For reasons Of compatibility the
  87.   File FUNCTIONs automatically replace This constant by
  88.   fmShareDenyNone. }
  89.  
  90.   {$IFDEF OS2}
  91.   fmOpenRead       = $0000;
  92.   fmOpenWrite      = $0001;
  93.   fmOpenReadWrite  = $0002;
  94.   fmShareCompat    = $0000;
  95.   fmShareExclusive = $0010;
  96.   fmShareDenyWrite = $0020;
  97.   fmShareDenyRead  = $0030;
  98.   fmShareDenyNone  = $0040;
  99.   {$ENDIF}
  100.  
  101.   {$IFDEF Win95}
  102.   fmOpenRead       = $80000000;
  103.   fmOpenWrite      = $40000000;
  104.   fmOpenReadWrite  = $C0000000;
  105.   fmShareCompat    = $00000003;
  106.   fmShareExclusive = $00000000;
  107.   fmShareDenyWrite = $00000001;
  108.   fmShareDenyRead  = $00000002;
  109.   fmShareDenyNone  = $00000003;
  110.   {$ENDIF}
  111.  
  112. { File Record}
  113. Type
  114.   TFileRec=FileRec;
  115.  
  116. { File attribute constants - Please note that there Is no constant
  117.   faVolumeID, since OS/2 handles volume Ids In another way than Dos
  118.   does. }
  119. Const
  120.   faReadOnly       = $0001;
  121.   faHidden         = $0002;
  122.   faSysFile        = $0004;
  123.   faDirectory      = $0010;
  124.   faArchive        = $0020;
  125.  
  126.   faAnyFile        = faReadOnly Or faHidden Or faSysFile Or faDirectory Or faArchive;
  127.  
  128. { 'Must' attribute constants - OS/2-specific File attribute constants
  129.   For searching files. Use these constants In logical combination
  130.   With the normal File Attributes when calling FindFirst() To restrict
  131.   the Search results. }
  132.  
  133.   faMustReadOnly   = $0100;
  134.   faMustHidden     = $0200;
  135.   faMustSysFile    = $0400;
  136.   faMustDirectory  = $1000;
  137.   faMustArchive    = $2000;
  138.  
  139. Const
  140.  
  141. { File Lock-TimeOut - This TimeOut Value Is used when performing File
  142.   locking / unlocking operations. Value Is given In ms. }
  143.  
  144.   LockTimeout: LongInt = 5000;
  145.  
  146. Type
  147.  
  148. { support For date And Time operations - both values are stored In
  149.   one floating Point Value. the Integer part Contains the days passed
  150.   since 31-Dec-0000, assuming that the Gregorian calendar has always
  151.   been used. the fractional part Contains the part Of the Day since
  152.   00:00:00. the Time part Is always equal To Or greater than Zero
  153.   And smaller than one. }
  154.  
  155.   TDateTime = Extended;
  156.  
  157. Const
  158.  
  159.   SecsPerDay = 24 * 60 * 60;
  160.   MSecsPerDay = SecsPerDay * 1000;
  161.  
  162. Type
  163.  
  164. { Some Type conversion records. }
  165.  
  166.   WordRec = Record
  167.     Lo, Hi: Byte;
  168.   End;
  169.  
  170.   LongRec = Record
  171.     Lo, Hi: Word;
  172.   End;
  173.  
  174.   TMethod = Record
  175.     Code, Data: Pointer;
  176.   End;
  177.  
  178. { Some useful arrays. }
  179.  
  180.   PByteArray = ^TByteArray;
  181.   TByteArray = Array[0..MaxLongInt] Of Byte;
  182.  
  183.   PWordArray = ^TWordArray;
  184.   TWordArray = Array[0..MaxLongInt Div 2] Of Word;
  185.  
  186. { Generic Procedure Type. }
  187.  
  188.   TProcedure = Procedure;
  189.  
  190. { Generic FileName Type }
  191.  
  192.   TFileName = String;
  193.  
  194. { File Search Record - This Is the Data structure internally used
  195.   by the FindFirst, FindNext, And FindClose FUNCTIONs. }
  196.  
  197.   TSearchRec = Record
  198.     {$IFDEF Win95}
  199.     InternalAttr:LongWord;
  200.     SearchRecIntern:WIN32_FIND_DATA;
  201.     {$ENDIF}
  202.     HDir: LongWord;
  203.     Attr: Byte;
  204.     Time: LongInt;
  205.     Size: LongInt;
  206.     Name: String;
  207.   End;
  208.  
  209. { FloatToText codes - these codes are used To specify the basic
  210.   Output format Of the various FUNCTIONs that Convert floating
  211.   Point values To Strings. }
  212.  
  213.   TFloatFormat = (ffGeneral, ffExponent, ffFixed, ffNumber, ffCurrency);
  214.  
  215. { FloatToDecimal Result Record - This Record Is used To hold the return
  216.   Value Of the FloatToDecimal Function. }
  217.  
  218.   TFloatRec = Record
  219.     Exponent: Integer;
  220.     Negative: Boolean;
  221.     Digits: Array[0..18] Of Char;
  222.   End;
  223.  
  224. Const
  225.  
  226. { Empty String And Pointer To Empty String - used internally by various
  227.   String FUNCTIONs. }
  228.  
  229.   EmptyStr: String[1] = '';
  230.   NullStr: PString = @EmptyStr;
  231.  
  232. Var
  233.  
  234. { --- date, Time, And currency defaults ---
  235.  
  236.   the following global variables contain Default values For formatting
  237.   date, Time, And currency values. most Of them are queried from the
  238.   System At Program startup. Some others are taken from the
  239.   application's resources. }
  240.  
  241. { DateSeparator - the character used To separate Year, Month, And Day,
  242.   when converting A TDateTime Value To Text. queried from the System
  243.   At Program startup. }
  244.  
  245.   DateSeparator: Char;
  246.  
  247. { ShortDateFormat - the Default format String used when converting a
  248.   TDateTime Value To Text. This one Is used whenever A short Result
  249.   Is desired. the Value Is computed At Program startup. }
  250.  
  251.   ShortDateFormat: String[15];
  252.  
  253. { LongDateFormat - the Default format String used when converting a
  254.   TDateTime Value To Text. This one Is used whenever A LONG Result
  255.   Is desired. the Value Is computed At Program startup. }
  256.  
  257.   LongDateFormat: String[31];
  258.  
  259. { ShortMonthNames - Abbreviations For Month Names used when converting
  260.   A TDateTime Value To Text. the Names are taken from the program's
  261.   resources. }
  262.  
  263.   ShortMonthNames: Array[1..12] Of String[7];
  264.  
  265. { LongMonthNames - the full Month Names used when converting a
  266.   TDateTime Value To Text. the Names are taken from the program's
  267.   resources. }
  268.  
  269.   LongMonthNames: Array[1..12] Of String[15];
  270.  
  271. { ShortDayNames - Abbreviations For Day Names used when converting
  272.   A TDateTime Value To Text. the Names are taken from the program's
  273.   resources. }
  274.  
  275.   ShortDayNames: Array[1..7] Of String[7];
  276.  
  277. { LongDayNames - the full Day Names used when converting A TDateTime
  278.   Value To Text. the Names are taken from the program's resources. }
  279.  
  280.   LongDayNames: Array[1..7] Of String[15];
  281.  
  282. { DateOrder - the order Of Year, Month, And Day assumed when trying To
  283.   extract date information from A String. queried from the System At
  284.   Program startup. }
  285.  
  286.   DateOrder: Byte;
  287.  
  288. { TimeSeparator - the character used To separate Hour, Minute, And
  289.   Second, when converting A TDateTime Value To Text. queried from the
  290.   System At Program startup. }
  291.  
  292.   TimeSeparator: Char;
  293.  
  294. { TimeAMString - the String appended To Time values between 00:00 And
  295.   11:59 when converting A DateTime Value To Text. only used when
  296.   12-Hour clock format Is used. queried from the System At Program
  297.   startup. }
  298.  
  299.   TimeAMString: String[7];
  300.  
  301. { TimePMString - the String appended To Time values between 12:00 And
  302.   23:59 when converting A DateTime Value To Text. only used when
  303.   12-Hour clock format Is used. queried from the System At Program
  304.   startup. }
  305.  
  306.   TimePMString: String[7];
  307.  
  308. { ShortTimeFormat - the Default format String used when converting a
  309.   TDateTime Value To Text. This one Is used whenever A shorter Result
  310.   Is desired. queried from the System At Program startup. }
  311.  
  312.   ShortTimeFormat: String[15];
  313.  
  314. { LongTimeFormat - the Default format String used when converting a
  315.   TDateTime Value To Text. This one Is used whenever A longer Result
  316.   Is desired. queried from the System At Program startup. }
  317.  
  318.   LongTimeFormat: String[31];
  319.  
  320. { TwelveHours - Indicates whether 12-Hour clock format Is used when
  321.   trying To extract Time information from A String. queried from
  322.   the System At Program startup. }
  323.  
  324.   TwelveHours: Boolean;
  325.  
  326. { CurrencyString - the local currency String used when converting
  327.   currency values To Text. Default Value Is queried from the System
  328.   At Program startup. }
  329.  
  330.   CurrencyString: String[7];
  331.  
  332. { CurrencyFormat - the order Of currency Value, currency String, And
  333.   separating space used when converting currency values To Text.
  334.   Default Value Is queried from the System At Program startup.
  335.  
  336.   the following values four are possible, With the fifth one
  337.   being an additional Value that Is only supported by OS/2:
  338.  
  339.     0 = '$1'       1 = '1$'       2 = '$ 1'      3 = '1 $'
  340.  
  341.     4 = currency String replaces DECIMAL indicator }
  342.  
  343.   CurrencyFormat: Byte;
  344.  
  345. { NegCurrFormat - Corresponds To CurrencyFormat, but Is used when
  346.   converting Negative currency values To Text. queried from the
  347.   System At Program startup.
  348.  
  349.   the following values are possible:
  350.  
  351.     0 = '($1)'     1 = '-$1'      2 = '$-1'      3 = '$1-'
  352.     4 = '(1$)'     5 = '-1$'      6 = '1-$'      7 = '1$-'
  353.     8 = '-1 $'     9 = '-$ 1'    10 = '$ 1-'
  354.  
  355.   since OS/2 doesn't support A Special format For Negative currency
  356.   values, A format Is chosen that matches the CurrencyFormat With
  357.   A preceding '-'. the following List shows the possible values:
  358.  
  359.     CurrencyFormat           NegCurrFormat
  360.  
  361.       0 = '$1'                 1 = -$1
  362.       1 = '1$'                 5 = -1$
  363.       2 = '$ 1'                9 = -$ 1
  364.       3 = '1 $'                8 = -1 $ }
  365.  
  366.   NegCurrFormat: Byte;
  367.  
  368. { ThousandSeparator - the character used To separate blocks Of three
  369.   Digits when converting floating Point values To Text. queried from
  370.   the System At Program startup. }
  371.  
  372.  ThousandSeparator: Char;
  373.  
  374.  { DecimalSeparator - the character used To separate the Integer part
  375.   from the fractional part when converting floating Point values To
  376.   Text. queried from the System At Program startup. }
  377.  
  378.   DecimalSeparator: Char;
  379.  
  380. { CurrencyDigits - the Number Of Digits used In the fractional part
  381.   Of A currency Value when converting A currency Value To Text.
  382.   queried from the System At Program startup. }
  383.  
  384.   CurrencyDecimals: Byte;
  385.  
  386. { ListSeparator - the character To Use when separating Items In A List.
  387.   Currently Not used by any Function. }
  388.  
  389.   ListSeparator: Char;
  390.  
  391. { --- Memory management --- }
  392.  
  393. { AllocMem - Allocates A Memory block Of the desired Size ON the heap.
  394.   In contrast To the GetMem Standard Procedure, AllocMem fills the
  395.   whole block With zeroes. }
  396.  
  397. Function AllocMem(Size: Cardinal): Pointer;
  398.  
  399. { ReAllocMem - re-Allocates A previously allocated Memory block And
  400.   changes its Size. copies the contents Of the old block into the
  401.   New one. CurSize And NewSize specify the Current And the New Size
  402.   Of the block. If the New Size Is larger than the Current Size, the
  403.   additional Bytes are zeroed. the old Memory block Is automatically
  404.   disposed. note that the resulting Pointer will always be different
  405.   from the old Pointer, even If the Size isn't changed. the Function
  406.   can Handle Nil pointers And Zero blocks. }
  407.  
  408. Function ReAllocMem(P: Pointer; CurSize, NewSize: Cardinal): Pointer;
  409.  
  410. { --- Exit Procedure Handling --- }
  411.  
  412. { AddExitProc - Adds A parameterless Procedure To the List Of
  413.   procedures To be called when the Program Is Terminated. note that
  414.   the Procedure that Is added Last will be called First. }
  415.  
  416. Procedure AddExitProc(Proc: TProcedure);
  417.  
  418. { CallExitProcs - calls All procedures that were installed by
  419.   AddExitProc And deletes them from the List. note that the
  420.   Procedure that was added Last will be called First. }
  421.  
  422. Procedure CallExitProcs;
  423.  
  424. { --- String Handling --- }
  425.  
  426. { NewStr - Allocates A block Of Memory ON the heap And fills it With
  427.   the given String, returns A PString To the Memory block. the Memory
  428.   block's Size will be exactly one Byte more than the string's Real
  429.   Length. Empty Strings don't Use any heap space, the Function returns
  430.   NullStr In This Case. since NullStr Points To EmptyStr, the Function
  431.   never returns Nil, So you can always de-Reference the resulting
  432.   Pointer. Use DisposeStr To Free the Memory block. }
  433.  
  434. Function NewStr(Const S: String): PString;
  435.  
  436. { DisposeStr - Disposes A block Of Memory ON the heap that Contains
  437.   A String. the block MUST have been allocated by A call To NewStr.
  438.   If the given Pointer Is NullStr (And thereby references the Empty
  439.   String) Or Nil, the Function does absolutely Nothing. }
  440.  
  441. Procedure DisposeStr(P: PString);
  442.  
  443. { AssignStr - Assigns A New Value To A String Pointer that has been
  444.   previously allocated by A call To NewStr, Or Is Nil. the old String
  445.   Is disposed by DisposeStr, And the New one Is allocated by NewStr. }
  446.  
  447. Procedure AssignStr(Var P: PString; Const S: String);
  448.  
  449. { AppendStr - Appends A String To the End Of another. }
  450.  
  451. Procedure AppendStr(Var Dest: String; Const S: String);
  452.  
  453. { uppercase - Converts A String To upper Case by simply Changing All
  454.   occurences Of 'a'..'z' To the corresponding upper Case characters.
  455.   If you want A conversion that also considers international Special
  456.   characters, Use AnsiUpperCase. }
  457.  
  458. Function uppercase(Const S: String): String;
  459.  
  460. { lowercase - Converts A String To lower Case by simply Changing All
  461.   occurences Of 'A'..'Z' To the corresponding lower Case characters.
  462.   If you want A conversion that also considers international Special
  463.   characters, Use AnsiLowerCase. }
  464.  
  465. Function lowercase(Const S: String): String;
  466.  
  467. { CompareStr - Compares two Strings And returns an Integer Value
  468.   As In the following Table:
  469.  
  470.     s1 < s2       Result < 0
  471.     s1 = s2       Result = 0
  472.     s1 > s2       Result > 0
  473.  
  474.   CompareStr Is Case-sensitive, but does Not take international
  475.   Special characters Or the Currently Selected codepage into account. }
  476.  
  477. Function CompareStr(Const s1, s2: String): Integer;
  478.  
  479. { CompareText - Compares two Strings And returns an Integer Value
  480.   As In the following Table:
  481.  
  482.     s1 < s2       Result < 0
  483.     s1 = s2       Result = 0
  484.     s1 > s2       Result > 0
  485.  
  486.   CompareText Is Case-insensitive, And does Not take international
  487.   Special characters Or the Currently Selected codepage into account. }
  488.  
  489. Function CompareText(Const s1, s2: String): Integer;
  490.  
  491. { AnsiUpperCase - Converts A String To upper Case. This Function
  492.   also takes international Special characters And the Currently
  493.   Selected codepage into account. If you don't want This, Use
  494.   uppercase. }
  495.  
  496. Function AnsiUpperCase(Const S: String): String;
  497.  
  498. { AnsiLowerCase - Converts A String To lower Case. This Function
  499.   also takes international Special characters And the Currently
  500.   Selected codepage into account. If you don't want This, Use
  501.   lowercase. note that AnsiLowerCase Is Not available under OS/2. }
  502.  
  503. {$IFNDEF OS2}
  504. Function AnsiLowerCase(Const S: String): String;
  505. {$ENDIF}
  506.  
  507. { AnsiCompareStr - Compares two Strings And returns an Integer Value
  508.   As In the following Table:
  509.  
  510.     s1 < s2       Result < 0
  511.     s1 = s2       Result = 0
  512.     s1 > s2       Result > 0
  513.  
  514.   AnsiCompareStr Is Case-sensitive, And takes international Special
  515.   characters And the Currently Selected codepage into account. note
  516.   that the Function Is Not available under OS/2. }
  517.  
  518. {$IFNDEF OS2}
  519. Function AnsiCompareStr(Const s1, s2: String): Integer;
  520. {$ENDIF}
  521.  
  522. { AnsiCompareText - Compares two Strings And returns an Integer Value
  523.   As In the following Table:
  524.  
  525.     s1 < s2       Result < 0
  526.     s1 = s2       Result = 0
  527.     s1 > s2       Result > 0
  528.  
  529.   AnsiCompareText Is Case-insensitive, And takes international Special
  530.   characters And the Currently Selected codepage into account. }
  531.  
  532. Function AnsiCompareText(Const s1, s2: String): Integer;
  533.  
  534. { Trim - Removes leading And trailing spaces And Control characters. }
  535.  
  536. Function Trim(Const S: String): String;
  537.  
  538. { TrimLeft - Removes leading spaces And Control characters. }
  539.  
  540. Function TrimLeft(Const S: String): String;
  541.  
  542. { TrimRight - Removes trailing spaces And Control characters. }
  543.  
  544. Function TrimRight(Const S: String): String;
  545.  
  546. { QuotedStr - returns the given String enclosed In quotes. quotes already
  547.   included In the String are returned As two quote characters. }
  548.  
  549. Function QuotedStr(Const S: String): String;
  550.  
  551. { IsValidIdent - Checks whether the given String Contains A legal
  552.   Pascal identifier. check your Speed-Pascal manual To See what A
  553.   legal identifier looks like. :-) }
  554.  
  555. Function IsValidIdent(Const Ident: String): Boolean;
  556.  
  557. { IntToStr - Converts an Integer Value To A String Of Digits. }
  558.  
  559. Function IntToStr(Value: LongInt): String;
  560.  
  561. { IntToHex - Converts an Integer Value To A String Of hexadecimal
  562.   Digits. the minimum desired Number Of Digits can be specified.
  563.   If the Result Contains less Digits, it Is Left-padded With zeroes. }
  564.  
  565. Function IntToHex(Value: LongInt; Digits: Integer): String;
  566.  
  567. { StrToInt - Extracts an Integer Value from A String. If the String
  568.   doesn't contain A legal Integer Value, Exception EConvertError
  569.   Is raised. }
  570.  
  571. Function StrToInt(Const S: String): LongInt;
  572.  
  573. { StrToIntDef - Extracts an Integer Value from A String. If the String
  574.   doesn't contain A legal Integer Value, the desired Default Value
  575.   Is returned instead. }
  576.  
  577. {$IFDEF GUI}
  578. Function StrToIntDef(Const S: String; Default: LongInt): LongInt;
  579. {$ENDIF GUI}
  580.  
  581. { LoadStr - Loads A String from the application's resources. the
  582.   String Is retrieved by an Integer Number. If the resources don't
  583.   contain A String With the given Number, LoadStr returns an Empty
  584.   String. }
  585.  
  586. {$IFDEF GUI}
  587. Function LoadStr(Ident: Word): String;
  588. {$ENDIF GUI}
  589.  
  590. { LoadNLSStr - Loads A String from the application's Current Language Table. the
  591.   String Is retrieved by an Integer Number. If the resources don't
  592.   contain A String With the given Number, LoadStr returns an Empty
  593.   String. }
  594.  
  595. Function LoadNLSStr(Ident: Word): String;
  596.  
  597. { LoadTableStr - Loads A String from the specified String Table. the
  598.   String Is retrieved by an Integer Number. If the resources don't
  599.   contain A String With the given Number, LoadStr returns an Empty
  600.   String. }
  601.  
  602. Function LoadTableStr(Const Table:String;Ident: Word): String;
  603.  
  604. { FmtLoadStr - Loads A String from the application's resources And
  605.   replaces Some placeholders by values given In an Open-Array. the
  606.   String Is retrieved by an Integer Number. If the resources don't
  607.   contain A String With the given Number, FmtLoadStr returns an
  608.   Empty String. }
  609.  
  610. {$IFDEF GUI}
  611. Function FmtLoadStr(Ident: Word; Const Args: Array Of Const): String;
  612. {$ENDIF GUI}
  613.  
  614. { FmtLoadNLSStr - Loads A String from the application's Current Language Table And
  615.   replaces Some placeholders by values given In an Open-Array. the
  616.   String Is retrieved by an Integer Number. If the resources don't
  617.   contain A String With the given Number, FmtLoadStr returns an
  618.   Empty String. }
  619.  
  620. Function FmtLoadNLSStr(Ident: Word; Const Args: Array Of Const): String;
  621.  
  622. { FmtLoadTableStr - Loads A String from the specified String Table And
  623.   replaces Some placeholders by values given In an Open-Array. the
  624.   String Is retrieved by an Integer Number. If the resources don't
  625.   contain A String With the given Number, FmtLoadStr returns an
  626.   Empty String. }
  627.  
  628. Function FmtLoadTableStr(Const Table:String;Ident: Word; Const Args: Array Of Const): String;
  629.  
  630.  
  631. { SysErrorMessage - returns A System Error Message. }
  632.  
  633. {$IFDEF OS2}
  634. Function SysErrorMessage(MsgNum: LongInt): String;
  635. {$ENDIF OS2}
  636.  
  637. { --- File management --- }
  638.  
  639. { FileOpen - Opens an existing File With A given File Mode. the File
  640.   Mode Is A logical combination Of one Of the File Open constants
  641.   (fmOpenXXX) And one Of the sharing Mode constants (fmShareXXX). If
  642.   the File Is successfully opended, the resulting Integer Value Is
  643.   positive And Contains the File Handle. Otherwise the Result Is the
  644.   Negative Value Of the Error Code returned by the operating System. }
  645.  
  646. Function FileOpen(Const FileName: String; Mode: Word): LongInt;
  647.  
  648. { FileCreate - creates A New File Or overwrites an existing one. no
  649.   File Mode can be specified, So the File Is always created With
  650.   fmOpenWrite Or fmShareExclusive. If the File Is successfully
  651.   created, the resulting Integer Value Is positive And Contains the
  652.   File Handle. Otherwiese the Result Is the Negative Value Of the
  653.   Error Code returned by the operating System. }
  654.  
  655. Function FileCreate(Const FileName: String): LongInt;
  656.  
  657. { FileOpenOrCreate - Opens Or creates A File, depending ON whether
  658.   the File already exists Or Not. A File Mode can be specified. the
  659.   File Mode Is A logical combination Of one Of the File Open constants
  660.   (fmOpenXXX) And one Of the sharing Mode constants (fmShareXXX). If
  661.   the File Is successfully opended Or created, the resulting Integer
  662.   Value Is positive And Contains the File Handle. Otherwise the
  663.   Result Is the Negative Value Of the Error Code returned by the
  664.   operating System. }
  665.  
  666. Function FileOpenOrCreate(Const FileName: String; Mode: Word): LongInt;
  667.  
  668. { FileCreateIfNew - creates A File If there's Not already A File With
  669.   the same Name. A File Mode can be specified. the File Mode Is a
  670.   logical combination Of one Of the File Open constants (fmOpenXXX)
  671.   And one Of the sharing Mode constants (fmShareXXX). If the New File
  672.   Is successfully created, the resulting Integer Value Is positive And
  673.   Contains the File Handle. Otherwise the Result Is the Negative Value
  674.   Of the Error Code returned by the operating System. note that This
  675.   Function also fails If the File already exists. }
  676.  
  677. Function FileCreateIfNew(Const FileName: String; Mode: Word): LongInt;
  678.  
  679. { FileRead - Attempts To Read up To Count Bytes from the given File
  680.   Handle And returns the Number Of Bytes actually Read. If an Error
  681.   occurs, the Result Is -1. }
  682.  
  683. Function FileRead(Handle: LongInt; Var Buffer; Count: LongInt): LongInt;
  684.  
  685. { FileWrite - Attempts To Write up To Count Bytes To the given File
  686.   Handle And returns the Number Of Bytes actually written. If an Error
  687.   occurs, the Result Is -1. }
  688.  
  689. Function FileWrite(Handle: LongInt; Const Buffer; Count: LongInt): LongInt;
  690.  
  691. { FileSeek - changes the Current Position Of A File Handle by Count
  692.   Bytes. the actual Movement depends ON the Value Of Origin, according
  693.   To the following Table:
  694.  
  695.     Origin        Action
  696.  
  697.       0           Move relative To the file's beginning
  698.       1           Move relative To the Current Position
  699.       2           Move relative To the file's End
  700.  
  701.   the Function returns the New Position, Or -1 If an Error occured. }
  702.  
  703. Function FileSeek(Handle: LongInt; Offset: LongInt; Origin: Integer): LongInt;
  704.  
  705. { FileClose - Closes A File And frees the Handle. }
  706.  
  707. Procedure FileClose(Handle: LongInt);
  708.  
  709. { FileLock - Locks A Range Of A File For exclusive access by the
  710.   Application. returns A Boolean Value indicating Success Or
  711.   failure. note that the Function waits up To the Time specified
  712.   In the LockTimeout global variable before it fails. }
  713.  
  714. Function FileLock(Handle, Offset, Range: LongInt): Boolean;
  715.  
  716. { FileUnLock - Unlocks A Range Of A File that was previously locked
  717.   For exclusive access by the Application. returns A Boolean Value
  718.   indicating Success Or failure. }
  719.  
  720. Function FileUnLock(Handle, Offset, Range: LongInt): Boolean;
  721.  
  722. { FileAge - returns the date And Time Of A file's Last modification.
  723.  
  724.   If the File doesn't exist, -1 Is returned instead.
  725.  
  726.   To Use date / Time formatting FUNCTIONs For This Value, Convert it
  727.   To A TDateTime by A call To FileDateToDateTime First. }
  728.  
  729. Function FileAge(Const FileName: String): LongInt;
  730.  
  731. { FileExists - Indicates whether A File exists Or Not. }
  732.  
  733. Function FileExists(Const FileName: String): Boolean;
  734.  
  735. { FindFirst - Starts A Search For files specified by A Name Pattern
  736.   And File Attributes.
  737.  
  738.   any Pattern that Is allowed ON the Command Line Is also A legal
  739.   argument For Path.
  740.  
  741.   Attr Is A logical combination Of File Attributes (faXXX) And
  742.   File-MUST Attributes (faMustXXX), the latter being available only
  743.   under OS/2.
  744.  
  745.   the Var SearchRec will contain Name And Attributes Of the First File
  746.   that matched the given specs. In This Case the Function returns 0.
  747.   If an Error occurs, the Result Is the Negative Value Of the Error
  748.   Code returned by the operating System.
  749.  
  750.   Use FindNext To Find more files And FindClose To End the File
  751.   Search. note that you MUST Use FindClose, Or you may Run out Of
  752.   handles after A While. }
  753.  
  754. Function FindFirst(Const Path: String; Attr: Integer; Var SearchRec: TSearchRec): LongInt;
  755.  
  756. { FindNext - after A call To FindNext, the Var SearchRec Contains the
  757.   Next File that matches the specs Of A File Search previously started
  758.   by FindFirst.
  759.  
  760.   A return Value Of 0 Indicates Success. you may call FindNext Until
  761.   an Error occures (With the Negative Value Of the operating system's
  762.   Error Code returned), Or Until no more matching files are found
  763.   (usually indicated by A return Value Of -18.) }
  764.  
  765. Function FindNext(Var SearchRec: TSearchRec): LongInt;
  766.  
  767. { FindClose - Ends A File Search previously started by FindFirst. note
  768.   that you MUST Use FindClose, Or you may Run out Of handles after a
  769.   While. }
  770.  
  771. Procedure FindClose(Var SearchRec: TSearchRec);
  772.  
  773. { FileGetDate - returns the date And Time Of A file's Last
  774.   modification. If the given File Handle Is invalid, -1 Is returned
  775.   instead.
  776.  
  777.   To Use date / Time formatting FUNCTIONs For the Result, Convert
  778.   it To A TDateTime by A call To FileDateToDateTime First. }
  779.  
  780. Function FileGetDate(Handle: LongInt): LongInt;
  781.  
  782. { FileSetDate - changes the date And Time Of A file's Last
  783.   modification. If the Operation fails due To an invalid Handle Or
  784.   an illegal Age Parameter, the date And Time remain unchanged.
  785.  
  786.   This Procedure doesn't Accept TDateTime values. you have To Convert
  787.   them To A LongInt by DateTimeToFileDate First. }
  788.  
  789. Procedure FileSetDate(Handle: Integer; Age: LongInt);
  790.  
  791. { FileGetAttr - returns A file's Attributes. the Result Value Is a
  792.   logical combination Of File attribute constants (faXXX). If the
  793.   Function fails due To A non-existing File Or another Error
  794.   condition, the Result Is the Negative Value Of the operating
  795.   system's Error Code. }
  796.  
  797. Function FileGetAttr(Const FileName: String): LongInt;
  798.  
  799. { FileSetAttr - changes A file's Attributes. the Attr Parameter may
  800.   contain any logical combination Of File attribute constants
  801.   (faXXX). A Result Value Of 0 Indicates Success. If the Function
  802.   fails due To A non-existing File Or another Error condition, the
  803.   Result Is the Negative Value Of the operating system's Error Code. }
  804.  
  805. Function FileSetAttr(Const FileName: String; Attr: Integer): Integer;
  806.  
  807. { CopyFile - copies A File. Result Is A Boolean indicating Success Or
  808.   failure. }
  809.  
  810. Function CopyFile(Const SourceName, DestName: String): Boolean;
  811.  
  812. { DeleteFile - deletes A File. Result Is A Boolean indicating Success
  813.   Or failure. }
  814.  
  815. Function DeleteFile(Const FileName: String): Boolean;
  816.  
  817. { RenameFile - Renames A File. Result Is A Boolean indicating Success
  818.   Or failure. you may Use RenameFile To Move A File To A New location,
  819.   but only If the Drive stays the same. }
  820.  
  821. Function RenameFile(Const OldName, NewName: String): Boolean;
  822.  
  823. { ChangeFileExt - changes the extension Of A given FileName. the
  824.   extension Is the part from the rightmost dot To the End Of the
  825.   FileName. If the old FileName doesn't contain an extension, it
  826.   Is simply added. the extension MUST Start With A dot.
  827.  
  828.   note that the Function only handles A String, but does Not Perform
  829.   any Physical changes To files. }
  830.  
  831. Function ChangeFileExt(Const FileName, extension: String): String;
  832.  
  833. { ExtractFilePath - returns the Drive And Directory parts Of a
  834.   FileName, that Is, everything from the Start To the rightmost colon
  835.   Or backslash In the String. If the FileName doesn't contain Drive Or
  836.   Directory information, an Empty String Is returned. }
  837.  
  838. Function ExtractFilePath(Const FileName: String): String;
  839.  
  840. { ExtractFileName - returns the Name And extension parts Of A
  841.   FileName, that Is, everything from rightmost colon Or backslash To
  842.   the End Of the String. If the FileName doesn't contain A Name Or
  843.   extension, an Empty String Is returned. }
  844.  
  845. Function ExtractFileName(Const FileName: String): String;
  846.  
  847. { ExtractFileExt - returns the extension part Of A FileName, that Is,
  848.   everything from rightmost dot To the End Of the String. If the
  849.   FileName doesn't contain A dot, an Empty String Is returned. }
  850.  
  851. Function ExtractFileExt(Const FileName: String): String;
  852.  
  853. { ConcatFileName - Concatenates two filenames, assuming the First
  854.   one specifies Some Kind Of Directory information, And the Second
  855.   one A FileName. the Result Is A Complete legal pathname. the
  856.   Function automatically inserts A backslash, If necessary. }
  857.  
  858. Function ConcatFileName(Const pathname, FileName: String): String;
  859.  
  860. { ExpandFileName - Expands A FileName To an Absolute FileName, that
  861.   Is, A FileName containing A Drive letter, Directory information
  862.   relative To the root Of the Drive, And the FileName. Embedded '..'
  863.   are removed. }
  864.  
  865. Function ExpandFileName(FileName: String): String;
  866.  
  867. { EditFileName - changes A FileName using A Pattern possibly
  868.   containing the wildcards '*' And '?'. everything that would
  869.   be Accepted by the Copy Command should be legal For Name And
  870.   edit. }
  871.  
  872. Function EditFileName(Const Name, edit: String): String;
  873.  
  874. { FileSearch - Searches For A File Name In A List Of directories
  875.   given by DirList. the Directory entries MUST be separated by
  876.   semicolons, just like the system's Path. the working Directory
  877.   Is implicitly prepended To the List Of directories. the Result
  878.   String Is either the First occurence Of the File Complete With
  879.   the Directory it was found In, Or the Empty String, If the File
  880.   could Not be found. }
  881.  
  882. Function FileSearch(Const Name, DirList: String): String;
  883.  
  884. { DiskFree - returns the Free space Of the given disk Drive. Drive 0
  885.   Is the Current Drive, Drive 1 Is 'A:', And So ON. If the given Drive
  886.   Is invalid Or cannot be Read, -1 Is returned, Otherwise the Result
  887.   Contains the Number Of Bytes Free. }
  888.  
  889. Function DiskFree(Drive: Byte): LongInt;
  890.  
  891. { DiskSize - returns the disk Size Of the given disk Drive. Drive 0
  892.   Is the Current Drive, Drive 1 Is 'A:', And So ON. If the given Drive
  893.   Is invalid Or cannot be Read, -1 Is returned, Otherwise the Result
  894.   Contains the Number Of Bytes that can be potentially used For File
  895.   storage. }
  896.  
  897. Function DiskSize(Drive: Byte): LongInt;
  898.  
  899. { FileDateToDateTime - Converts A File date / Time Value To a
  900.   TDateTime that can be used within formatting operations. }
  901.  
  902. Function FileDateToDateTime(FileDate: LongInt): TDateTime;
  903.  
  904. { FileDateToDateTime - Converts A TDateTime To A File date / Time
  905.   Value that can be used within File FUNCTIONs. }
  906.  
  907. Function DateTimeToFileDate(DateTime: TDateTime): LongInt;
  908.  
  909. { --- 'C'-like String Handling --- }
  910.  
  911. { StrLen - returns the Length Of Str, ignoring the terminating Zero. }
  912.  
  913. Function StrLen(Str: PChar): Cardinal;
  914.  
  915. { StrEnd - returns A Pointer To the terminating Zero Of Str. }
  916.  
  917. Function StrEnd(Str: PChar): PChar;
  918.  
  919. { StrMove - copies exactly Count characters from Source To Dest. It's
  920.   okay when Source And Dest overlap, StrMove can Handle This. }
  921.  
  922. Function StrMove(Dest, Source: PChar; Count: Cardinal): PChar;
  923.  
  924. { StrCopy - copies Source To Dest And returns Dest. }
  925.  
  926. Function StrCopy(Dest, Source: PChar): PChar;
  927.  
  928. { StrECopy - copies Source To Dest And returns A Pointer To the
  929.   terminating Zero Of the resulting String. }
  930.  
  931. Function StrECopy(Dest, Source: PChar): PChar;
  932.  
  933. { StrLCopy - copies A maximum Of MaxLen characters from Source To Dest
  934.   And returns Dest. }
  935.  
  936. Function StrLCopy(Dest, Source: PChar; MaxLen: Cardinal): PChar;
  937.  
  938. { StrPCopy - copies A Pascal String Source To A PChar Dest And returns
  939.   Dest. }
  940.  
  941. Function StrPCopy(Dest: PChar; Const Source: String): PChar;
  942.  
  943. { StrPLCopy - copies A maximum Of MaxLen characters from A Pascal
  944.   String Source To A PChar Dest. returns Dest. }
  945.  
  946. Function StrPLCopy(Dest: PChar; Const Source: String; MaxLen: Cardinal): PChar;
  947.  
  948. { StrCat - Concatenates Dest And Source, that Is, Appends Source To
  949.   the End Of Dest, And returns Dest. }
  950.  
  951. Function StrCat(Dest, Source: PChar): PChar;
  952.  
  953. { StrLCat - Concatenates Dest And Source, that Is, Appends Source To
  954.   the End Of Dest, but copies only So many characters that the
  955.   resulting String does Not exceed MaxLen characters. returns Dest. }
  956.  
  957. Function StrLCat(Dest, Source: PChar; MaxLen: Cardinal): PChar;
  958.  
  959. { StrComp - Compares two Strings And returns an Integer Value
  960.   As In the following Table:
  961.  
  962.     Str1 < Str2       Result < 0
  963.     Str1 = Str2       Result = 0
  964.     Str1 > Str2       Result > 0
  965.  
  966.   StrComp Is Case-sensitive, but does Not take international Special
  967.   characters Or the Currently Selected codepage into account. }
  968.  
  969. Function StrComp(Str1, Str2: PChar): Integer;
  970.  
  971. { StrIComp - Compares two Strings And returns an Integer Value
  972.   As In the following Table:
  973.  
  974.     Str1 < Str2       Result < 0
  975.     Str1 = Str2       Result = 0
  976.     Str1 > Str2       Result > 0
  977.  
  978.   StrComp Is Case-insensitive, And does Not take international
  979.   Special characters Or the Currently Selected codepage into account. }
  980.  
  981. Function StrIComp(Str1, Str2: PChar): Integer;
  982.  
  983. { StrLComp - Compares up To MaxLen characters Of two Strings And
  984.   returns an Integer Value As In the following Table:
  985.  
  986.     Str1 < Str2       Result < 0
  987.     Str1 = Str2       Result = 0
  988.     Str1 > Str2       Result > 0
  989.  
  990.   StrLComp Is Case-sensitive, but does Not take international Special
  991.   characters Or the Currently Selected codepage into account. }
  992.  
  993. Function StrLComp(Str1, Str2: PChar; MaxLen: Cardinal): Integer;
  994.  
  995. { StrLIComp - Compares up To MaxLen characters Of two Strings And
  996.   returns an Integer Value As In the following Table:
  997.  
  998.     Str1 < Str2       Result < 0
  999.     Str1 = Str2       Result = 0
  1000.     Str1 > Str2       Result > 0
  1001.  
  1002.   StrLComp Is Case-insensitive, And does Not take international
  1003.   Special characters Or the Currently Selected codepage into account. }
  1004.  
  1005. Function StrLIComp(Str1, Str2: PChar; MaxLen: Cardinal): Integer;
  1006.  
  1007. { StrScan - Searches For the First occurence Of A character In A
  1008.   String. returns the Pointer To the occurence, Or Nil, If the
  1009.   character cannot be found. }
  1010.  
  1011. Function StrScan(Str: PChar; Chr: Char): PChar;
  1012.  
  1013. { StrRScan - Searches For the Last occurence Of A character In A
  1014.   String. returns the Pointer To the occurence, Or Nil, If the
  1015.   character cannot be found. }
  1016.  
  1017. Function StrRScan(Str: PChar; Chr: Char): PChar;
  1018.  
  1019. { StrScan - Searches For the First occurence Of A SubStr In A given
  1020.   String Str. returns the Pointer To the occurence, Or Nil, If the
  1021.   SubStr cannot be found. }
  1022.  
  1023. Function StrPos(Str, SubStr: PChar): PChar;
  1024.  
  1025. { StrUpper - Converts A String To upper Case by simply Changing All
  1026.   occurences Of 'a'..'z' To the corresponding upper Case characters.
  1027.   returns A Pointer To the String. changes the Source String, does
  1028.   Not Create A New String. does also Not take international Special
  1029.   characters Or the Currently Selected codepage into account. }
  1030.  
  1031. Function StrUpper(Str: PChar): PChar;
  1032.  
  1033. { StrLower - Converts A String To lower Case by simply Changing All
  1034.   occurences Of 'A'..'Z' To the corresponding lower Case characters.
  1035.   returns A Pointer To the String.  changes the Source String, does
  1036.   Not Create A New String. does also Not take international Special
  1037.   characters Or the Currently Selected codepage into account. }
  1038.  
  1039. Function StrLower(Str: PChar): PChar;
  1040.  
  1041. { StrPas - Converts A PChar Str To A Pascal String. }
  1042.  
  1043. Function StrPas(Str: PChar): String;
  1044.  
  1045. { StrAlloc - Allocates A block Of Memory For storing PChars. the Size
  1046.   Is specified And stored In A Double Word that preceeds the Buffer.
  1047.   Use StrDispose To Free the Buffer. }
  1048.  
  1049. Function StrAlloc(Size: Cardinal): PChar;
  1050.  
  1051. { StrBufSize - returns the Size Of A PChar Buffer that has been
  1052.   previously allocated by StrAlloc. }
  1053.  
  1054. Function StrBufSize(Str: PChar): Cardinal;
  1055.  
  1056. { StrNew - creates A Copy Of A given String. In contrast To StrCopy,
  1057.   StrNew Allocates A Memory block that can hold the String, by a
  1058.   call To StrAlloc. Then it copies the Source String. the New
  1059.   String can be disposed by A call To StrDispose. }
  1060.  
  1061. Function StrNew(Str: PChar): PChar;
  1062.  
  1063. { StrDispose - Disposes A PChar Buffer that has been previously
  1064.   allocated by A call To StrAlloc. }
  1065.  
  1066. Procedure StrDispose(Str: PChar);
  1067.  
  1068. { --- String formatting --- }
  1069.  
  1070. { format - formats A String And replaces placeholders by arguments.
  1071.  
  1072.   the format String can contain arbitrary Text. This Text Is simply
  1073.   copied into the Result. everything that Starts With A '%' Is
  1074.   considered A placeholder. placeholders are replaced by the
  1075.   Parameters given In the variant-Type Open-Array Args. the First
  1076.   placeholder Is replaced by the First argument, the Second one
  1077.   by the Second argument, And So ON. you MUST specify At least As many
  1078.   Parameters As there are placeholders, Otherwise an Exception
  1079.   EConvertError will be raised.
  1080.  
  1081.   the way A placeholder / argument pair will be Handled Is controlled
  1082.   by Some optional specifiers. the Line below shows the possibilities.
  1083.  
  1084.   Text In " " MUST appear literally, 'index', 'width' And 'precision'
  1085.   MUST be replaced by Integer numbers, And 'type' MUST be replaced by
  1086.   A character that specifies the argument Type.
  1087.  
  1088.   parts enclosed In angular brackets are optional, the angular
  1089.   brackets MUST Not appear In the format specifier, they are only used
  1090.   To Show the syntax.
  1091.  
  1092.     "%" [Index ":"] ["-"] [Width] ["." Precision] Type
  1093.  
  1094.   the different parts Of the format specifier MUST appear In the
  1095.   given order, And they have the following meaning:
  1096.  
  1097.     "%"                Begins the format specifier
  1098.  
  1099.     Index ":"          takes the Next argument from the Array entry
  1100.                        given by Integer Value Index. Normally the
  1101.                        arguments are used one after the other. This
  1102.                        part Of the format specifier allows To Change
  1103.                        This behaviour.
  1104.  
  1105.     "-"                Left-Justifies the Text inserted For the format
  1106.                        specifier. Normally the Text Is justified To
  1107.                        the Right. only applies If the String Is Left-
  1108.                        padded With spaces by the Width-specifier.
  1109.  
  1110.     Width              Integer Value that specifies the Width being
  1111.                        reserved For the argument. If the String
  1112.                        resulting from the conversion Of the argument
  1113.                        Contains less than Width characters, it Is
  1114.                        Left padded With spaces To achieve This minimum
  1115.                        Length. If "-" Is used To Activate Left-
  1116.                        justification, the String Is padded To the
  1117.                        Right rather than To the Left. If the String
  1118.                        already has A Length equal To Or greater than
  1119.                        Width, no padding Is Needed.
  1120.  
  1121.     "." Precision      Integer Value that specifies the Precision
  1122.                        used when converting the argument. the actual
  1123.                        consequences Of Precision depend ON the
  1124.                        argument Type. See descriptions below For
  1125.                        Details.
  1126.  
  1127.   the Index, Width, And Precision specifiers can also contain an
  1128.   asterisk ('*'). In This Case, the Real Value Is taken from the
  1129.   Next argument Array entry, which has To be an Integer Value, Or
  1130.   EConvertError will be raised.
  1131.  
  1132.   following are the characters allowed To specify the argument Type.
  1133.   note that 'decimal point' And 'thousand separator' mean that the
  1134.   characters contained In the global variables DecimalSeparator And
  1135.   ThousandSeparator will be inserted.
  1136.  
  1137.     D                  DECIMAL format. the corresponding argument MUST
  1138.                        be an Integer Value, Otherwise EConvertError Is
  1139.                        raised. the argument Is converted To A DECIMAL
  1140.                        String. If A Precision Is specified, the String
  1141.                        Is guaranteed To have At least A Number Of
  1142.                        Digits equal To Precision. If the String Is
  1143.                        shorter, it Is padded With zeroes.
  1144.  
  1145.     E                  Scientific (exponential) format. the
  1146.                        corresponding argument MUST be A floating Point
  1147.                        Value, Otherwise EConvertError Is raised. the
  1148.                        argument Is converted To A DECIMAL String using
  1149.                        Scientific notation. the String Starts With a
  1150.                        minus sign, If the argument Is Negative. one
  1151.                        digit always precedes the DECIMAL Point. the
  1152.                        Number Of Digits following the DECIMAL Point Is
  1153.                        controlled by the optional Precision specifier.
  1154.                        the total Number Of Digits Is always equal To
  1155.                        Precision. If Precision Is Not specified, a
  1156.                        Default Of 15 Is assumed, resulting In 1 digit
  1157.                        before And 14 after the DECIMAL Point.
  1158.                        following Is the exponential 'E' With A plus Or
  1159.                        A minus sign And up To 3 Digits indicating the
  1160.                        Exponent.
  1161.  
  1162.     F                  FIXED Point format. the corresponding argument
  1163.                        MUST be A floating Point Value, Otherwise
  1164.                        EConvertError Is raised. the argument Is
  1165.                        converted To A String using FIXED notation. it
  1166.                        Starts With A minus sign, If the argument Is
  1167.                        Negative. All Digits Of the argument's Integer
  1168.                        part appear In the Result. following Is a
  1169.                        DECIMAL separator And A Number Of Digits equal
  1170.                        To Precision. If no Precision Is specified, a
  1171.                        Default Of 2 DECIMAL places Is assumed.
  1172.  
  1173.     G                  General Number format. the argument MUST be a
  1174.                        floating Point Value, Otherwise EConvertError
  1175.                        Is raised. the argument Is converted To a
  1176.                        String using either FIXED Or Scientific format,
  1177.                        depending ON which results In A shorter String.
  1178.                        the optional Precision specifier Controls the
  1179.                        Number Of significant Digits (used For
  1180.                        rounding) With A Default Of 15. the Result will
  1181.                        contain neither unnecessary zeroes nor an
  1182.                        unnecessary DECIMAL Point. If the argument
  1183.                        Value Is greater than Or equal To 0.00001, And
  1184.                        If the Number Of Digits To the Left Of the
  1185.                        DECIMAL Point Is less than Or equal To the
  1186.                        Precision, FIXED format Is used. Otherwise the
  1187.                        Result Uses Scientific format.
  1188.  
  1189.     M                  currency (money) format. the corresponding
  1190.                        argument MUST be A floating Point Value,
  1191.                        Otherwise EConvertError Is raised. the argument
  1192.                        Is converted To A String using the following
  1193.                        global variables:
  1194.  
  1195.                          CurrencyString
  1196.                          CurrencyFormat
  1197.                          NegCurrFormat
  1198.                          CurrencyDecimals
  1199.  
  1200.                        If A Precision Is specified, it overrides the
  1201.                        Default Value Of CurrencyDecimals.
  1202.  
  1203.     N                  Number format. equal To FIXED, but the Result
  1204.                        String will contain thousand separators.
  1205.  
  1206.     P                  Pointer format. the corresponding argument MUST
  1207.                        be A Pointer Value, Otherwise EConvertError Is
  1208.                        raised. the Value Is converted To A String
  1209.                        containing the hexadecimal representation Of
  1210.                        the Pointer, With an additional ':' In the
  1211.                        middle. the resulting String has always a
  1212.                        Length Of 9 characters. since we are dealing
  1213.                        With flat Memory model, we have A full 32-bit
  1214.                        Pointer With no segment part, only Offset.
  1215.  
  1216.     S                  String format. the corresponding argument MUST
  1217.                        be A Single character, A String Or A PChar Value,
  1218.                        Otherwise EConvertError Is raised. the argument
  1219.                        Is simply copied To the destination String. If
  1220.                        A Precision Is specified, it Is considered the
  1221.                        maximum Length Of the argument String. longer
  1222.                        Strings will be truncated.
  1223.  
  1224.     X                  hexadecimal format. the corresponding argument
  1225.                        MUST be an Integer Value, Otherwise EConvertError
  1226.                        Is raised. the argument Is converted To a
  1227.                        hexadecimal String. If A Precision Is specified,
  1228.                        the String Is guaranteed To have At least a
  1229.                        Number Of Digits equal To Precision. If the
  1230.                        String Is shorter, it Is padded With zeroes. }
  1231.  
  1232. Function format(Const format: String; Const Args: Array Of Const): String;
  1233.  
  1234. { FmtStr - formats A String And replaces placeholders by arguments.
  1235.   See format For A detailed description Of the format String And the
  1236.   argument Array. }
  1237.  
  1238. Procedure FmtStr(Var Result: String; Const format: String;
  1239.   Const Args: Array Of Const);
  1240.  
  1241. { StrFmt - formats A String And replaces placeholders by arguments.
  1242.   note that the Buffer MUST be large enough To hold the Complete
  1243.   Result, Otherwise A protection fault (EGPFault) may occur. See
  1244.   format For A detailed description Of the format String And the
  1245.   argument Array. }
  1246.  
  1247. Function StrFmt(Buffer, format: PChar; Const Args: Array Of Const): PChar;
  1248.  
  1249. { StrLFmt - formats A String And replaces placeholders by arguments.
  1250.   the Function ensures that the Size Of the Output String written into
  1251.   Buffer won't exceed MaxLen characters. the function's Result Is also
  1252.   A Pointer To Buffer. See format For A detailed description Of the
  1253.   format String And the argument Array. }
  1254.  
  1255. Function StrLFmt(Buffer: PChar; MaxLen: Cardinal; format: PChar;
  1256.   Const Args: Array Of Const): PChar;
  1257.  
  1258. { FormatBuf - formats A String And replaces placeholders by arguments.
  1259.   format And Buffer Strings are given As untyped Var / Const
  1260.   Parameters. their sizes are given In BufLen And FmtLen. the Function
  1261.   ensures that the Size Of the Output String written into Buffer won't
  1262.   exceed BufLen characters. the Result Value Is the Number Of
  1263.   characters actually written into Buffer. See format For A detailed
  1264.   description Of the format String And the argument Array. }
  1265.  
  1266. Function FormatBuf(Var Buffer; BufLen: Cardinal; Const format;
  1267.   FmtLen: Cardinal; Const Args: Array Of Const): Cardinal;
  1268.  
  1269. { --- floating Point conversion --- }
  1270.  
  1271. { FloatToStrF - Converts A floating Point Number To A String. the
  1272.   appearance Of the Result String can be controlled by specifying
  1273.   A basic format To apply, A Precision, And A Number Of Digits.
  1274.   the Precision Parameter should be less than Or equal To 18. the
  1275.   meaning Of the Digits Parameter depends ON the format chosen.
  1276.  
  1277.   following Is A detailed description Of the possible formats:
  1278.  
  1279.     ffCurrency     money (currency) format. the argument Is converted
  1280.                    To A String using the following global variables:
  1281.  
  1282.                      CurrencyString
  1283.                      CurrencyFormat
  1284.                      NegCurrFormat
  1285.  
  1286.                    the Digits Parameter specifies the Number Of Digits
  1287.                    following the DECIMAL Point (0 To 18 being legal
  1288.                    values).
  1289.  
  1290.     ffExponent     Scientific (exponential) format. the argument Is
  1291.                    converted To A DECIMAL String using Scientific
  1292.                    notation. the String Starts With A minus sign, If
  1293.                    the argument Is Negative. one digit precedes the
  1294.                    DECIMAL Point. the Number Of Digits following the
  1295.                    DECIMAL Point Is controlled by Precision. the total
  1296.                    Number Of Digits Is always equal To Precision.
  1297.                    following Is the exponential 'E' With A plus Or a
  1298.                    minus sign And the Exponent With A minimum Length
  1299.                    Of Digits characters (0 To 4 being legal values).
  1300.  
  1301.     ffFixed        FIXED Point format. the argument Is converted To a
  1302.                    String using FIXED Point notation. it Starts With a
  1303.                    minus sign, If the argument Is Negative. All Digits
  1304.                    Of the argument's Integer part appear In the Result.
  1305.                    following Is A comma And A Number Of DECIMAL Digits
  1306.                    equal To Digits (0 To 18 being legal values). If
  1307.                    the Number Of Digits To the Left Of the DECIMAL
  1308.                    Point Is greater than Precision, the Output will be
  1309.                    In Scientific format.
  1310.  
  1311.     ffGeneral      General Number format. the argument Is converted
  1312.                    To A String using either FIXED Or Scientific
  1313.                    format, depending ON which results In A shorter
  1314.                    String. the Result will contain neither trailing
  1315.                    zeroes nor an unnecessary DECIMAL Point. If the
  1316.                    argument Value Is greater than Or equal To 0.00001,
  1317.                    And If the Number Of Digits To the Left Of the
  1318.                    DECIMAL Point Is less than Or equal To Precision,
  1319.                    FIXED format Is used. Otherwise the Result Is
  1320.                    formatted In Scientific format With Digits
  1321.                    specifying the minimum Number Of Digits In the
  1322.                    Exponent (0 To 4 being legal values).
  1323.  
  1324.     ffNumber       Number format. equal To FIXED, but the Result
  1325.                    String will contain thousand separators.
  1326.  
  1327.   If the Value Is Not-A-Number, positive infinity, Or Negative
  1328.   infinity, Then the Output String will also be NAN, INF, Or -INF. }
  1329.  
  1330. Function FloatToStrF(Value: Extended; format: TFloatFormat;
  1331.   Precision, Digits: Integer): String;
  1332.  
  1333. { FloatToStr - Converts A floating Point Value To A String using
  1334.   General Number format And 15 significant Digits. See FloatToStrF
  1335.   For more Details. }
  1336.  
  1337. Function FloatToStr(Value: Extended): String;
  1338.  
  1339. { FloatToText - Converts A floating Point Number To A String. the
  1340.   Result Is written To Buffer without A Zero teminator being
  1341.   appended. the caller has To ensure that the Buffer Is large
  1342.   enough To hold the Result. the Result can be controlled using
  1343.   format, Precision And Digits Parameters. See FloatToStrF For
  1344.   A detailed description Of these Parameters. }
  1345.  
  1346. Function FloatToText(Buffer: PChar; Value: Extended; format: TFloatFormat;
  1347.   Precision, Digits: Integer): Integer;
  1348.  
  1349. { FormatFloat - Converts A floating Point Value To A String using a
  1350.   specified format.
  1351.  
  1352.   the Parameter format Controls the appearance Of the Result String.
  1353.  
  1354.   format can contain up To three Sections, separated from each other
  1355.   by semicolons. the First section holds the format String used For
  1356.   positive values, the Second one holds the format For Negative
  1357.   values, And the third one Is applied To Zero values. If one Of
  1358.   the Sections Is missing Or Empty, the First section Is used
  1359.   instead. If All Sections are missing Or Empty, General Number
  1360.   format Is used With A Precision Of 15. See FloatToStrF For more
  1361.   Details about General Number format.
  1362.  
  1363.   each Of the three Sections can contain arbitrary Text, which Is
  1364.   simply copied To the Result String. Some characters have A Special
  1365.   meaning, they serve As placeholders For inserting Data from the
  1366.   Value Parameter.
  1367.  
  1368.   the following List shows All placeholders And their meaning:
  1369.  
  1370.     0         Mandatory digit. If the Value has A digit At This
  1371.               Position, it Is copied To the Result. Otherwise a
  1372.               0 Is inserted.
  1373.  
  1374.     #         optional digit. If the Value has A digit At This
  1375.               Position, it Is copied To the Result. Otherwise
  1376.               This Position Of the format String will be ignored.
  1377.  
  1378.     .         DECIMAL separator. the First occurence Of '.' In the
  1379.               format String determines the Position At which A DECIMAL
  1380.               separator will be inserted. the DECIMAL separator Is
  1381.               taken from the global variable DecimalSeparator. further
  1382.               occurences Of '.' will be ignored.
  1383.  
  1384.     ,         thousand separator. any occurence Of ',' activates the
  1385.               insertion Of thousand separators into the Result, where
  1386.               necessary. the thousand separator Is taken from the
  1387.               global variable DecimalSeparator.
  1388.  
  1389.     E+ E-     Scientific (exponential) format. If any Of the four
  1390.     E+ E-     Strings To the Left occur In the format String, the
  1391.               Result will be formatted using Scientific notation.
  1392.               the exponential E will have the same Case As In the
  1393.               format String. the Exponent itself will always be
  1394.               preceded by its sign, If E+ Or E+ are used. E- And E-
  1395.               contain A sign only If the Exponent Value Is Negative.
  1396.               up To four digit placeholders can be used To specify the
  1397.               minimum Number Of Digits used For the Exponent.
  1398.  
  1399.     '...'     characters enclosed In Single Or Double quotes will
  1400.     "..."     simply be copied To the Result (without quotes).
  1401.  
  1402.   the floating Point Value Is rounded With A Precision equal To the
  1403.   total Number Of digit placeholders In the format String. optional
  1404.   digit placeholders between the leftmost And rightmost Mandatory
  1405.   digit placeholders will be taken As Mandatory Digits, So it makes
  1406.   no sense To specify one ore more '#' between zeroes. If the rounded
  1407.   Value Contains more Digits In the Integer part than there are
  1408.   placeholders Left Of the DECIMAL separator, the additional Digits
  1409.   will be inserted before the First placeholder. }
  1410.  
  1411. Function FormatFloat(Const format: String; Value: Extended): String;
  1412.  
  1413. { FloatToTextFmt - Converts A floating Point Value To A String using a
  1414.   specified format. the Result Is written To Buffer without a
  1415.   terminating Zero. the caller has To ensure that the Buffer Is large
  1416.   enough To hold the Result. the Number Of characters actually written
  1417.   To Buffer Is returned. See FormatFloat For A description Of the
  1418.   format Parameter. }
  1419.  
  1420. Function FloatToTextFmt(Buffer: PChar; Value: Extended;
  1421.   format: PChar): Integer;
  1422.  
  1423. { StrToFloat - Converts A String To A floating Point Value. the String
  1424.   MUST contain A legal floating Point Value, With the DECIMAL Point
  1425.   being the same character As In the global variable DecimalSeparator.
  1426.   it MUST Not contain thousand separators Or currency symbols. leading
  1427.   And trailing spaces are allowed. If the String does Not conform
  1428.   these restrictions, EConvertError Is raised. }
  1429.  
  1430. Function StrToFloat(Const S: String): Extended;
  1431.  
  1432. { TextToFloat - Converts A Zero-Terminated String To A floating Point
  1433.   Value. the String MUST contain A legal floating Point Value, With
  1434.   the DECIMAL Point being the same character As In the global variable
  1435.   DecimalSeparator. it MUST Not contain thousand separators Or
  1436.   currency symbols. leading And trailing spaces are allowed. If the
  1437.   String does Not conform these restrictions, EConvertError Is raised. }
  1438.  
  1439. Function TextToFloat(Buffer: PChar; Var Value: Extended): Boolean;
  1440.  
  1441. { FloatToDecimal - Converts A floating Point Value To A TFloatRec
  1442.   Record which separates Digits, sign, And Exponent. the Precision
  1443.   Parameter specifies the Number Of significant Digits (With 1..18
  1444.   being legal values), the Decimals Parameter specifies the desired
  1445.   minimum Number Of Digits In the fractional part. rounding Is
  1446.   controlled by Precision As well As by Decimals. To force A Number
  1447.   Of significant Digits even With large values, specify 9999 For
  1448.   Decimals.
  1449.  
  1450.   the resulting TFloatRec will contain the following information:
  1451.  
  1452.     Exponent - the result's Exponent. an Exponent Value Of -32768
  1453.     Indicates that the Value Is Not-A-Number (NAN). positive Or
  1454.     Negative infinity (INF / -INF) Is indicated by an Exponent
  1455.     Value Of 32767.
  1456.  
  1457.     Negative - Indicates whether the Value Is Negative Or Not. Use
  1458.     This To distinguish positive from Negative infinity, too. Zero
  1459.     Is assumed To be non-Negative.
  1460.  
  1461.     Digits - Contains the significant Digits With A terminating
  1462.     Zero (Chr(0)). does Not contain the DECIMAL separator. Empty,
  1463.     If the Value Is Not-A-Number, Or positive, Or Negative infinity. }
  1464.  
  1465. Procedure FloatToDecimal(Var Result: TFloatRec; Value: Extended;
  1466.   Precision, Decimals: Integer);
  1467.  
  1468. { --- date / Time Handling --- }
  1469.  
  1470. { EncodeDate - Encodes the given Year, Month, And Day into A Single
  1471.   TDateTime Value. the Result Contains the Number Of days passed since
  1472.   the 31-Dec-0000 And the given date, assuming Gregorian calendar has
  1473.   always been used. If any Parameter Contains an illegal Value,
  1474.   EConvertError Is raised. }
  1475.  
  1476. Function EncodeDate(Year, Month, Day: Word): TDateTime;
  1477.  
  1478. { EncodeTime - Encodes the given Hour, Minute, Second And millisecond
  1479.   into A Single TDateTime Value. the Result Contains the fractional
  1480.   part Of the Day passed since 00:00:00. it Is always A Value equal To
  1481.   Or greater than Zero And And smaller that one. If any Parameter
  1482.   Contains an illegal Value, EConvertError Is raised. }
  1483.  
  1484. Function EncodeTime(Hour, Min, Sec, MSec: Word): TDateTime;
  1485.  
  1486. { DecodeDate - Extracts Year, Month, And Day from A given TDateTime
  1487.   Value. }
  1488.  
  1489. Procedure DecodeDate(date: TDateTime; Var Year, Month, Day: Word);
  1490.  
  1491. { DecodeTime - Extracts Hour, Minute, Second, And millisecond from a
  1492.   given TDateTime Value. }
  1493.  
  1494. Procedure DecodeTime(Time: TDateTime; Var Hour, Min, Sec, MSec: Word);
  1495.  
  1496. { DayOfWeek - Extracts the Day Of the week from A given TDateTime
  1497.   Value. the days are numbered from 1 To 7 In the following order:
  1498.  
  1499.     Sun / Mon / Tue / Wed / Thu / Fri / Sat }
  1500.  
  1501. Function DayOfWeek(date: TDateTime): Integer;
  1502.  
  1503. { date - Queries the Current System date. }
  1504.  
  1505. Function date: TDateTime;
  1506.  
  1507. { Time - Queries the Current System Time. }
  1508.  
  1509. Function Time: TDateTime;
  1510.  
  1511. { now - Queries the Current System date And Time. }
  1512.  
  1513. Function now: TDateTime;
  1514.  
  1515. { DateToStr - Converts the date part Of the given TDateTime Value
  1516.   To A String, using the format specified In the global variable
  1517.   ShortDateFormat. }
  1518.  
  1519. Function DateToStr(date: TDateTime): String;
  1520.  
  1521. { TimeToStr - Converts the Time part ao the given TDateTime Value
  1522.   To A String, using the format specified In the global variable
  1523.   LongTimeFormat. }
  1524.  
  1525. Function TimeToStr(Time: TDateTime): String;
  1526.  
  1527. { DateTimeToStr - Converts the given TDateTime Value To A String
  1528.   using the formats specified In the global variables ShortDateFormat
  1529.   And LongTimeFormat. the Time Is only appended, If the TDateTime
  1530.   Value Contains A (fractional) Time part different from 00:00:00. }
  1531.  
  1532. Function DateTimeToStr(DateTime: TDateTime): String;
  1533.  
  1534. { StrToDate - Tries To exctract date information from A String.
  1535.   the FUNCTIONs expects the String To contain two Or three numbers
  1536.   separated by the character given In the global variable
  1537.   DateSeparator. the order In which Day, Month, And Year are
  1538.   expected Is determined by the global variable DateOrder.
  1539.   If only two numbers are found, they are assumed To specify
  1540.   A Month And Day Of the Current Year. If the Year Is smaller
  1541.   than 100, it Is assumed To be A Year Of the Current century.
  1542.   If no legal date can be extracted from the String,
  1543.   EConvertError Is raised. }
  1544.  
  1545. Function StrToDate(Const S: String): TDateTime;
  1546.  
  1547. { StrToTime - Tries To exctract Time information from A String.
  1548.   the FUNCTIONs expects the String To contain two Or three numbers
  1549.   separated by the character given In the global variable
  1550.   TimeSeparator, optionally followed by 'AM' Or 'PM' To indicate
  1551.   12-Hour format. the First two numbers are taken As Hour And
  1552.   Minute, the optional third one As Second. If no indicator For
  1553.   12-Hour format Is found, the Time Is assumed To be In 24-Hour
  1554.   format. If no legal Time can be extracted from the String,
  1555.   EConvertError Is raised. }
  1556.  
  1557. Function StrToTime(Const S: String): TDateTime;
  1558.  
  1559. { StrToDateTime - Tries To extract date And Time information from A
  1560.   String. the Function expects the String To contain A date optionally
  1561.   followed by A Time. See StrToDate And StrToTime For more Details
  1562.   about the string's contents. If no legal date And Time can be
  1563.   extracted from the String, EConvertError Is raised. }
  1564.  
  1565. Function StrToDateTime(Const S: String): TDateTime;
  1566.  
  1567. { FormatDateTime - Converts A TDateTime Value To A String using a
  1568.   format specified by the Parameter format.
  1569.  
  1570.   the format String may contain arbitrary Text, which Is simply
  1571.   copies To the Result String. Some characters Or character
  1572.   sequences have A Special meaning, they serve As placeholders And
  1573.   are replaced by values extracted from DateTime.
  1574.  
  1575.   the following placeholders are allowed In the format String. their
  1576.   Case doesn't matter. If the format String Is Empty, 'c' Is assumed
  1577.   the Default format.
  1578.  
  1579.     C         replaced by the date formatted As specified In the
  1580.               global variable ShortDateFormat. If the (fractional)
  1581.               Time part Is different from 00:00:00, the Time Is
  1582.               appended using the format specified In the global
  1583.               variable LongTimeFormat.
  1584.  
  1585.     D         replaced by A Number indicating the Day Of the Month,
  1586.               With no leading Zero.
  1587.  
  1588.     dd        replaced by A Number indicating the Day Of the Month,
  1589.               With leading Zero.
  1590.  
  1591.     ddd       replaced by the Day Of the week's Name taken from the
  1592.               global Array ShortDayNames, resulting In an abbreviation
  1593.               Of the day's Name.
  1594.  
  1595.     dddd      replaced by the Day Of the week's Name taken from the
  1596.               global Array LongDayNames, resulting In the day's full
  1597.               Name.
  1598.  
  1599.     ddddd     replaced by the date formatted As specified In the
  1600.               global variable ShortDateFormat.
  1601.  
  1602.     dddddd    replaced by the date formatted As specified In the
  1603.               global variable LongDateFormat.
  1604.  
  1605.     M         when used immediately after an Hour placeholder,
  1606.               replaced by the Minute. Otherwise replaced by A
  1607.               Number indicating the Month. no leading zeroes.
  1608.  
  1609.     mm        when used immediately after an Hour placeholder,
  1610.               replaced by the Minute. Otherwise replaced by A
  1611.               Number indicating the Month. leading zeroes.
  1612.  
  1613.     mmm       replaced by the month's Name taken from the global Array
  1614.               ShortMonthNames, resulting In an abbreviation Of the
  1615.               month's Name.
  1616.  
  1617.     mmmm      replaced by the month's Name taken from the global Array
  1618.               LongMonthNames, resulting In the month's full Name.
  1619.  
  1620.     yy        replaced by two Digits indicating the Year. leading
  1621.               zeroes.
  1622.  
  1623.     yyyy      replaced by four Digits indicating the Year. leading
  1624.               zeroes.
  1625.  
  1626.     H         replaced by the Hour without leading Zero.
  1627.  
  1628.     hh        replaced by the Hour With leading Zero.
  1629.  
  1630.     N         replaced by the Minute without leading Zero.
  1631.  
  1632.     nn        replaced by the Minute With leading Zero.
  1633.  
  1634.     S         replaced by the Second without leading Zero.
  1635.  
  1636.     SS        replaced by the Second With leading Zero.
  1637.  
  1638.     T         replaced by the Time formatted As specified In the
  1639.               global variable ShortTimeFormat.
  1640.  
  1641.     tt        replaced by the Time formatted As specified In the
  1642.               global variable LongTimeFormat.
  1643.  
  1644.     am/PM     Indicates that 12-Hour format should be used For the
  1645.               preceding Hour placeholder. replaced by 'am' Or 'pm',
  1646.               depending ON the Time, With the same Case As specified.
  1647.  
  1648.     A/P       Indicates that 12-Hour format should be used For the
  1649.               preceding Hour placeholder. replaced by 'a' Or 'p',
  1650.               depending ON the Time, With the same Case As specified.
  1651.  
  1652.     ampm      Indicates that 12-Hour format should be used For the
  1653.               preceding Hour placeholder. replaced by A String taken
  1654.               from the global variables TimeAMString Or TimePMString,
  1655.               depending ON the Time.
  1656.  
  1657.     /         replaced by the date separator As specified In the global
  1658.               variable DateSeparator.
  1659.  
  1660.     :         replaced by the Time separator As specified In the global
  1661.               variable TimeSeparator.
  1662.  
  1663.     '...'     characters enclosed In Single Or Double quotes will
  1664.     "..."     simply be copied To the Result (without quotes). }
  1665.  
  1666. Function FormatDateTime(Const format: String; DateTime: TDateTime): String;
  1667.  
  1668. { DateTimeToString - Converts A TDateTime Value To A String using A
  1669.   format specified by the format Parameter . See FormatDateTime For
  1670.   A detailed description Of the format String. }
  1671.  
  1672. Procedure DateTimeToString(Var Result: String; Const format: String;
  1673.   DateTime: TDateTime);
  1674.  
  1675. { --- System profile support --- }
  1676.  
  1677. {$IFDEF GUI}
  1678.  
  1679. { GetProfileStr - Reads A String from the operating system's user
  1680.   profile. If section Or entry don't exist, A Default Value Is
  1681.   returned instead. }
  1682.  
  1683. Function GetProfileStr(Const Section, Entry, Default: String): String;
  1684.  
  1685. { GetProfileChar - Reads A character from the operating system's user
  1686.   profile. If section Or entry don't exist, A Default Value Is
  1687.   returned instead. }
  1688.  
  1689. Function GetProfileChar(Const Section, Entry: String; Default: Char): Char;
  1690.  
  1691. { GetProfileInt - Reads an Integer from the operating system's user
  1692.   profile. If section Or entry don't exist, A Default Value Is
  1693.   returned instead. }
  1694.  
  1695. Function GetProfileInt(Const Section, Entry: string; Default: Integer): Integer;
  1696.  
  1697. { GetFormatSettings - Queries A lot Of Default values used For
  1698.   formatting FUNCTIONs from the Operation System. called automatically
  1699.   In the SysUtils startup Code, So an Application that Uses SysUtils
  1700.   can always access these values immediately after Program startup. }
  1701.  
  1702. {$ENDIF GUI}
  1703.  
  1704. Procedure GetFormatSettings;
  1705.  
  1706. { ConvertError - Raises EConvertError With the given Error Message. }
  1707.  
  1708. Procedure ConvertError(Const Msg: String);
  1709.  
  1710. { --- Some routines that belong into System.PAS --- }
  1711.  
  1712. { SetLength - changes the Length Of A String. Please Use This
  1713.   Procedure instead Of writing S[0] := NewLength To maintain
  1714.   compatibility With the forthcoming LONG Strings that won't contain
  1715.   A Length-Byte any more. }
  1716.  
  1717. { Procedure SetLength(Var S: String; NewLength: Byte); }
  1718.  
  1719. { StringOfChars - returns A String that consists Of
  1720.   Count occurences Of the given character CH. }
  1721.  
  1722. Function StringOfChars(CH: Char; Count: Integer): String;
  1723.  
  1724. { SetCurrentLanguageTable - sets the Language Table Name To the specified Language.
  1725.   the Name MUST Start With "SIBYL_NLS_". A Table With the Name MUST exist. If the Table
  1726.   cannot be found Or Some other Error occurs This Function returns False, otherise True.
  1727.   by convention the Table MUST Include All Sibyl Default Language identifiers
  1728.   (See /Language Directory For examples).}
  1729.  
  1730. Function SetCurrentLanguageTable(Const Table:String):Boolean;
  1731.  
  1732. { GetCurrentLanguageTable - gets the Current Language Table Name. }
  1733.  
  1734. Function GetCurrentLanguageTable:String;
  1735.  
  1736. { GetCurrentLanguage - returns the Currently Set Language. the Language String Is
  1737.   retrieved from the Current Language Table With the "SLanguage" Index. This Function
  1738.   returns an Empty String ON Error. }
  1739.  
  1740. Function GetCurrentLanguage:String;
  1741.  
  1742. {GetPhysicalDrives - returns information about logical drives connected
  1743.  to the system. The drives are encoded bitwise starting with bit 0 for
  1744.  drive A. A enabled bit indicates that the appropriate drive is present}
  1745. Function GetPhysicalDrives:LongWord;
  1746.  
  1747. {$IFDEF WIN32}
  1748. Procedure StrOemToAnsi(Var s:String);
  1749. {$ENDIF}
  1750.  
  1751. Implementation
  1752.  
  1753. {$IFDEF WIN32}
  1754. Procedure StrOemToAnsi(Var s:String);
  1755. Var Found:Boolean;
  1756.     c:CString;
  1757. Begin
  1758.     Found:=True;
  1759.     Asm
  1760.        MOV EDI,s
  1761.        MOVZXB ECX,[EDI]
  1762.        INC EDI
  1763.        CMP ECX,0
  1764.        JE !End1
  1765. !Lo1:
  1766.        //Check for Σ,÷,ⁿ,─,╓,▄,▀
  1767.        CMPB [EDI],132
  1768.        JE !End2
  1769.        CMPB [EDI],142
  1770.        JE !End2
  1771.        CMPB [EDI],148
  1772.        JE !End2
  1773.        CMPB [EDI],153
  1774.        JE !End2
  1775.        CMPB [EDI],129
  1776.        JE !End2
  1777.        CMPB [EDI],154
  1778.        JE !End2
  1779.        CMPB [EDI],225
  1780.        JE !End2
  1781.  
  1782.        INC EDI
  1783.        LOOP !Lo1
  1784. !End1:
  1785.        MOVB Found,0
  1786. !End2:
  1787.     End;
  1788.  
  1789.     If Found Then
  1790.     Begin
  1791.          c:=s;
  1792.          OemToAnsi(c,c);
  1793.          s:=c;
  1794.     End;
  1795. End;
  1796. {$ENDIF}
  1797.  
  1798. Uses
  1799.   Language;
  1800.  
  1801.  
  1802. Function GetPhysicalDrives:LongWord;
  1803.   {$IFDEF OS2}
  1804. Var
  1805.   ActualDrive:LongWord;
  1806.   {$ENDIF}
  1807. Begin
  1808.     {$IFDEF OS2}
  1809.     DosQueryCurrentDisk(ActualDrive,Result);
  1810.     {$ENDIF}
  1811.     {$IFDEF Win95}
  1812.     result := GetLogicalDrives;
  1813.     {$ENDIF}
  1814. End;
  1815.  
  1816. { Current Language String Table identifier. Name has preceding SIBYL_NLS_ String !}
  1817. Var
  1818.   CurrentLanguageTable:String;
  1819.  
  1820. Function SetCurrentLanguageTable(Const Table:String):Boolean;
  1821. Var P:Pointer;
  1822.     len:LongWord;
  1823. Begin
  1824.    P:=FindStringTableRes(Table,len);
  1825.    Result:=P<>Nil;
  1826.    If Result Then CurrentLanguageTable:=Table;
  1827. End;
  1828.  
  1829. Function GetCurrentLanguageTable:String;
  1830. Begin
  1831.    Result:=CurrentLanguageTable;
  1832. End;
  1833.  
  1834. Function GetCurrentLanguage:String;
  1835. Begin
  1836.    Result:=LoadNLSStr(SLanguage);
  1837. End;
  1838.  
  1839. Const
  1840.  
  1841. { Array With Number Of days passed since beginning Of the Year
  1842.   Until the 1st Of Every Month. used For date/Time conversions. }
  1843.  
  1844.   DaysPassed: Array[False..True, 1..13] Of Integer =
  1845.     ((0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365),
  1846.      (0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366));
  1847.  
  1848.   ShareModes = fmShareExclusive
  1849.             Or fmShareDenyRead
  1850.             Or fmShareDenyWrite
  1851.             Or fmShareDenyNone;
  1852.  
  1853. Var
  1854.  
  1855. { Collating sequence. Needed For sorting when OS/2 base API FUNCTIONs are used. }
  1856.  
  1857.   CollatingSequence: Array[#0..#255] Of Byte;
  1858.  
  1859. Const
  1860.  
  1861. { Array For creation Of hexadecimal numbers }
  1862.  
  1863.   Hexadecimals: Array[0..15] Of Char = '0123456789ABCDEF';
  1864.  
  1865. Procedure ConvertError(Const Msg: String);
  1866. Begin
  1867.   Raise EConvertError.Create(Msg);
  1868. End;
  1869.  
  1870. Procedure FmtLoadConvertError(Ident: Integer; Args: Array Of Const);
  1871. Var
  1872.   Msg: String;
  1873. Begin
  1874.   {$IFDEF GUI}
  1875.     Try
  1876.     Msg := FmtLoadNLSStr(Ident, Args);
  1877.   Except
  1878.     Msg := LoadNLSStr(Ident) + ' [!]';
  1879.   End;
  1880.   {$ELSE GUI}
  1881.   Msg := 'SysUtils conversion error #' + IntToStr(Ident);
  1882.   {$ENDIF GUI}
  1883.   ConvertError(Msg);
  1884. End;
  1885.  
  1886. { --- String / PChar Utility FUNCTIONs --- }
  1887.  
  1888. Assembler
  1889.  
  1890.   { This Function returns the Length Of A String And A Pointer To the
  1891.     Zero terminator.
  1892.  
  1893.     Input:   EDI holds Pointer String
  1894.     Output:  EDI hols Pointer To Zero terminator, EAX holds String Length
  1895.     changes: EAX, EBX, ECX, EDI }
  1896.  
  1897.   SysUtils.!StringLength Proc NEAR32
  1898.  
  1899.     MOV       EBX, EDI
  1900.     Xor       EAX, EAX
  1901.     CMP       EDI, 0
  1902.     JE        !Out!StringLength
  1903.     MOV       ECX, $FFFFFFFF
  1904.     CLD
  1905.     REPNE     SCASB
  1906.     Not       ECX
  1907.     MOV       EAX, ECX
  1908.     Dec       EAX
  1909.     Dec       EDI
  1910.  
  1911.   !Out!StringLength:
  1912.     RETN32
  1913.  
  1914.   SysUtils.!StringLength ENDP
  1915.  
  1916.   { This FUNCTIONs copies A maximum Number Of characters from one String
  1917.     To another.
  1918.  
  1919.     Input:   ESI holds Source, EDI holds destination, ECX hold maximum
  1920.              Number Of characters
  1921.     Output:  EDI holds End Of destination String
  1922.     changes: EAX, EBX, ECX, EDX, ESI, EDI }
  1923.  
  1924.   SysUtils.!StringCopy Proc NEAR32
  1925.  
  1926.     MOV       EBX, ECX
  1927.     MOV       EDX, EDI
  1928.     Xor       EAX, EAX
  1929.     CMP       EDI, 0
  1930.     JE        !Out!StringCopy
  1931.     CMP       ESI, 0
  1932.     JE        !Out!StringCopy
  1933.     MOV       EDI, ESI
  1934.     CLD
  1935.     REPNE     SCASB
  1936.     SUB       EBX, ECX
  1937.     MOV       ECX, EBX
  1938.     Shr       ECX, 2
  1939.     MOV       EDI, EDX
  1940.     REP       MOVSD
  1941.     MOV       ECX, EBX
  1942.     And       ECX, 3
  1943.     REP       MOVSB
  1944.     STOSB
  1945.     Dec       EDI
  1946.     Dec       EDI
  1947.  
  1948.   !Out!StringCopy:
  1949.     RETN32
  1950.  
  1951.   SysUtils.!StringCopy ENDP
  1952.  
  1953.   // This Function Compares A maximum Number Of characters
  1954.  
  1955.   SysUtils.!StringCompare Proc NEAR32
  1956.  
  1957.     REPE       CMPSB
  1958.     Xor        EAX, EAX
  1959.     MOV        AL, [ESI - 1]
  1960.     MOV        BL, [EDI - 1]
  1961.     SUB        EAX, EBX
  1962.     RETN32
  1963.  
  1964.   SysUtils.!StringCompare ENDP
  1965.  
  1966.   //
  1967.  
  1968.   SysUtils.!StringICompare Proc NEAR32
  1969.  
  1970.     Xor        EAX, EAX;
  1971.  
  1972.   !Loop!StringICompare:
  1973.  
  1974.     REPE       CMPSB
  1975.     JE         !Out!StringICompare
  1976.  
  1977.     Xor        EBX, EBX
  1978.     MOV        BL, [ESI - 1]
  1979.     CMP        BL, 'A'
  1980.     JL         !UpcaseSecondChar!StringICompare
  1981.     CMP        BL, 'Z'
  1982.     JG         !UpcaseSecondChar!StringICompare
  1983.     Or         BL, 32
  1984.  
  1985.   !UpcaseSecondChar!StringICompare:
  1986.  
  1987.     Xor        EDX, EDX
  1988.     MOV        DL, [EDI - 1]
  1989.     CMP        DL, 'A'
  1990.     JL         !CompareSingleChar!StringICompare
  1991.     CMP        DL, 'Z'
  1992.     JG         !CompareSingleChar!StringICompare
  1993.     Or         DL, 32
  1994.  
  1995.   !CompareSingleChar!StringICompare:
  1996.  
  1997.     SUB        EBX, EDX
  1998.     JE         !Loop!StringICompare
  1999.     MOV        EAX, EBX
  2000.  
  2001.   !Out!StringICompare:
  2002.  
  2003.     RETN32
  2004.  
  2005.   SysUtils.!StringICompare ENDP
  2006.  
  2007. End;
  2008.  
  2009. { --- Memory management --- }
  2010.  
  2011. Function AllocMem(Size: Cardinal): Pointer;
  2012. Begin
  2013.   GetMem(Result, Size);
  2014.   FillChar(Result^, Size, 0);
  2015. End;
  2016.  
  2017. Function ReAllocMem(P: Pointer; CurSize, NewSize: Cardinal): Pointer;
  2018. Var
  2019.   Q: PByteArray;
  2020. Begin
  2021.   If NewSize <> 0 Then GetMem(Q, NewSize) Else Q := Nil;
  2022.  
  2023.   If NewSize > 0 Then
  2024.   Begin
  2025.     If NewSize > CurSize Then
  2026.     Begin
  2027.       FillChar(Q^[CurSize], NewSize - CurSize, 0);
  2028.       NewSize := CurSize;
  2029.     End;
  2030.     If NewSize <> 0 Then Move(P^, Q^, NewSize);
  2031.   End;
  2032.   If CurSize <> 0 Then FreeMem(P, CurSize);
  2033.   Result := Q;
  2034. End;
  2035.  
  2036. { Exit Procedure Handling }
  2037.  
  2038. Type
  2039.   PExitNode = ^TExitNode;
  2040.   TExitNode = Record
  2041.     Next: PExitNode;
  2042.     Proc: TProcedure;
  2043.   End;
  2044.  
  2045. Const
  2046.   ExitChain: PExitNode = Nil;
  2047.  
  2048. Var
  2049.   SaveExitProc: Pointer;
  2050.  
  2051. Procedure CallExitProcs;
  2052. Var
  2053.   First: PExitNode;
  2054.   Proc: TProcedure;
  2055. Begin
  2056.   While ExitChain <> Nil Do
  2057.   Begin
  2058.     First := ExitChain;
  2059.     Proc := First^.Proc;
  2060.     ExitChain := First^.Next;
  2061.     ExitProc := Nil; { Avoids recursion! }
  2062.     Dispose(First);
  2063.     Proc;
  2064.   End;
  2065.   ExitProc := SaveExitProc;
  2066. End;
  2067.  
  2068. Procedure AddExitProc(Proc: TProcedure);
  2069. Var
  2070.   NewNode: PExitNode;
  2071. Begin
  2072.   If ExitChain = Nil Then SaveExitProc := ExitProc;
  2073.   New(NewNode);
  2074.   NewNode^.Next := ExitChain;
  2075.   NewNode^.Proc := Proc;
  2076.   ExitChain := NewNode;
  2077.   ExitProc := @CallExitProcs;
  2078. End;
  2079.  
  2080. { --- Pascal String Handling --- }
  2081.  
  2082. Function NewStr(Const S: String): PString;
  2083. Begin
  2084.   If Length(S) = 0 Then Result := NullStr
  2085.   Else
  2086.   Begin
  2087.     GetMem(Result, Length(S) + 1);
  2088.     Result^ := S;
  2089.   End;
  2090. End;
  2091.  
  2092. Procedure DisposeStr(P: PString);
  2093. Begin
  2094.   If (P <> NullStr) And (P <> Nil) Then FreeMem(P, Length(P^) + 1);
  2095. End;
  2096.  
  2097. Procedure AssignStr(Var P: PString; Const S: String);
  2098. Begin
  2099.   DisposeStr(P);
  2100.   P := NewStr(S);
  2101. End;
  2102.  
  2103. Procedure AppendStr(Var Dest: String; Const S: String);
  2104. Begin
  2105.   Insert(S, Dest, Length(Dest) + 1);
  2106. End;
  2107.  
  2108. Function uppercase(Const S: String): String;
  2109. Var
  2110.   T: String;
  2111.   N, C: Integer;
  2112. Begin
  2113.   T := S;
  2114.   For N := 1 To Length(T) Do
  2115.   Begin
  2116.     C := Ord(T[N]);
  2117.     If (C >= Ord('a')) And (C <= Ord('z')) Then T[N] := Chr(C And Not 32);
  2118.   End;
  2119.   Result := T;
  2120. End;
  2121.  
  2122. Function lowercase(Const S: String): String;
  2123. Var
  2124.   T: String;
  2125.   N, C: Integer;
  2126. Begin
  2127.   T := S;
  2128.   For N := 1 To Length(T) Do
  2129.   Begin
  2130.     C := Ord(T[N]);
  2131.     If (C >= Ord('A')) And (C <= Ord('Z')) Then T[N] := Chr(C Or 32);
  2132.   End;
  2133.   Result := T;
  2134. End;
  2135.  
  2136. Function CompareStr(Const s1, s2: String): Integer;
  2137. Begin
  2138.   If s1 <= s2 Then
  2139.   Begin
  2140.     If s1 = s2 Then Result := 0 Else Result := -1;
  2141.   End
  2142.   Else Result := +1
  2143. End;
  2144.  
  2145. Function CompareText(Const s1, s2: String): Integer;
  2146. Var
  2147.   l1, l2, L: Integer;
  2148. Begin
  2149.   l1 := Length(s1);
  2150.   l2 := Length(s2);
  2151.   If l1 <= l2 Then L := l1 Else L := l2;
  2152.   Result := StrLIComp(@s1[1], @s2[1], L);
  2153.   If Result = 0 Then
  2154.   Begin
  2155.     If l1 < l2 Then Result := -1 Else If l1 > l2 Then Result := 1;
  2156.   End;
  2157. End;
  2158.  
  2159. {$IFDEF OS2}
  2160.   {$IFDEF GUI}
  2161. Function AnsiUpperCase(Const S: String): String;
  2162. Var
  2163.   Temp: cstring;
  2164. Begin
  2165.   Temp := S;
  2166.   WinUpper(AppHandle, 0, 0, Temp);
  2167.   Result := Temp;
  2168. End;
  2169.   {$ELSE GUI}
  2170. Function AnsiUpperCase(Const S: String): String;
  2171. Var
  2172.   cc: COUNTRYCODE;
  2173. Begin
  2174.   Result := S;
  2175.   cc.country := 0;
  2176.   cc.codepage := 0;
  2177.   DosMapCase(Length(Result), cc, Result[1]);
  2178. End;
  2179.   {$ENDIF GUI}
  2180. {$ENDIF OS2}
  2181.  
  2182. {$IFDEF Win95}
  2183. Function AnsiUpperCase(Const S: String): String;
  2184. Var
  2185.   s1: cstring;
  2186. Begin
  2187.   s1 := S;
  2188.   AnsiUpperBuff(s1, Length(s));
  2189.   AnsiUpperCase:=s1;
  2190. End;
  2191. {$ENDIF Win95}
  2192.  
  2193. {$IFDEF Win95}
  2194. Function AnsiLowerCase(Const S: String): String;
  2195. Var
  2196.   s1: cstring;
  2197. Begin
  2198.   s1 := S;
  2199.   AnsiLowerBuff(s1, Length(s));
  2200.   Result := s1;
  2201. End;
  2202. {$ENDIF Win95}
  2203.  
  2204. {$IFDEF OS2}
  2205.   {$IFDEF GUI}
  2206. Function AnsiCompareText(Const s1, s2: String): Integer;
  2207. Var
  2208.   Temp1, Temp2: cstring[256];
  2209. Begin
  2210.   Temp1 := s1;
  2211.   Temp2 := s2;
  2212.   Case WinCompareStrings(AppHandle, 0, 0, Temp1, Temp2, 0) Of
  2213.     WCS_LT: Result := -1;
  2214.     WCS_EQ: Result :=  0;
  2215.     WCS_GT: Result :=  1;
  2216.   End;
  2217. End;
  2218.   {$ELSE GUI}
  2219. Function AnsiCompareText(Const s1, s2: String): Integer;
  2220. Var
  2221.   N, l1, l2: Integer;
  2222. Begin
  2223.   N := 1;
  2224.   l1 := Length(s1);
  2225.   l2 := Length(s2);
  2226.   While (N <= l1) And (N <= l2)
  2227.     And (CollatingSequence[s1[N]] = CollatingSequence[s2[N]]) Do Inc(N);
  2228.  
  2229.   If (N <= l1) And (N <= l2) Then
  2230.   Begin
  2231.     If CollatingSequence[s1[N]] < CollatingSequence[s2[N]] Then Result := -1
  2232.     Else If CollatingSequence[s1[N]] > CollatingSequence[s2[N]] Then Result := 1
  2233.     Else Result := 0;
  2234.   End
  2235.   Else
  2236.   Begin
  2237.     If l1 < l2 Then Result := -1
  2238.     Else If l1 > l2 Then Result := 1
  2239.     Else Result := 0;
  2240.   End;
  2241. End;
  2242.   {$ENDIF GUI}
  2243. {$ENDIF OS2}
  2244.  
  2245. {$IFDEF Win95}
  2246. Function AnsiCompareText(Const s1, s2: String): Integer;
  2247. Var
  2248.   Temp1, Temp2: Array[0..255] Of Char;
  2249. Begin
  2250.   AnsiCompareText:=lstrcmpi(StrPCopy(Temp1,s1)^,
  2251.                             StrPCopy(Temp2,s2)^);
  2252. End;
  2253. {$ENDIF Win95}
  2254.  
  2255. {$IFDEF Win95}
  2256. Function AnsiCompareStr(Const s1, s2: String): Integer;
  2257. Var
  2258.   Temp1, Temp2: Array[0..255] Of Char;
  2259. Begin
  2260.   Result := lstrcmp(StrPCopy(Temp1,s1)^, StrPCopy(Temp2,s2)^);
  2261. End;
  2262. {$ENDIF Win95}
  2263.  
  2264. Function IsValidIdent(Const Ident: String): Boolean;
  2265. Var
  2266.   L, N: Integer;
  2267. Begin
  2268.   L := Length(Ident);
  2269.   If L = 0 Then IsValidIdent := False
  2270.   Else
  2271.   Begin
  2272.     If Ident[1] In ['a'..'z', 'A'..'Z', '_'] Then
  2273.     Begin
  2274.       N := 2;
  2275.       While (N <= L) And (Ident[N] In ['a'..'z', 'A'..'Z', '_', '0'..'9']) Do Inc(N);
  2276.       If N > L Then IsValidIdent := True
  2277.       Else IsValidIdent := False;
  2278.     End
  2279.     Else IsValidIdent := False;
  2280.   End;
  2281. End;
  2282.  
  2283. Function IntToStr(Value: LongInt): String;
  2284. Begin
  2285.   Str(Value, Result);
  2286. End;
  2287.  
  2288. Function IntToHex(Value: LongInt; Digits: Integer): String;
  2289. Begin
  2290.   Result := '';
  2291.   Repeat
  2292.     Dec(Digits);
  2293.     Result := Hexadecimals[Value And $0F] + Result;
  2294.     Value := Value Shr 4;
  2295.   Until Value = 0;
  2296.   If Digits > 0 Then
  2297.   Begin
  2298.     Move(Result[1], Result[1 + Digits], Byte(Result[0]));
  2299.     FillChar(Result[1], Digits, '0');
  2300.     Inc(Byte(Result[0]), Digits);
  2301.   End;
  2302. End;
  2303.  
  2304. Function StrToInt(Const S: String): LongInt;
  2305. Var
  2306.   err: Integer;
  2307. Begin
  2308.   Val(S, Result, err);
  2309.   If err <> 0 Then FmtLoadConvertError(SInvalidInteger, [S]);
  2310. End;
  2311.  
  2312. Function StrToIntDef(Const S: String; Default: LongInt): LongInt;
  2313. Var
  2314.   err: Integer;
  2315. Begin
  2316.   Val(S, Result, err);
  2317.   If err <> 0 Then Result := Default;
  2318. End;
  2319.  
  2320. {$IFDEF OS2}
  2321. Function LoadStr(Ident: Word): String;
  2322. Var
  2323.   Buffer: cstring;
  2324. Begin
  2325.   {$IFDEF GUI}
  2326.   WinLoadString(AppHandle, 0, Ident, 256, Buffer);
  2327.   Result := Buffer;
  2328.   {$ELSE}
  2329.   Result := 'SysUtils Msg #' + IntToStr(Ident);
  2330.   {$ENDIF GUI}
  2331. End;
  2332.  
  2333. Function FmtLoadStr(Ident: Word; Const Args: Array Of Const): String;
  2334. Begin
  2335.   FmtStr(Result, LoadStr(Ident), Args);
  2336. End;
  2337. {$ENDIF OS2}
  2338.  
  2339. Function LoadTableStr(Const Table:String;Ident: Word): String;
  2340. Begin
  2341.   Result:=GetStringTableEntry(Table,Ident);
  2342. End;
  2343.  
  2344. Function LoadNLSStr(Ident: Word): String;
  2345. Begin
  2346.   Result:=GetStringTableEntry(CurrentLanguageTable,Ident);
  2347.   //If the above failed, Try To Load from Default Table...
  2348.   If Result='' Then Result:=GetStringTableEntry('SIBYL_NLS_Default',Ident);
  2349. End;
  2350.  
  2351. Function FmtLoadTableStr(Const Table:String;Ident: Word; Const Args: Array Of Const): String;
  2352. Begin
  2353.   FmtStr(Result, LoadTableStr(Table,Ident), Args);
  2354. End;
  2355.  
  2356. Function FmtLoadNLSStr(Ident: Word; Const Args: Array Of Const): String;
  2357. Begin
  2358.   FmtStr(Result, LoadNLSStr(Ident), Args);
  2359. End;
  2360.  
  2361. {$IFDEF Win95}
  2362. Function LoadStr(Ident: Word): String;
  2363. Begin
  2364.   Result[0] := Char(LoadString(DllModule,Ident,cstring(Result[1]),254));
  2365. End;
  2366.  
  2367. Function FmtLoadStr(Ident: Word; Const Args: Array Of Const): String;
  2368. Begin
  2369.   FmtStr(Result, LoadStr(Ident), Args);
  2370. End;
  2371. {$ENDIF}
  2372.  
  2373. {$IFDEF OS2}
  2374. Function SysErrorMessage(MsgNum: LongInt): String;
  2375. Var
  2376.   len, rc: LongWord;
  2377.   Table: PChar;
  2378. Begin
  2379.   rc := DosGetMessage(Table, 0, Result[1], 255, MsgNum, 'OSO001.MSG', len);
  2380.   If rc = 0 Then SetLength(Result, len)
  2381.   Else
  2382.   Begin
  2383.     Str(rc, Result);
  2384.     Result := 'DosGetMessage error #' + Result;
  2385.   End;
  2386. End;
  2387. {$ENDIF}
  2388.  
  2389. {
  2390. Procedure SetLength(Var S: String; NewLength: Byte);
  2391. Begin
  2392.   Byte(S[0]) := NewLength;
  2393. End;
  2394. }
  2395.  
  2396. Function Trim(Const S: String): String;
  2397. Var
  2398.   L, R: Integer;
  2399. Begin
  2400.   R := Length(S);
  2401.   While (R > 0) And (S[R] <= ' ') Do Dec(R);
  2402.   L := 1;
  2403.   While (L <= R) And (S[L] <= ' ') Do Inc(L);
  2404.   Result := Copy(S, L, R - L + 1);
  2405. End;
  2406.  
  2407. Function TrimLeft(Const S: String): String;
  2408. Var
  2409.   L, R: Integer;
  2410. Begin
  2411.   R := Length(S);
  2412.   L := 1;
  2413.   While (L <= R) And (S[L] <= ' ') Do Inc(L);
  2414.   Result := Copy(S, L, R - L + 1);
  2415. End;
  2416.  
  2417. Function TrimRight(Const S: String): String;
  2418. Var
  2419.   R: Integer;
  2420. Begin
  2421.   R := Length(S);
  2422.   While (R > 0) And (S[R] <= ' ') Do Dec(R);
  2423.   Result := Copy(S, 1, R);
  2424. End;
  2425.  
  2426. Function QuotedStr(Const S: String): String;
  2427. Var
  2428.   N: Integer;
  2429. Begin
  2430.   Result := #39;
  2431.   For N := 1 To Length(S) Do
  2432.   Begin
  2433.     Result := Result + S[N];
  2434.     If S[N] = #39 Then Result := Result + #39;
  2435.   End;
  2436.   Result := Result + #39;
  2437. End;
  2438.  
  2439. { --- File management --- }
  2440.  
  2441. Function FileOpen(Const FileName: String; Mode: Word): LongInt;
  2442. {$IFDEF OS2}
  2443. Const
  2444.   Action = OPEN_ACTION_OPEN_IF_EXISTS Or OPEN_ACTION_FAIL_IF_NEW;
  2445. Var
  2446.   ActionTaken, Handle: LongWord;
  2447. {$ENDIF}
  2448. {$IFDEF Win95}
  2449. Const
  2450.   Action = OPEN_EXISTING;
  2451. VAR SA:SECURITY_ATTRIBUTES;
  2452. {$ENDIF}
  2453. Var
  2454.   FileNameZ: cstring[256];
  2455. Begin
  2456.   FileNameZ := FileName;
  2457.   If Mode And ShareModes = 0 Then Mode := Mode Or fmShareDenyNone;
  2458.   {$IFDEF OS2}
  2459.   Result := - DosOpen(FileNameZ, Handle, ActionTaken, 0, 0, Action, Mode, Nil);
  2460.   If Result = NO_ERROR Then Result := Handle;
  2461.   {$ENDIF}
  2462.   {$IFDEF Win95}
  2463.   SA.nLength:=sizeof(SA);
  2464.   SA.lpSecurityDescriptor:=Nil;
  2465.   SA.bInheritHandle:=True;
  2466.   Result:=CreateFile(FileNameZ,Mode And Not 3,Mode And 3,SA,Action,
  2467.                      FILE_ATTRIBUTE_NORMAL,0);
  2468.   {$ENDIF}
  2469. End;
  2470.  
  2471. Function FileOpenOrCreate(Const FileName: String; Mode: Word): LongInt;
  2472. {$IFDEF OS2}
  2473. Const
  2474.   Action = OPEN_ACTION_OPEN_IF_EXISTS Or OPEN_ACTION_CREATE_IF_NEW;
  2475. Var
  2476.   ActionTaken, Handle: LongWord;
  2477. {$ENDIF}
  2478. {$IFDEF Win95}
  2479. Const
  2480.   Action = OPEN_ALWAYS;
  2481. Var SA:SECURITY_ATTRIBUTES;
  2482. {$ENDIF}
  2483. Var
  2484.   FileNameZ: cstring[256];
  2485. Begin
  2486.   FileNameZ := FileName;
  2487.   If Mode And ShareModes = 0 Then Mode := Mode Or fmShareDenyNone;
  2488.   {$IFDEF OS2}
  2489.   Result := - DosOpen(FileNameZ, Handle, ActionTaken, 0, 0, Action, Mode, Nil);
  2490.   If Result = NO_ERROR Then Result := Handle;
  2491.   {$ENDIF}
  2492.   {$IFDEF Win95}
  2493.   SA.nLength:=sizeof(SA);
  2494.   SA.lpSecurityDescriptor:=Nil;
  2495.   SA.bInheritHandle:=True;
  2496.   Result:=CreateFile(FileNameZ,Mode And Not 3,Mode And 3,SA,Action,
  2497.                      FILE_ATTRIBUTE_NORMAL,0);
  2498.   {$ENDIF}
  2499. End;
  2500.  
  2501. Function FileCreateIfNew(Const FileName: String; Mode: Word): LongInt;
  2502. {$IFDEF OS2}
  2503. Const
  2504.   Action = OPEN_ACTION_FAIL_IF_EXISTS Or OPEN_ACTION_CREATE_IF_NEW;
  2505. Var
  2506.   ActionTaken, Handle: LongWord;
  2507. {$ENDIF}
  2508. {$IFDEF Win95}
  2509. Const
  2510.   Action = CREATE_NEW;
  2511. Var SA:SECURITY_ATTRIBUTES;
  2512. {$ENDIF}
  2513. Var
  2514.   FileNameZ: cstring[256];
  2515. Begin
  2516.   FileNameZ := FileName;
  2517.   If Mode And ShareModes = 0 Then Mode := Mode Or fmShareDenyNone;
  2518.   {$IFDEF OS2}
  2519.   Result := - DosOpen(FileNameZ, Handle, ActionTaken, 0, 0, Action, Mode, Nil);
  2520.   If Result = NO_ERROR Then Result := Handle;
  2521.   {$ENDIF}
  2522.   {$IFDEF Win95}
  2523.   SA.nLength:=sizeof(SA);
  2524.   SA.lpSecurityDescriptor:=Nil;
  2525.   SA.bInheritHandle:=True;
  2526.   Result:=CreateFile(FileNameZ,Mode And Not 3,Mode And 3,SA,Action,
  2527.                      FILE_ATTRIBUTE_NORMAL,0);
  2528.   {$ENDIF}
  2529. End;
  2530.  
  2531. Function FileCreate(Const FileName: String): LongInt;
  2532. {$IFDEF OS2}
  2533. Const
  2534.   Action = OPEN_ACTION_REPLACE_IF_EXISTS Or OPEN_ACTION_CREATE_IF_NEW;
  2535. Var
  2536.   ActionTaken, Handle: LongWord;
  2537. {$ENDIF}
  2538. {$IFDEF Win95}
  2539. Const
  2540.   Action = CREATE_ALWAYS;
  2541. Var SA:SECURITY_ATTRIBUTES;
  2542. {$ENDIF}
  2543. Const
  2544.   Mode = fmOpenReadWrite Or fmShareExclusive;
  2545. Var
  2546.   FileNameZ: cstring[256];
  2547. Begin
  2548.   FileNameZ := FileName;
  2549.   {$IFDEF OS2}
  2550.   Result := - DosOpen(FileNameZ, Handle, ActionTaken, 0, 0, Action, Mode, Nil);
  2551.   If Result = NO_ERROR Then Result := Handle;
  2552.   {$ENDIF}
  2553.   {$IFDEF Win95}
  2554.   SA.nLength:=sizeof(SA);
  2555.   SA.lpSecurityDescriptor:=Nil;
  2556.   SA.bInheritHandle:=True;
  2557.   Result:=CreateFile(FileNameZ,Mode And Not 3,Mode And 3,SA,Action,
  2558.                      FILE_ATTRIBUTE_NORMAL,0);
  2559.   {$ENDIF}
  2560. End;
  2561.  
  2562. Function FileRead(Handle: LongInt; Var Buffer; Count: LongInt): LongInt;
  2563. Var
  2564.   Result: LongWord;
  2565. Begin
  2566.   {$IFDEF OS2}
  2567.   If DosRead(Handle, Buffer, Count, Result) = NO_ERROR Then FileRead := Result
  2568.   Else FileRead := -1;
  2569.   {$ENDIF}
  2570.   {$IFDEF Win95}
  2571.   If ReadFile(Handle,Buffer,Count,Result,Nil) Then FileRead := Result
  2572.   Else FileRead := -1;
  2573.   {$ENDIF}
  2574. End;
  2575.  
  2576. Function FileWrite(Handle: LongInt; Const Buffer; Count: LongInt): LongInt;
  2577. Var
  2578.    Result:LongWord;
  2579. Begin
  2580.   {$IFDEF OS2}
  2581.   If DosWrite(Handle, Buffer, Count, Result) = NO_ERROR Then FileWrite := Result
  2582.   Else FileWrite := -1;
  2583.   {$ENDIF}
  2584.   {$IFDEF Win95}
  2585.   If Not WriteFile(Handle,Buffer,Count,Result,Nil) Then Result := -1
  2586.   Else FileWrite := Result;
  2587.   {$ENDIF}
  2588. End;
  2589.  
  2590. Function FileSeek(Handle: LongInt; Offset: LongInt; Origin: Integer): LongInt;
  2591. {$IFDEF OS2}
  2592. Var
  2593.   NewPos: LongWord;
  2594. {$ENDIF}
  2595. Begin
  2596.   {$IFDEF OS2}
  2597.   If DosSetFilePtr(Handle, Offset, Origin, NewPos) = NO_ERROR Then FileSeek := NewPos
  2598.   Else FileSeek := -1;
  2599.   {$ENDIF}
  2600.   {$IFDEF Win95}
  2601.   Result:=SetFilePointer(Handle,Offset,Nil,Origin);
  2602.   {$ENDIF}
  2603. End;
  2604.  
  2605. Procedure FileClose(Handle: LongInt);
  2606. Begin
  2607.   {$IFDEF OS2}
  2608.   DosClose(Handle);
  2609.   {$ENDIF}
  2610.   {$IFDEF Win95}
  2611.   CloseHandle(Handle);
  2612.   {$ENDIF}
  2613. End;
  2614.  
  2615. Function FileLock(Handle, Offset, Range: LongInt): Boolean;
  2616. {$IFDEF OS2}
  2617. Var
  2618.   Lock, UnLock: BseDos.FileLock;
  2619. {$ENDIF}
  2620. Begin
  2621.   {$IFDEF OS2}
  2622.   Lock.LOffset := Offset;
  2623.   Lock.LRange := Range;
  2624.   UnLock.LOffset := 0;
  2625.   UnLock.LRange := 0;
  2626.   Result := (DosSetFileLocks(Handle, UnLock, Lock, LockTimeout, 0) = NO_ERROR);
  2627.   {$ENDIF}
  2628.   {$IFDEF Win95}
  2629.   Result := LockFile(Handle,Offset,0,Range,0);
  2630.   {$ENDIF}
  2631. End;
  2632.  
  2633. Function FileUnLock(Handle, Offset, Range: LongInt): Boolean;
  2634. {$IFDEF OS2}
  2635. Var
  2636.   Lock, UnLock: BseDos.FileLock;
  2637. {$ENDIF}
  2638. Begin
  2639.   {$IFDEF OS2}
  2640.   UnLock.LOffset := Offset;
  2641.   UnLock.LRange := Range;
  2642.   Lock.LOffset := 0;
  2643.   Lock.LRange := 0;
  2644.   Result := (DosSetFileLocks(Handle, UnLock, Lock, LockTimeout, 0) = NO_ERROR);
  2645.   {$ENDIF}
  2646.   {$IFDEF Win95}
  2647.   Result := UnlockFile(Handle,Offset,0,Range,0);
  2648.   {$ENDIF}
  2649. End;
  2650.  
  2651. Function FileAge(Const FileName: String): LongInt;
  2652. Var
  2653.   FileNameZ: cstring;
  2654. {$IFDEF OS2}
  2655.   Buffer: FILESTATUS3;
  2656. {$ENDIF}
  2657. {$IFDEF Win95}
  2658.   Handle:LongWord;
  2659.   LastAccess,creation,LastWrite,actual:FILETIME;
  2660.   date,Time:Word;
  2661. {$ENDIF}
  2662. Begin
  2663.   FileNameZ := FileName;
  2664.   {$IFDEF OS2}
  2665.   If DosQueryPathInfo(FileNameZ, FIL_STANDARD, Buffer, SizeOf(Buffer)) = NO_ERROR Then
  2666.     FileAge := (Buffer.fdateLastWrite Shl 16) Or Buffer.ftimeLastWrite
  2667.   Else FileAge := -1;
  2668.   {$ENDIF}
  2669.   {$IFDEF Win95}
  2670.   Handle:=CreateFile(FileNameZ,GENERIC_READ,0,Nil,OPEN_EXISTING,
  2671.                      FILE_ATTRIBUTE_NORMAL,0);
  2672.   If Handle=-1 Then
  2673.   Begin
  2674.        FileAge:=-1;
  2675.        Exit;
  2676.   End;
  2677.   If Not GetFileTime(Handle,creation,LastAccess,LastWrite) Then
  2678.   Begin
  2679.        CloseHandle(Handle);
  2680.        FileAge:=-1;
  2681.        Exit;
  2682.   End;
  2683.   CloseHandle(Handle);
  2684.   FileTimeToLocalFileTime(LastWrite,actual);
  2685.   FileTimeToDosDateTime(actual,date,Time);
  2686.   FileAge := (date Shl 16) Or Time;
  2687.   {$ENDIF}
  2688. End;
  2689.  
  2690. Function FileExists(Const FileName: String): Boolean;
  2691. Var
  2692.   SearchRec: TSearchRec;
  2693. Begin
  2694.   If FindFirst(FileName, faAnyFile, SearchRec) = 0 Then
  2695.   Begin
  2696.     FileExists := True;
  2697.     FindClose(SearchRec);
  2698.   End
  2699.   Else FileExists := False;
  2700. End;
  2701.  
  2702. Function FindFirst(Const Path: String; Attr: Integer; Var SearchRec: TSearchRec): LongInt;
  2703. {$IFDEF OS2}
  2704. Var
  2705.   OS2SearchRec: FILEFINDBUF3;
  2706.   Result, Count: LongWord;
  2707. Const
  2708.   Size = SizeOf(OS2SearchRec);
  2709. {$ENDIF}
  2710. {$IFDEF WIN32}
  2711. Var Actual:FILETIME;
  2712.     date,time:word;
  2713. {$ENDIF}
  2714. Var
  2715.   PathZ: cstring;
  2716. Begin
  2717.   PathZ := Path;
  2718.   {$IFDEF OS2}
  2719.   SearchRec.HDir := HDIR_CREATE;
  2720.   Count := 1;
  2721.   Result := DosFindFirst(PathZ, SearchRec.HDir, Attr, OS2SearchRec, Size, Count, FIL_STANDARD);
  2722.   If Result = NO_ERROR Then
  2723.   Begin
  2724.     With OS2SearchRec Do
  2725.     Begin
  2726.       SearchRec.Name := achName;
  2727.       SearchRec.Size := cbFile;
  2728.       SearchRec.Attr := attrFile;
  2729.       SearchRec.Time := fdateLastWrite;
  2730.       SearchRec.Time := SearchRec.Time Shl 16 + ftimeLastWrite;
  2731.     End;
  2732.     FindFirst := 0;
  2733.   End
  2734.   Else FindFirst := -Result;
  2735.   {$ENDIF}
  2736.   {$IFDEF Win95}
  2737.   SearchRec.InternalAttr:=Attr;
  2738.   SearchRec.HDir:=FindFirstFile(PathZ,SearchRec.SearchRecIntern);
  2739.   If SearchRec.HDir=INVALID_HANDLE_VALUE Then
  2740.   Begin
  2741.        FindFirst:=-GetLastError;
  2742.        Exit;
  2743.   End;
  2744.   While SearchRec.SearchRecIntern.dwFileAttributes And SearchRec.InternalAttr=0 Do
  2745.   Begin
  2746.        If FindNextFile(SearchRec.HDir,SearchRec.SearchRecIntern)=False Then
  2747.        Begin
  2748.             Result:=-GetLastError;
  2749.             WinBase.FindClose(SearchRec.HDir);
  2750.             Exit;
  2751.        End;
  2752.   End;
  2753.  
  2754.   FileTimeToLocalFileTime(SearchRec.SearchRecIntern.ftLastWriteTime,Actual);
  2755.   FileTimeToDosDateTime(Actual,date,time);
  2756.   SearchRec.Time:=(date Shl 16) Or Time;
  2757.   SearchRec.Size:=SearchRec.SearchRecIntern.nFileSizeLow;
  2758.   SearchRec.Attr:=SearchRec.SearchRecIntern.dwFileAttributes;
  2759.   SearchRec.Name:=cstring(SearchRec.SearchRecIntern.cFileName);
  2760.   Result := 0;
  2761.   {$ENDIF}
  2762. End;
  2763.  
  2764. Function FindNext(Var SearchRec: TSearchRec): LongInt;
  2765. {$IFDEF OS2}
  2766. Var
  2767.   OS2SearchRec: FILEFINDBUF3;
  2768.   Result: Integer;
  2769.   Count: LongWord;
  2770. Const
  2771.   Size = SizeOf(OS2SearchRec);
  2772. {$ENDIF}
  2773. {$IFDEF WIN32}
  2774. Var Actual:FILETIME;
  2775.     date,time:word;
  2776. {$ENDIF}
  2777. Begin
  2778.   {$IFDEF OS2}
  2779.   Count := 1;
  2780.   Result := DosFindNext (SearchRec.HDir, OS2SearchRec, Size, Count);
  2781.   If Result = NO_ERROR Then
  2782.   Begin
  2783.     With OS2SearchRec Do
  2784.     Begin
  2785.       SearchRec.Name := achName;
  2786.       SearchRec.Size := cbFile;
  2787.       SearchRec.Attr := attrFile;
  2788.       SearchRec.Time := fdateLastWrite;
  2789.       SearchRec.Time := SearchRec.Time Shl 16 + ftimeLastWrite;
  2790.     End;
  2791.     FindNext := 0;
  2792.   End
  2793.   Else FindNext := -Result;
  2794.   {$ENDIF}
  2795.   {$IFDEF Win95}
  2796.   If FindNextFile(SearchRec.HDir,SearchRec.SearchRecIntern)=False Then
  2797.   Begin
  2798.        Result:=-GetLastError;
  2799.        WinBase.FindClose(SearchRec.HDir);
  2800.        Exit;
  2801.   End;
  2802.   While SearchRec.SearchRecIntern.dwFileAttributes And SearchRec.InternalAttr=0 Do
  2803.   Begin
  2804.        If FindNextFile(SearchRec.HDir,SearchRec.SearchRecIntern)=False Then
  2805.        Begin
  2806.             Result:=-GetLastError;
  2807.             WinBase.FindClose(SearchRec.HDir);
  2808.             Exit;
  2809.        End;
  2810.   End;
  2811.  
  2812.   FileTimeToLocalFileTime(SearchRec.SearchRecIntern.ftLastWriteTime,Actual);
  2813.   FileTimeToDosDateTime(Actual,date,time);
  2814.   SearchRec.Time:=(date Shl 16) Or Time;
  2815.   SearchRec.Size:=SearchRec.SearchRecIntern.nFileSizeLow;
  2816.   SearchRec.Attr:=SearchRec.SearchRecIntern.dwFileAttributes;
  2817.   SearchRec.Name:=cstring(SearchRec.SearchRecIntern.cFileName);
  2818.   Result := 0;
  2819.   {$ENDIF}
  2820. End;
  2821.  
  2822. Procedure FindClose(Var SearchRec: TSearchRec);
  2823. Begin
  2824.   {$IFDEF OS2}
  2825.   DosFindClose(SearchRec.HDir);
  2826.   {$ENDIF}
  2827.   {$IFDEF Win95}
  2828.   WinBase.FindClose(SearchRec.HDir);
  2829.   {$ENDIF}
  2830. End;
  2831.  
  2832. Function FileGetDate(Handle: LongInt): LongInt;
  2833. {$IFDEF OS2}
  2834. Var
  2835.   Buffer: FILESTATUS3;
  2836. {$ENDIF}
  2837. {$IFDEF Win95}
  2838. Var
  2839.   LastAccess,creation,LastWrite,actual:FILETIME;
  2840.   date,Time:Word;
  2841. {$ENDIF}
  2842. Begin
  2843.   {$IFDEF OS2}
  2844.   If DosQueryFileInfo(Handle, FIL_STANDARD, Buffer, SizeOf(Buffer)) = NO_ERROR Then
  2845.     FileGetDate := (Buffer.fdateLastWrite Shl 16) Or Buffer.ftimeLastWrite
  2846.   Else FileGetDate := -1;
  2847.   {$ENDIF}
  2848.   {$IFDEF Win95}
  2849.   If Not GetFileTime(Handle,creation,LastAccess,LastWrite) Then
  2850.   Begin
  2851.        CloseHandle(Handle);
  2852.        FileGetDate:=-1;
  2853.        Exit;
  2854.   End;
  2855.   CloseHandle(Handle);
  2856.   FileTimeToLocalFileTime(LastWrite,actual);
  2857.   FileTimeToDosDateTime(actual,date,Time);
  2858.   FileGetDate := (date Shl 16) Or Time;
  2859.   {$ENDIF}
  2860. End;
  2861.  
  2862. Procedure FileSetDate(Handle: Integer; Age: LongInt);
  2863. {$IFDEF OS2}
  2864. Var
  2865.   Buffer: FILESTATUS3;
  2866. {$ENDIF}
  2867. {$IFDEF Win95}
  2868. Var
  2869.    date,Time:Word;
  2870.    LastWrite:FILETIME;
  2871. {$ENDIF}
  2872. Begin
  2873.   {$IFDEF OS2}
  2874.   FillChar(Buffer, SizeOf(Buffer), 0);
  2875.   Buffer.ftimeLastWrite := Age And $FFFF;
  2876.   Buffer.fdateLastWrite := Age Shr 16;
  2877.   DosSetFileInfo(Handle, FIL_STANDARD, Buffer, SizeOf(Buffer));
  2878.   {$ENDIF}
  2879.   {$IFDEF Win95}
  2880.   date:= Age Shr 16;
  2881.   Time:= Age And $FFFF;
  2882.   DosDateTimeToFileTime(date,Time,LastWrite);
  2883.  
  2884.   WinBase.SetFileTime(Handle,Nil,Nil,LastWrite);
  2885.   {$ENDIF}
  2886. End;
  2887.  
  2888. Function FileGetAttr(Const FileName: String): LongInt;
  2889. {$IFDEF OS2}
  2890. Var
  2891.   Buffer: FILESTATUS3;
  2892. {$ENDIF}
  2893. Var
  2894.   FileNameZ: cstring;
  2895. Begin
  2896.   FileNameZ := FileName;
  2897.   {$IFDEF OS2}
  2898.   Result := - DosQueryPathInfo(FileNameZ, FIL_STANDARD, Buffer, SizeOf(Buffer));
  2899.   If Result = 0 Then Result := Buffer.attrFile;
  2900.   {$ENDIF}
  2901.   {$IFDEF Win95}
  2902.   Result := GetFileAttributes(FileNameZ);
  2903.   {$ENDIF}
  2904. End;
  2905.  
  2906. Function FileSetAttr(Const FileName: String; Attr: Integer): Integer;
  2907. {$IFDEF OS2}
  2908. Var
  2909.   Buffer: FILESTATUS3;
  2910. {$ENDIF}
  2911. Var
  2912.   FileNameZ: cstring;
  2913. Begin
  2914.   FileNameZ := FileName;
  2915.   {$IFDEF OS2}
  2916.   FillChar(Buffer, SizeOf(Buffer), 0);
  2917.   Buffer.attrFile := Attr;
  2918.   Result := - DosSetPathInfo(FileNameZ, FIL_STANDARD, Buffer, SizeOf(Buffer), 0);
  2919.   {$ENDIF}
  2920.   {$IFDEF Win95}
  2921.   If SetFileAttributes(FileNameZ,Attr) Then Result:=0
  2922.   Else Result := -GetLastError;
  2923.   {$ENDIF}
  2924. End;
  2925.  
  2926. Function CopyFile(Const SourceName, DestName: String): Boolean;
  2927. Var
  2928.   SourceZ, DestZ: cstring;
  2929. Begin
  2930.   SourceZ := SourceName;
  2931.   DestZ := DestName;
  2932.   {$IFDEF OS2}
  2933.   Result := (DosCopy(SourceZ, DestZ, DCPY_EXISTING) = NO_ERROR);
  2934.   {$ENDIF}
  2935.   {$IFDEF Win95}
  2936.   Result := WinBase.CopyFile(SourceZ, DestZ, True);
  2937.   {$ENDIF}
  2938. End;
  2939.  
  2940. Function DeleteFile(Const FileName: String): Boolean;
  2941. Var
  2942.   FileNameZ: cstring;
  2943. Begin
  2944.   FileNameZ := FileName;
  2945.   {$IFDEF OS2}
  2946.   Result := (DosDelete(FileNameZ) = NO_ERROR);
  2947.   {$ENDIF}
  2948.   {$IFDEF Win95}
  2949.   Result := WinBase.DeleteFile(FileNameZ);
  2950.   {$ENDIF}
  2951. End;
  2952.  
  2953. Function RenameFile(Const OldName, NewName: String): Boolean;
  2954. Var
  2955.   OldNameZ, NewNameZ: cstring;
  2956. Begin
  2957.   OldNameZ := OldName;
  2958.   NewNameZ := NewName;
  2959.   {$IFDEF OS2}
  2960.   Result := (DosMove(OldNameZ, NewNameZ) = NO_ERROR);
  2961.   {$ENDIF}
  2962.   {$IFDEF Win95}
  2963.   Result := MoveFile(OldNameZ, NewNameZ);
  2964.   {$ENDIF}
  2965. End;
  2966.  
  2967. Function ChangeFileExt(Const FileName, extension: String): String;
  2968. Var
  2969.   P: Integer;
  2970. Begin
  2971.   P := Length(FileName);
  2972.   While (P > 0) And (FileName[P] <> '.') Do Dec(P);
  2973.   If P = 0 Then Result := FileName + extension
  2974.   Else Result := Copy(FileName, 1, P - 1) + extension;
  2975. End;
  2976.  
  2977. Function ExtractFilePath(Const FileName: String): String;
  2978. Var
  2979.   P: Integer;
  2980. Begin
  2981.   P := Length(FileName);
  2982.   While (P > 0) And (FileName[P] <> ':') And (FileName[P] <> '\') Do Dec(P);
  2983.   Result := Copy(FileName, 1, P);
  2984. End;
  2985.  
  2986. Function ExtractFileName(Const FileName: String): String;
  2987. Var
  2988.   P: Integer;
  2989. Begin
  2990.   P := Length(FileName);
  2991.   While (P > 0) And (FileName[P] <> ':') And (FileName[P] <> '\') Do Dec(P);
  2992.   Result := Copy(FileName, P + 1, 255);
  2993. End;
  2994.  
  2995. Function ExtractFileExt(Const FileName: String): String;
  2996. Var
  2997.   P: Integer;
  2998. Begin
  2999.   P := Length(FileName);
  3000.   While (P > 0) And (FileName[P] <> '.') Do Dec(P);
  3001.   If P = 0 Then Result := ''
  3002.   Else Result := Copy(FileName, P, 255);
  3003. End;
  3004.  
  3005. Function ConcatFileName(Const pathname, FileName: String): String;
  3006. Begin
  3007.   If (pathname = '') Or (FileName = '') Or
  3008.     (pathname[Length(pathname)] In ['\', ':']) Then
  3009.       Result := pathname + FileName
  3010.   Else Result := pathname + '\' + FileName;
  3011. End;
  3012.  
  3013. Function ExpandFileName(FileName: String): String;
  3014. {$IFDEF OS2}
  3015. Const
  3016.   Level = FIL_QUERYFULLNAME;
  3017. Var
  3018.   Buffer:CString;
  3019. {$ENDIF}
  3020. {$IFDEF Win95}
  3021. Var
  3022.    TempName : PChar;
  3023. {$ENDIF}
  3024. Var
  3025.   FileNameZ: cstring;
  3026. Begin
  3027.   FileNameZ := FileName;
  3028.   {$IFDEF OS2}
  3029.   If DosQueryPathInfo(FileNameZ, Level, Buffer, SizeOf(Buffer)) = NO_ERROR Then Result := Buffer
  3030.   Else
  3031.   Begin
  3032.       If ((length(FileName)=2)And(FileName[2]=':')) Then
  3033.       Begin
  3034.            {$I-}
  3035.            GetDir(ord(Upcase(FileName[1]))-64,Result);
  3036.            {$I+}
  3037.            If IoResult<>0 Then Result:='';
  3038.       End
  3039.       Else Result:='';
  3040.   End;
  3041.   {$ENDIF}
  3042.   {$IFDEF Win95}
  3043.   Result[0]:=Chr(GetFullPathName(FileNameZ,256,cstring(Result[1]),TempName));
  3044.   {$ENDIF}
  3045. End;
  3046.  
  3047. Function EditFileName(Const Name, edit: String): String;
  3048. {$IFDEF OS2}
  3049. Var
  3050.   Buffer: cstring;
  3051. {$ENDIF}
  3052. Var
  3053.   NameZ, EditZ: cstring;
  3054. Begin
  3055.   NameZ := Name;
  3056.   EditZ := edit;
  3057.   {$IFDEF OS2}
  3058.   If DosEditName(1, NameZ, EditZ, Buffer, 256) = 0 Then Result := Buffer
  3059.   Else Result := '';
  3060.   {$ENDIF}
  3061.   {$IFDEF Win95}
  3062.   Result := '';  //Not supported
  3063.   {$ENDIF}
  3064. End;
  3065.  
  3066. Function FileSearch(Const Name, DirList: String): String;
  3067. {$IFDEF OS2}
  3068. Const
  3069.   Flags = SEARCH_IGNORENETERRS;
  3070. {$ENDIF}
  3071. {$IFDEF Win95}
  3072. Var
  3073.    Temp : PChar;
  3074. {$ENDIF}
  3075. Var
  3076.   NameZ, DirListZ, Buffer: cstring;
  3077. Begin
  3078.   NameZ := Name;
  3079.   DirListZ := DirList;
  3080.   {$IFDEF OS2}
  3081.   If DosSearchPath(Flags, DirListZ, NameZ, Buffer, SizeOf(Buffer)) = NO_ERROR Then
  3082.     Result := Buffer
  3083.   Else Result := '';
  3084.   {$ENDIF}
  3085.   {$IFDEF Win95}
  3086.   If SearchPath(DirListZ,Name,Nil,256,Buffer,Temp)=0 Then Result:=''
  3087.   Else Result:=Buffer;
  3088.   {$ENDIF}
  3089. End;
  3090.  
  3091. Function DiskFree(Drive: Byte): LongInt;
  3092. {$IFDEF OS2}
  3093. Var
  3094.   Buffer: FSALLOCATE;
  3095. {$ENDIF}
  3096. {$IFDEF Win95}
  3097. Var
  3098.   C : cstring;
  3099.   S:LongWord;
  3100.   Sec,clust,freeclust:LongWord;
  3101. {$ENDIF}
  3102. Begin
  3103.   {$IFDEF OS2}
  3104.   If DosQueryFSInfo(Drive, FSIL_ALLOC, Buffer, SizeOf(Buffer)) = NO_ERROR Then
  3105.     With Buffer Do Result := cUnitAvail * cSectorUnit * cbSector
  3106.   Else Result := -1;
  3107.   {$ENDIF}
  3108.   {$IFDEF Win95}
  3109.   If Drive=0 Then
  3110.   Begin
  3111.        If Not GetDiskFreeSpace(Nil,S,Sec,freeclust,clust) Then
  3112.        Begin
  3113.             Result:=-1;
  3114.             Exit;
  3115.        End;
  3116.   End
  3117.   Else
  3118.   Begin
  3119.        C:=Chr(Ord('A')+(Drive-1))+':\';
  3120.        If Not GetDiskFreeSpace(C,S,Sec,freeclust,clust) Then
  3121.        Begin
  3122.             Result:=-1;
  3123.             Exit;
  3124.        End;
  3125.   End;
  3126.   Result:=S*Sec*freeclust;
  3127.   {$ENDIF}
  3128. End;
  3129.  
  3130. Function DiskSize(Drive: Byte): LongInt;
  3131. {$IFDEF OS2}
  3132. Var
  3133.   Buffer: FSALLOCATE;
  3134. {$ENDIF}
  3135. {$IFDEF Win95}
  3136. Var
  3137.   C : cstring;
  3138.   S:LongWord;
  3139.   Sec,clust,freeclust:LongWord;
  3140. {$ENDIF}
  3141. Begin
  3142.   {$IFDEF OS2}
  3143.   If DosQueryFSInfo(Drive, FSIL_ALLOC, Buffer, SizeOf(Buffer)) = NO_ERROR Then
  3144.     With Buffer Do Result := cUnit * cSectorUnit * cbSector
  3145.   Else Result := -1;
  3146.   {$ENDIF}
  3147.   {$IFDEF Win95}
  3148.   If Drive=0 Then
  3149.   Begin
  3150.        If Not GetDiskFreeSpace(Nil,S,Sec,freeclust,clust) Then
  3151.        Begin
  3152.             Result:=-1;
  3153.             Exit;
  3154.        End;
  3155.   End
  3156.   Else
  3157.   Begin
  3158.        C:=Chr(Ord('A')+(Drive-1))+':\';
  3159.        If Not GetDiskFreeSpace(C,S,Sec,freeclust,clust) Then
  3160.        Begin
  3161.             Result:=-1;
  3162.             Exit;
  3163.        End;
  3164.   End;
  3165.   Result:=S*Sec*clust;
  3166.   {$ENDIF}
  3167. End;
  3168.  
  3169. Function FileDateToDateTime(FileDate: LongInt): TDateTime;
  3170. Var
  3171.   Day, Month, Year, Hour, Min, Sec: Word;
  3172. Begin
  3173.   Sec      := (FileDate And 31) Shl 1;
  3174.   FileDate := FileDate Shr 5;
  3175.   Min      := FileDate And 63;
  3176.   FileDate := FileDate Shr 6;
  3177.   Hour     := FileDate And 31;
  3178.   FileDate := FileDate Shr 5;
  3179.  
  3180.   Day      := FileDate And 31;
  3181.   FileDate := FileDate Shr 5;
  3182.   Month    := FileDate And 15;
  3183.   FileDate := FileDate Shr 4;
  3184.   Year     := 1980 + (FileDate And 127);
  3185.  
  3186.   Result := EncodeDate(Year, Month, Day) + EncodeTime(Hour, Min, Sec, 0);
  3187. End;
  3188.  
  3189. Function DateTimeToFileDate(DateTime: TDateTime): LongInt;
  3190. Var
  3191.   Day, Month, Year, Hour, Min, Sec, MSec: Word;
  3192.   FileDate, FILETIME: LongInt;
  3193. Begin
  3194.   DecodeDate(DateTime, Year, Month, Day);
  3195.   DecodeTime(DateTime, Hour, Min, Sec, MSec);
  3196.  
  3197.   FileDate := Year - 1980;
  3198.   FileDate := (FileDate Shl 4) Or Month;
  3199.   FileDate := (FileDate Shl 5) Or Day;
  3200.  
  3201.   FILETIME := Hour;
  3202.   FILETIME := (FILETIME Shl 6) Or Min;
  3203.   FILETIME := (FILETIME Shl 5) Or (Sec Div 2);
  3204.  
  3205.   Result := (FileDate Shl 16) Or FILETIME;
  3206. End;
  3207.  
  3208. /* Alte Implementierung, macht Probleme mit neuem Compiler
  3209.  
  3210. Function DateTimeToFileDate(DateTime: TDateTime): LongInt;
  3211. Var
  3212.   Day, Month, Year, Hour, Min, Sec, MSec: Word;
  3213.   FileDate: LongInt;
  3214. Begin
  3215.   DecodeDate(DateTime, Year, Month, Day);
  3216.   DecodeTime(DateTime, Hour, Min, Sec, MSec);
  3217.  
  3218.   FileDate := Year - 1980;
  3219.   FileDate := (FileDate Shl 4) Or Month;
  3220.   FileDate := (FileDate Shl 5) Or Day;
  3221.   FileDate := Hour;
  3222.   FileDate := (FileDate Shl 6) Or Min;
  3223.   FileDate := (FileDate Shl 5) Or (Sec Div 2);
  3224.  
  3225.   Result := FileDate;
  3226. End;
  3227.  
  3228. */
  3229.  
  3230. { --- PChar Handling --- }
  3231.  
  3232. Function StrLen(Str:PChar): Cardinal;
  3233. Begin
  3234.   Asm
  3235.     MOV       EDI, Str
  3236.     CALLN32   !StringLength
  3237.     MOV       Result, EAX
  3238.   End;
  3239. End;
  3240.  
  3241. Function StrEnd(Str:PChar):PChar;
  3242. Begin
  3243.   Asm
  3244.     MOV       EDI, Str
  3245.     CALLN32   !StringLength
  3246.     MOV       Result, EDI
  3247.   End;
  3248. End;
  3249.  
  3250. Function StrMove(Dest, Source: PChar; Count: Cardinal): PChar;
  3251. Begin
  3252.   If (Source = Nil) Or (Dest = Nil) Or (Count = 0) Then Result := Nil
  3253.   Else
  3254.   Begin
  3255.     Move(Source^, Dest^, Count);
  3256.     Result := Dest;
  3257.   End;
  3258. End;
  3259.  
  3260. Function StrCopy(Dest, Source:PChar):PChar;
  3261. Begin
  3262.   Asm
  3263.     MOV       ESI, Source
  3264.     MOV       EDI, Dest
  3265.     MOV       ECX, $FFFFFFFF
  3266.     CALLN32   !StringCopy
  3267.     MOV       EAX, Dest
  3268.     MOV       Result, EAX
  3269.   End;
  3270. End;
  3271.  
  3272. Function StrECopy(Dest, Source:PChar):PChar;
  3273. Begin
  3274.   Asm
  3275.     MOV       ESI, Source
  3276.     MOV       EDI, Dest
  3277.     MOV       ECX, $FFFFFFFF
  3278.     CALLN32   !StringCopy
  3279.     MOV       Result, EDI
  3280.   End;
  3281. End;
  3282.  
  3283. Function StrLCopy(Dest, Source:PChar; MaxLen: Cardinal):PChar;
  3284. Begin
  3285.   Asm
  3286.     MOV       ESI, Source
  3287.     MOV       EDI, Dest
  3288.     MOV       ECX, MaxLen
  3289.     CALLN32   !StringCopy
  3290.     MOV       EAX, Dest
  3291.     MOV       Result, EAX
  3292.   End;
  3293. End;
  3294.  
  3295. Function StrPCopy(Dest: PChar; Const Source: String): PChar;
  3296. Begin
  3297.   Asm
  3298.     MOV       EDI, Dest
  3299.     MOV       ESI, Source
  3300.     Xor       ECX, ECX
  3301.     MOV       CL, [ESI]
  3302.     Inc       ESI
  3303.     CALLN32   !StringCopy
  3304.     MOV       EAX, Dest
  3305.     MOV       Result, EAX
  3306.   End;
  3307. End;
  3308.  
  3309. Function StrPLCopy(Dest: PChar; Const Source: String; MaxLen: Cardinal): PChar;
  3310. Begin
  3311.   Asm
  3312.     MOV       EDI, Dest
  3313.     MOV       ESI, Source
  3314.     Xor       ECX, ECX
  3315.     MOV       CL, [ESI]
  3316.     Inc       ESI
  3317.     CMP       ECX, MaxLen
  3318.     JLE       StrPLCopy_1
  3319.     MOV       ECX, MaxLen
  3320.  
  3321.     StrPLCopy_1:
  3322.  
  3323.     CALLN32   !StringCopy
  3324.     MOV       EAX, Dest
  3325.     MOV       Result, EAX
  3326.   End;
  3327. End;
  3328.  
  3329. Function StrCat(Dest, Source: PChar): PChar;
  3330. Begin
  3331.   Asm
  3332.     MOV       EDI, Dest
  3333.     MOV       ESI, Source
  3334.     CALLN32   !StringLength
  3335.     MOV       ECX, $FFFFFFFF
  3336.     CALLN32   !StringCopy
  3337.     MOV       EAX, Dest
  3338.     MOV       Result, EAX
  3339.   End;
  3340. End;
  3341.  
  3342. Function StrLCat(Dest, Source: PChar; MaxLen: Cardinal): PChar;
  3343. Begin
  3344.   Asm
  3345.     MOV       EDI, Dest
  3346.     MOV       ESI, Source
  3347.     CALLN32   !StringLength
  3348.     MOV       ECX, MaxLen
  3349.     SUB       ECX, EAX
  3350.     JLE       StrLCat_1
  3351.     CALLN32   !StringCopy
  3352.  
  3353.     StrLCat_1:
  3354.  
  3355.     MOV       EAX, Dest
  3356.     MOV       Result, EAX
  3357.   End;
  3358. End;
  3359.  
  3360. Function StrComp(Str1, Str2: PChar): Integer;
  3361. Begin
  3362.   Asm
  3363.     MOV        EDI, Str1
  3364.     CALLN32    !StringLength
  3365.     MOV        ECX, EAX
  3366.     MOV        ESI, Str1
  3367.     MOV        EDI, Str2
  3368.     CALLN32    !StringCompare
  3369.     MOV        Result, EAX
  3370.   End;
  3371. End;
  3372.  
  3373. Function StrLComp(Str1, Str2: PChar; MaxLen: Cardinal): Integer;
  3374. Begin
  3375.   Asm
  3376.     MOV        EDI, Str1
  3377.     MOV        ECX, MaxLen
  3378.     MOV        EBX, ECX
  3379.     Xor        EAX, EAX
  3380.     REPNZ      SCASB
  3381.     SUB        EBX, ECX
  3382.     MOV        ECX, EBX
  3383.     MOV        ESI, Str1
  3384.     MOV        EDI, Str2
  3385.     CALLN32    !StringCompare
  3386.     MOV        Result, EAX
  3387.   End;
  3388. End;
  3389.  
  3390. Function StrIComp(Str1, Str2: PChar): Integer;
  3391. Begin
  3392.   Asm
  3393.     MOV        EDI, Str1
  3394.     CALLN32    !StringLength
  3395.     MOV        ECX, EAX
  3396.     MOV        ESI, Str1
  3397.     MOV        EDI, Str2
  3398.     CALLN32    !StringICompare
  3399.     MOV        Result, EAX
  3400.   End;
  3401. End;
  3402.  
  3403. Function StrLIComp(Str1, Str2: PChar; MaxLen: Cardinal): Integer;
  3404. Begin
  3405.   Asm
  3406.     MOV        EDI, Str1
  3407.     MOV        ECX, MaxLen
  3408.     MOV        EBX, ECX
  3409.     Xor        EAX, EAX
  3410.     REPNZ      SCASB
  3411.     SUB        EBX, ECX
  3412.     MOV        ECX, EBX
  3413.     MOV        ESI, Str1
  3414.     MOV        EDI, Str2
  3415.     CALLN32    !StringICompare
  3416.     MOV        Result, EAX
  3417.   End;
  3418. End;
  3419.  
  3420. Function StrScan(Str: PChar; Chr: Char): PChar;
  3421. Begin
  3422.   Asm
  3423.     MOV        EDI, Str
  3424.     CALLN32    !StringLength
  3425.     Inc        EAX
  3426.     MOV        ECX, EAX
  3427.     Xor        EBX, EBX
  3428.     MOV        AL, Chr
  3429.     MOV        EDI, Str
  3430.     REPNZ      SCASB
  3431.     Dec        EDI
  3432.     CMP        AL, [EDI]
  3433.     JNE        !StrScan_1
  3434.     MOV        EBX, EDI
  3435.  
  3436.     !StrScan_1:
  3437.  
  3438.     MOV        Result, EBX
  3439.   End;
  3440. End;
  3441.  
  3442. Function StrRScan(Str: PChar; Chr: Char): PChar;
  3443. Begin
  3444.   Asm
  3445.     MOV        EDI, Str
  3446.     CALLN32    !StringLength
  3447.     Inc        EAX
  3448.     MOV        ECX, EAX
  3449.     Xor        EBX, EBX
  3450.     MOV        AL, Chr
  3451.     STD
  3452.     REPNZ      SCASB
  3453.     Inc        EDI
  3454.     CMP        AL, [EDI]
  3455.     JNE        !StrRScan_1
  3456.     MOV        EBX, EDI
  3457.  
  3458.     !StrRScan_1:
  3459.  
  3460.     CLD
  3461.     MOV        Result, EBX
  3462.   End;
  3463. End;
  3464.  
  3465. Function StrPos(Str, SubStr: PChar): PChar;
  3466. Begin
  3467.   Asm
  3468.     MOV       EDI, SubStr
  3469.     CALLN32   !StringLength
  3470.     CMP       EAX, 0
  3471.     JE        !ErrOutStrPos
  3472.  
  3473.     MOV       EDX, EAX
  3474.     MOV       EDI, Str
  3475.     CALLN32   !StringLength
  3476.     CMP       EAX, 0
  3477.     JE        !ErrOutStrPos
  3478.     SUB       EAX, EDX
  3479.     JB        !ErrOutStrPos
  3480.     MOV       EDI, Str
  3481.  
  3482.     !1:
  3483.  
  3484.     MOV       ESI, SubStr
  3485.     LODSB
  3486.     REPNE     SCASB
  3487.     JNE       !ErrOutStrPos;
  3488.     MOV       EAX, ECX
  3489.     PUSH      EDI
  3490.     MOV       ECX, EDX
  3491.     Dec       ECX
  3492.     REPE      CMPSB
  3493.     MOV       ECX, EAX
  3494.     POP       EDI
  3495.     JNE       !1
  3496.     MOV       EAX, EDI
  3497.     Dec       EAX
  3498.     JMP       !out
  3499.  
  3500.     !ErrOutStrPos:
  3501.  
  3502.     Xor EAX,EAX
  3503.  
  3504.     !out:
  3505.  
  3506.     MOV Result, EAX
  3507.   End;
  3508. End;
  3509.  
  3510. Function StrLower(Str: PChar): PChar;
  3511. Begin
  3512.   Asm
  3513.     CLD
  3514.     MOV       ESI, Str
  3515.  
  3516.     !StringLower1:
  3517.  
  3518.     LODSB
  3519.     Or        AL, AL
  3520.     JE        !OutStrLower
  3521.  
  3522.     CMP       AL, 'A'
  3523.     JB        !StringLower1
  3524.     CMP       AL, 'Z'
  3525.     JA        !StringLower1
  3526.     Or        AL, 32
  3527.     MOV       [ESI-1], AL
  3528.     JMP       !StringLower1
  3529.  
  3530.     !OutStrLower:
  3531.  
  3532.     MOV        EAX, Str
  3533.     MOV        Result, EAX
  3534.   End;
  3535. End;
  3536.  
  3537. Function StrUpper(Str: PChar): PChar;
  3538. Begin
  3539.   Asm
  3540.     CLD
  3541.     MOV       ESI, Str
  3542.  
  3543.     !StringUpper_Loop:
  3544.  
  3545.     LODSB
  3546.     Or        AL, AL
  3547.     JE        !OutStrUpper
  3548.  
  3549.     CMP       AL, 'a'
  3550.     JB        !StringUpper_Loop
  3551.     CMP       AL, 'z'
  3552.     JA        !StringUpper_Loop
  3553.     And       AL, $DF
  3554.     MOV       [ESI-1], AL
  3555.     JMP       !StringUpper_Loop
  3556.  
  3557.     !OutStrUpper:
  3558.  
  3559.     MOV        EAX, Str
  3560.     MOV        Result, EAX
  3561.   End;
  3562. End;
  3563.  
  3564. Function StrPas(Str: PChar): String;
  3565. Begin
  3566.   Result := Str^;
  3567. End;
  3568.  
  3569. Function StrAlloc(Size: Cardinal): PChar;
  3570. Type
  3571.   PLong = ^LongInt;
  3572. Var
  3573.   P: PChar;
  3574. Begin
  3575.   GetMem(P, Size + 4);
  3576.   PLong(P)^ := Size + 4;
  3577.   Inc(P, 4);
  3578.   StrAlloc := P;
  3579. End;
  3580.  
  3581. Function StrBufSize(Str: PChar): Cardinal;
  3582. Type
  3583.   PLong = ^LongInt;
  3584. Begin
  3585.   Dec(Str, 4);
  3586.   StrBufSize := PLong(Str)^ - 4;
  3587. End;
  3588.  
  3589. Function StrNew(Str: PChar): PChar;
  3590. Var
  3591.   Size: LongInt;
  3592. Begin
  3593.   If Str = Nil Then StrNew := Nil
  3594.   Else
  3595.   Begin
  3596.     Size := StrLen(Str) + 1;
  3597.     StrNew := StrMove(StrAlloc(Size), Str, Size);
  3598.   End;
  3599. End;
  3600.  
  3601. Procedure StrDispose(Str: PChar);
  3602. Type
  3603.   PLong = ^LongInt;
  3604. Begin
  3605.   If Str <> Nil Then
  3606.     If Str <> NullStr Then
  3607.     Begin
  3608.       Dec(Str, 4);
  3609.       FreeMem(Str, PLong(Str)^);
  3610.     End;
  3611. End;
  3612.  
  3613. { --- String formatting --- }
  3614.  
  3615. {$HINTS OFF}
  3616. Function FormatBuf(Var Buffer; BufLen: Cardinal; Const format; FmtLen: Cardinal; Const Args: Array Of Const): Cardinal;
  3617. Var
  3618.   { format And Result buffers }
  3619.  
  3620.   FmtPos, OldFmtPos, BufPos, ArgPos: LongInt;
  3621.   Buf: cstring Absolute Buffer;
  3622.   Fmt: cstring Absolute format;
  3623.  
  3624.   { argument Buffer }
  3625.  
  3626.   VArgs: Array[0..1023] Of TVarRec Absolute Args;
  3627.  
  3628.   { Workaround For High() problem }
  3629.  
  3630.   High_Args: LongInt;
  3631.  
  3632.   { format Details }
  3633.  
  3634.   Index, Width, Precision: LongInt;
  3635.   LeftAlign: Boolean;
  3636.   ArgType: Char;
  3637.  
  3638.   { temporary variables }
  3639.  
  3640.   C: Char;
  3641.   P: Pointer;
  3642.   E: Extended;
  3643.   Pnt,M:LongInt;
  3644.   L: LongInt;
  3645.   S: String[80];
  3646.  
  3647.   { Raise Exception: format And argument don't match }
  3648.  
  3649.   Procedure IllegalArg;
  3650.   Begin
  3651.     FmtLoadConvertError(SInvalidFormat, [ArgType]);
  3652.   End;
  3653.  
  3654.   { Raise Exception: out Of arguments }
  3655.  
  3656.   Procedure OutOfArgs;
  3657.   Begin
  3658.     FmtLoadConvertError(SArgumentMissing, [ArgType]);
  3659.   End;
  3660.  
  3661.   { Get an argument from the Open Array. If the
  3662.     Type Is unexpected, Raise an Exception. }
  3663.  
  3664.   Function GetIntegerArg: LongInt;
  3665.   Begin
  3666.     If ArgPos > High_Args Then OutOfArgs;
  3667.     If VArgs[ArgPos].VType <> vtInteger Then IllegalArg;
  3668.     Result := VArgs[ArgPos].VInteger;
  3669.     Inc(ArgPos);
  3670.   End;
  3671.  
  3672.   Function GetExtendedArg: Extended;
  3673.   Begin
  3674.     If ArgPos > High_Args Then OutOfArgs;
  3675.     If VArgs[ArgPos].VType <> vtExtended Then IllegalArg;
  3676.     Result := VArgs[ArgPos].VExtended^;
  3677.     Inc(ArgPos);
  3678.   End;
  3679.  
  3680.   Function GetPointerArg: Pointer;
  3681.   Begin
  3682.     If ArgPos > High_Args Then OutOfArgs;
  3683.     If VArgs[ArgPos].VType <> vtPointer Then IllegalArg;
  3684.     Result := VArgs[ArgPos].VPointer;
  3685.     Inc(ArgPos);
  3686.   End;
  3687.  
  3688.   Procedure GetStringArg(Var FirstChar: Pointer; Var len: LongInt);
  3689.   Begin
  3690.     If ArgPos > High_Args Then OutOfArgs;
  3691.     Case VArgs[ArgPos].VType Of
  3692.       vtChar:
  3693.       Begin
  3694.         FirstChar := @VArgs[ArgPos].VChar;
  3695.         len := 1;
  3696.       End;
  3697.  
  3698.       vtString:
  3699.       Begin
  3700.         FirstChar := VArgs[ArgPos].VString;
  3701.         len := Byte(FirstChar^);
  3702.         Inc(FirstChar);
  3703.       End;
  3704.  
  3705.       vtPointer,
  3706.       vtPChar:
  3707.       Begin
  3708.         FirstChar := VArgs[ArgPos].VPChar;
  3709.         len := StrLen(FirstChar);
  3710.       End;
  3711.  
  3712.       vtAnsiString:
  3713.       Begin
  3714.         FirstChar := VArgs[ArgPos].VPChar;
  3715.         len := Length(AnsiString(VArgs[ArgPos].VAnsiString));
  3716.       End;
  3717.     Else
  3718.       IllegalArg;
  3719.     End;
  3720.     Inc(ArgPos);
  3721.   End;
  3722.  
  3723.   { Parse A Number from the format String. A '*' means:
  3724.     Get the Next Integer argument from the Open Array. }
  3725.  
  3726.   Function ParseNum: LongInt;
  3727.   Begin
  3728.     If Fmt[FmtPos] = '*' Then Result := GetIntegerArg
  3729.     Else
  3730.     Begin
  3731.       Result := 0;
  3732.       While (Fmt[FmtPos] In ['0'..'9']) And (FmtPos < FmtLen) Do
  3733.       Begin
  3734.         Result := Result * 10 + Ord(Fmt[FmtPos]) - 48;
  3735.         Inc(FmtPos);
  3736.       End;
  3737.     End;
  3738.   End;
  3739.  
  3740.   { Parse A whole format specifier. }
  3741.  
  3742.   Function ParseFmtSpec: Char;
  3743.   Label
  3744.     LIndex, LColon, LMinus, LWidth, LPoint, LType;
  3745.   Begin
  3746.     Width := -1;
  3747.     Index := -1;
  3748.     Precision := -1;
  3749.     LeftAlign := False;
  3750.     ArgType := #0;
  3751.     C := Fmt[FmtPos];
  3752.  
  3753.     LIndex:
  3754.  
  3755.       If Not (C In ['0'..'9']) Then Goto LMinus;
  3756.       Width := ParseNum;
  3757.       If FmtPos >= FmtLen Then Exit;
  3758.       C := Fmt[FmtPos];
  3759.  
  3760.     LColon:
  3761.  
  3762.       If C <> ':' Then Goto LPoint;
  3763.       Index := Width;
  3764.       Width := -1;
  3765.       Inc(FmtPos);
  3766.       If FmtPos >= FmtLen Then Exit;
  3767.       C := Fmt[FmtPos];
  3768.  
  3769.     LMinus:
  3770.  
  3771.       If C <> '-' Then Goto LWidth;
  3772.       LeftAlign := True;
  3773.       Inc(FmtPos);
  3774.       If FmtPos >= FmtLen Then Exit;
  3775.       C := Fmt[FmtPos];
  3776.  
  3777.     LWidth:
  3778.  
  3779.       If Not (C In ['0'..'9']) Then Goto LPoint;
  3780.       Width := ParseNum;
  3781.       If FmtPos >= FmtLen Then Exit;
  3782.       C := Fmt[FmtPos];
  3783.  
  3784.     LPoint:
  3785.  
  3786.       If C <> '.' Then Goto LType;
  3787.       Inc(FmtPos);
  3788.       Precision := ParseNum;
  3789.       If FmtPos >= FmtLen Then Exit;
  3790.       C := Fmt[FmtPos];
  3791.  
  3792.     LType:
  3793.  
  3794.       Result := UpCase(C);
  3795.       ArgType := Result;
  3796.  
  3797.       {WriteLn;
  3798.       WriteLn('Index:', Index, ' Align:', LeftAlign, ' Width:', Width, ' Prec: ', Precision, ' Type:', Result);
  3799.       WriteLn;}
  3800.  
  3801.       Inc(FmtPos);
  3802.   End;
  3803.  
  3804.   { Append something To the Result Buffer }
  3805.  
  3806.   Procedure AppendStr(P: Pointer; Count: LongInt);
  3807.   Begin
  3808.     If BufLen - BufPos < Count Then Count := BufLen - BufPos;
  3809.     Move(P^, Buf[BufPos], Count);
  3810.     Inc(BufPos, Count);
  3811.   End;
  3812.  
  3813.   Procedure AppendChar(C: Char; Count: LongInt);
  3814.   Begin
  3815.     If BufLen - BufPos < Count Then Count := BufLen - BufPos;
  3816.     FillChar(Buf[BufPos], Count, C);
  3817.     Inc(BufPos, Count);
  3818.   End;
  3819.  
  3820. Begin
  3821.   FmtPos := 0;
  3822.   OldFmtPos := 0;
  3823.   BufPos := 0;
  3824.   ArgPos := 0;
  3825.  
  3826.   High_Args := High(Args);
  3827.  
  3828.   While (FmtPos < FmtLen) And (BufPos < BufLen) Do
  3829.   Begin
  3830.     C := Fmt[FmtPos];
  3831.     Inc(FmtPos);
  3832.     If C = '%' Then
  3833.     Begin
  3834.       C := ParseFmtSpec;
  3835.       If C = 'S' Then
  3836.       Begin
  3837.         GetStringArg(P, L);
  3838.         If (Precision > -1) And (Precision < L) Then L := Precision;
  3839.       End
  3840.       Else
  3841.       Begin
  3842.         Case C Of
  3843.           'D': Begin
  3844.                  Str(GetIntegerArg, S);
  3845.                  L := Length(S);
  3846.                  If (Precision <> -1) And (L < Precision) Then
  3847.                  Begin
  3848.                    SetLength(S, Precision);
  3849.                    Move(S[1], S[1 + Precision - L], L);
  3850.                    FillChar(S[1], Precision - L, '0');
  3851.                  End;
  3852.                End;
  3853.           'E': S := FloatToStrF(GetExtendedArg, ffExponent, Precision, 3);
  3854.           'F': S := FloatToStrF(GetExtendedArg, ffFixed, 9999, Precision);
  3855.           'G': S := FloatToStrF(GetExtendedArg, ffGeneral, Precision, 3);
  3856.           'N': S := FloatToStrF(GetExtendedArg, ffFixed, 9999, Precision);
  3857.           'M': S := FloatToStrF(GetExtendedArg, ffCurrency, 9999, Precision);
  3858.           'P': Begin
  3859.                  L := LongInt(GetPointerArg);
  3860.                  S := IntToHex(L Shr 16, 4) + ':' + IntToHex(L And $FFFF, 4);
  3861.                End;
  3862.           'X': Begin
  3863.                  If Precision <> -1 Then S := IntToHex(GetIntegerArg, Precision)
  3864.                  Else S := IntToHex(GetIntegerArg, 0);
  3865.                End;
  3866.           Else FmtLoadConvertError(SInvalidFormat, [C]);
  3867.         End;
  3868.         P := @S[1];
  3869.         L := Length(S);
  3870.       End;
  3871.  
  3872.       { now P Points To the First Char To Append To our Result, L holds the
  3873.         Length Of the Text To Insert. If Width > L Then we have To pad our
  3874.         Text With spaces. }
  3875.  
  3876.       If LeftAlign Then
  3877.       Begin
  3878.         AppendStr(P, L);
  3879.         If (Width > -1) And (L < Width) Then AppendChar(' ', Width - L );
  3880.       End
  3881.       Else
  3882.       Begin
  3883.         If (Width > -1) And (L < Width) Then AppendChar(' ', Width - L );
  3884.         AppendStr(P, L);
  3885.       End;
  3886.     End
  3887.     Else
  3888.     Begin
  3889.       { Ordinary character }
  3890.       Buf[BufPos] := C;
  3891.       Inc(BufPos);
  3892.     End;
  3893.     OldFmtPos := FmtPos;
  3894.   End;
  3895.   Result := BufPos;
  3896. End;
  3897. {$HINTS ON}
  3898.  
  3899.  
  3900. Function format(Const format: String; Const Args: Array Of Const): String;
  3901. Begin
  3902.   SetLength(Result, FormatBuf(Result[1], 255, format[1], Length(format), Args));
  3903. End;
  3904.  
  3905. Procedure FmtStr(Var Result: String; Const format: String; Const Args: Array Of Const);
  3906. Begin
  3907.   SetLength(Result, FormatBuf(Result[1], 255, format[1], Length(format), Args));
  3908. End;
  3909.  
  3910. Function StrFmt(Buffer, format: PChar; Const Args: Array Of Const): PChar;
  3911. Begin
  3912.   FormatBuf(Buffer, MaxLongInt, format, StrLen(format), Args);
  3913.   Result := Buffer;
  3914. End;
  3915.  
  3916. Function StrLFmt(Buffer: PChar; MaxLen: Cardinal; format: PChar; Const Args: Array Of Const): PChar;
  3917. Begin
  3918.   FormatBuf(Buffer, MaxLen, format, StrLen(format), Args);
  3919.   Result := Buffer;
  3920. End;
  3921.  
  3922. { --- floating Point conversion --- }
  3923.  
  3924. Function FloatToStr(Value: Extended): String;
  3925. Begin
  3926.   Result := FloatToStrF(Value, ffGeneral, 15, 0);
  3927. End;
  3928.  
  3929. Function FloatToStrF(Value: Extended; format: TFloatFormat; Precision, Digits: Integer): String;
  3930. Var
  3931.   P: Integer;
  3932.   Negative, TooSmall, TooLarge: Boolean;
  3933. Begin
  3934.   Case format Of
  3935.  
  3936.     ffGeneral:
  3937.  
  3938.       Begin
  3939.         If (Precision = -1) Or (Precision > 15) Then Precision := 15;
  3940.         TooSmall := Abs(Value) < 0.00001;
  3941.         If Not TooSmall Then
  3942.         Begin
  3943.           Str(Value:0:999, Result);
  3944.           P := Pos('.', Result);
  3945.           Result[P] := DecimalSeparator;
  3946.           TooLarge := P > Precision + 1;
  3947.         End;
  3948.  
  3949.         If TooSmall Or TooLarge Then
  3950.           Result := FloatToStrF(Value, ffExponent, Precision, Digits);
  3951.  
  3952.         P := Length(Result);
  3953.         While Result[P] = '0' Do Dec(P);
  3954.         If Result[P] = DecimalSeparator Then Dec(P);
  3955.         SetLength(Result, P);
  3956.       End;
  3957.  
  3958.     ffExponent:
  3959.  
  3960.       Begin
  3961.         If (Precision = -1) Or (Precision > 15) Then Precision := 15;
  3962.         Str(Value:Precision + 8, Result);
  3963.         Result[3] := DecimalSeparator;
  3964.         If (Digits < 4) And (Result[Precision + 5] = '0') Then
  3965.         Begin
  3966.           Delete(Result, Precision + 5, 1);
  3967.           If (Digits < 3) And (Result[Precision + 5] = '0') Then
  3968.           Begin
  3969.             Delete(Result, Precision + 5, 1);
  3970.             If (Digits < 2) And (Result[Precision + 5] = '0') Then
  3971.             Begin
  3972.               Delete(Result, Precision + 5, 1);
  3973.               If (Digits < 1) And (Result[Precision + 5] = '0') Then Delete(Result, Precision + 3, 3);
  3974.             End;
  3975.           End;
  3976.         End;
  3977.         If Result[1] = ' ' Then Delete(Result, 1, 1);
  3978.       End;
  3979.  
  3980.     ffFixed:
  3981.  
  3982.       Begin
  3983.         If Digits = -1 Then Digits := 2
  3984.         Else If Digits > 15 Then Digits := 15;
  3985.         Str(Value:0:Digits, Result);
  3986.         If Result[1] = ' ' Then Delete(Result, 1, 1);
  3987.         P := Pos('.', Result);
  3988.         If P <> 0 Then Result[P] := DecimalSeparator;
  3989.       End;
  3990.  
  3991.     ffNumber:
  3992.  
  3993.       Begin
  3994.         If Digits = -1 Then Digits := 2
  3995.         Else If Digits > 15 Then Digits := 15;
  3996.         Str(Value:0:Digits, Result);
  3997.         If Result[1] = ' ' Then Delete(Result, 1, 1);
  3998.         P := Pos('.', Result);
  3999.         If P <> 0 Then Result[P] := DecimalSeparator;
  4000.         Dec(P, 3);
  4001.         While (P > 1) Do
  4002.         Begin
  4003.           If Result[P - 1] <> '-' Then Insert(ThousandSeparator, Result, P);
  4004.           Dec(P, 3);
  4005.         End;
  4006.       End;
  4007.  
  4008.     ffCurrency:
  4009.  
  4010.       Begin
  4011.         If Value < 0 Then
  4012.         Begin
  4013.           Negative := True;
  4014.           Value := -Value;
  4015.         End
  4016.         Else Negative := False;
  4017.  
  4018.         If Digits = -1 Then Digits := CurrencyDecimals
  4019.         Else If Digits > 15 Then Digits := 15;
  4020.         Str(Value:0:Digits, Result);
  4021.         If Result[1] = ' ' Then Delete(Result, 1, 1);
  4022.         P := Pos('.', Result);
  4023.         If P <> 0 Then Result[P] := DecimalSeparator;
  4024.         Dec(P, 3);
  4025.         While (P > 1) Do
  4026.         Begin
  4027.           Insert(ThousandSeparator, Result, P);
  4028.           Dec(P, 3);
  4029.         End;
  4030.  
  4031.         If Not Negative Then
  4032.         Begin
  4033.           Case CurrencyFormat Of
  4034.             0: Result := CurrencyString + Result;
  4035.             1: Result := Result + CurrencyString;
  4036.             2: Result := CurrencyString + ' ' + Result;
  4037.             3: Result := Result + ' ' + CurrencyString;
  4038.           End
  4039.         End
  4040.         Else
  4041.         Begin
  4042.           Case NegCurrFormat Of
  4043.             0: Result := '(' + CurrencyString + Result + ')';
  4044.             1: Result := '-' + CurrencyString + Result;
  4045.             2: Result := CurrencyString + '-' + Result;
  4046.             3: Result := CurrencyString + Result + '-';
  4047.             4: Result := '(' + Result + CurrencyString + ')';
  4048.             5: Result := '-' + Result + CurrencyString;
  4049.             6: Result := Result + '-' + CurrencyString;
  4050.             7: Result := Result + CurrencyString + '-';
  4051.             8: Result := '-' + Result + ' ' + CurrencyString;
  4052.             9: Result := '-' + CurrencyString + ' ' + Result;
  4053.             10: Result := CurrencyString + ' ' + Result + '-';
  4054.           End;
  4055.         End;
  4056.       End;
  4057.   End;
  4058. End;
  4059.  
  4060. Function FloatToText(Buffer: PChar; Value: Extended; format: TFloatFormat; Precision, Digits: Integer): Integer;
  4061. Var
  4062.   Tmp: String[40];
  4063. Begin
  4064.   Tmp := FloatToStrF(Value, format, Precision, Digits);
  4065.   Result := Length(Tmp);
  4066.   Move(Tmp[1], Buffer[0], Result);
  4067. End;
  4068.  
  4069. Function StrToFloat(Const S: String): Extended;
  4070. Var
  4071.   Error: Integer;
  4072.   Tmp: String;
  4073.   P: Integer;
  4074. Begin
  4075.   Tmp := S;
  4076.   P := Pos(DecimalSeparator, Tmp);
  4077.   If P <> 0 Then Tmp[P] := '.';
  4078.   Val(Tmp, Result, Error);
  4079.   If Error <> 0 Then FmtLoadConvertError(SInvalidFloat, [S]);
  4080. End;
  4081.  
  4082. Function TextToFloat(Buffer: PChar; Var Value: Extended): Boolean;
  4083. Var
  4084.   Error: Integer;
  4085.   Tmp: String;
  4086.   P: Integer;
  4087. Begin
  4088.   Tmp := StrPas(Buffer);
  4089.   P := Pos(DecimalSeparator, Tmp);
  4090.   If P <> 0 Then Tmp[P] := '.';
  4091.   Val(Tmp, Value, Error);
  4092.   Result := (Error = 0);
  4093. End;
  4094.  
  4095. Function FloatToTextFmt(Buffer: PChar; Value: Extended; format: PChar): Integer;
  4096. Var
  4097.   Digits: String[40];                         { String Of Digits                 }
  4098.   Exponent: String[8];                        { Exponent strin                   }
  4099.   FmtStart, FmtStop: PChar;                   { Start And End Of relevant part   }
  4100.                                               { Of format String                 }
  4101.   ExpFmt, ExpSize: Integer;                   { Type And Length Of               }
  4102.                                               { exponential format chosen        }
  4103.   Placehold: Array[1..4] Of Integer;          { Number Of placeholders In All    }
  4104.                                               { four Sections                    }
  4105.   thousand: Boolean;                          { thousand separators?             }
  4106.   UnexpectedDigits: Integer;                  { Number Of unexpected Digits that }
  4107.                                               { have To be inserted before the   }
  4108.                                               { First placeholder.               }
  4109.   DigitExponent: Integer;                     { Exponent Of First digit In       }
  4110.                                               { Digits Array.                    }
  4111.  
  4112.   { Find end of format section starting at P. False, if empty }
  4113.  
  4114.   Function GetSectionEnd(Var P: PChar): Boolean;
  4115.   Var
  4116.     C: Char;
  4117.     SQ, DQ: Boolean;
  4118.   Begin
  4119.     Result := False;
  4120.     SQ := False;
  4121.     DQ := False;
  4122.     C := P[0];
  4123.     While (C <> #0) And ((C <> ';') Or SQ Or DQ) Do
  4124.     Begin
  4125.       Result := True;
  4126.       Case C Of
  4127.         #34: If Not SQ Then DQ := Not DQ;
  4128.         #39: If Not DQ Then SQ := Not SQ;
  4129.       End;
  4130.       Inc(P);
  4131.       C := P[0];
  4132.     End;
  4133.   End;
  4134.  
  4135.   { Find start and end of format section to apply. If section doesn't exist,
  4136.     use section 1. If section 2 is used, the sign of value is ignored.       }
  4137.  
  4138.   Procedure GetSectionRange(section: Integer);
  4139.   Var
  4140.     Sec: Array[1..3] Of PChar;
  4141.     SecOk: Array[1..3] Of Boolean;
  4142.   Begin
  4143.     Sec[1] := format;
  4144.     SecOk[1] := GetSectionEnd(Sec[1]);
  4145.     If section > 1 Then
  4146.     Begin
  4147.       Sec[2] := Sec[1];
  4148.       If Sec[2][0] <> #0 Then Inc(Sec[2]);
  4149.       SecOk[2] := GetSectionEnd(Sec[2]);
  4150.       If section > 2 Then
  4151.       Begin
  4152.         Sec[3] := Sec[2];
  4153.         If Sec[3][0] <> #0 Then Inc(Sec[3]);
  4154.         SecOk[3] := GetSectionEnd(Sec[3]);
  4155.       End;
  4156.     End;
  4157.     If Not SecOk[1] Then FmtStart := Nil
  4158.     Else
  4159.     Begin
  4160.       If Not SecOk[section] Then section := 1
  4161.       Else If section = 2 Then Value := -Value;   { Remove sign }
  4162.       If section = 1 Then FmtStart := format Else
  4163.       Begin
  4164.         FmtStart := Sec[section - 1];
  4165.         Inc(FmtStart);
  4166.       End;
  4167.       FmtStop := Sec[section];
  4168.     End;
  4169.   End;
  4170.  
  4171.   { Find format section ranging from FmtStart to FmtStop. }
  4172.  
  4173.   Procedure GetFormatOptions;
  4174.   Var
  4175.     Fmt: PChar;
  4176.     SQ, DQ: Boolean;
  4177.     area: Integer;
  4178.   Begin
  4179.     SQ := False;
  4180.     DQ := False;
  4181.     Fmt := FmtStart;
  4182.     ExpFmt := 0;
  4183.     area := 1;
  4184.     thousand := False;
  4185.     Placehold[1] := 0;
  4186.     Placehold[2] := 0;
  4187.     Placehold[3] := 0;
  4188.     Placehold[4] := 0;
  4189.  
  4190.     While Fmt < FmtStop Do
  4191.     Begin
  4192.       Case Fmt[0] Of
  4193.         #34:
  4194.         Begin
  4195.           If Not SQ Then DQ := Not DQ;
  4196.           Inc(Fmt);
  4197.         End;
  4198.  
  4199.         #39:
  4200.         Begin
  4201.           If Not DQ Then SQ := Not SQ;
  4202.           Inc(Fmt);
  4203.         End;
  4204.  
  4205.       Else
  4206.         { This was 'if not SQ or DQ'. Looked wrong... }
  4207.         If Not SQ Or DQ Then
  4208.         Begin
  4209.           Case Fmt[0] Of
  4210.             '0':
  4211.             Begin
  4212.               Case area Of
  4213.                 1:
  4214.                 area := 2;
  4215.                 4:
  4216.                 Begin
  4217.                   area := 3;
  4218.                   Inc(Placehold[3], Placehold[4]);
  4219.                   Placehold[4] := 0;
  4220.                 End;
  4221.               End;
  4222.               Inc(Placehold[area]);
  4223.               Inc(Fmt);
  4224.             End;
  4225.  
  4226.             '#':
  4227.             Begin
  4228.               If area = 3 Then area := 4;
  4229.               Inc(Placehold[area]);
  4230.               Inc(Fmt);
  4231.             End;
  4232.  
  4233.             '.':
  4234.             Begin
  4235.               If area < 3 Then area := 3;
  4236.               Inc(Fmt);
  4237.             End;
  4238.  
  4239.             ',':
  4240.             Begin
  4241.               thousand := True;
  4242.               Inc(Fmt);
  4243.             End;
  4244.  
  4245.             'e', 'E':
  4246.             If ExpFmt = 0 Then
  4247.             Begin
  4248.               If Fmt[0] = 'E' Then ExpFmt := 1 Else ExpFmt := 3;
  4249.               Inc(Fmt);
  4250.               If Fmt < FmtStop Then
  4251.               Begin
  4252.                 Case Fmt[0] Of
  4253.                   '+':
  4254.                   Begin
  4255.                   End;
  4256.  
  4257.                   '-':
  4258.                   Inc(ExpFmt);
  4259.  
  4260.                 Else
  4261.                   ExpFmt := 0;
  4262.                 End;
  4263.  
  4264.                 If ExpFmt <> 0 Then
  4265.                 Begin
  4266.                   Inc(Fmt);
  4267.                   ExpSize := 0;
  4268.                   While (Fmt < FmtStop) And (ExpSize < 4) And (Fmt[0] In ['0'..'9']) Do
  4269.                   Begin
  4270.                     Inc(ExpSize);
  4271.                     Inc(Fmt);
  4272.                   End;
  4273.                 End;
  4274.               End;
  4275.             End
  4276.             Else Inc(Fmt);
  4277.  
  4278.           Else { Case }
  4279.             Inc(Fmt);
  4280.           End; { Case }
  4281.         End; { Begin }
  4282.       End; { Case }
  4283.     End; { While .. Begin }
  4284.   End;
  4285.  
  4286.   Procedure FloatToStr;
  4287.   Var
  4288.     I, J, Exp, Width, Decimals, DecimalPoint, len: Integer;
  4289.   Begin
  4290.     If ExpFmt = 0 Then
  4291.     Begin
  4292.       { Fixpoint }
  4293.       Decimals := Placehold[3] + Placehold[4];
  4294.       Width := Placehold[1] + Placehold[2] + Decimals;
  4295.  
  4296.       If Decimals = 0 Then Str(Value: Width: 0, Digits)
  4297.       Else Str(Value: Width + 1: Decimals, Digits);
  4298.  
  4299.       len := Length(Digits);
  4300.  
  4301.       { Find the decimal point }
  4302.       If Decimals = 0 Then DecimalPoint := len  + 1 Else DecimalPoint := len - Decimals;
  4303.  
  4304.       { If value is very small, and no decimal places
  4305.         are desired, remove the leading 0.            }
  4306.       If (Abs(Value) < 1) And (Placehold[2] = 0) Then
  4307.       Begin
  4308.         If Placehold[1] = 0 Then Delete(Digits, DecimalPoint - 1, 1)
  4309.         Else Digits[DecimalPoint - 1] := ' ';
  4310.       End;
  4311.  
  4312.       { Convert optional zeroes to spaces. }
  4313.       I := len;
  4314.       J := DecimalPoint + Placehold[3];
  4315.       While (I > J) And (Digits[I] = '0') Do
  4316.       Begin
  4317.         Digits[I] := ' ';
  4318.         Dec(I);
  4319.       End;
  4320.  
  4321.       { If integer value and no obligatory decimal
  4322.         places, remove decimal point. }
  4323.  
  4324.       If (DecimalPoint < len) And (Digits[DecimalPoint + 1] = ' ') Then
  4325.           Digits[DecimalPoint] := ' ';
  4326.  
  4327.       { Convert spaces left from obligatory decimal point to zeroes. }
  4328.  
  4329.       I := DecimalPoint - Placehold[2];
  4330.       While (I < DecimalPoint) And (Digits[I] = ' ') Do
  4331.       Begin
  4332.         Digits[I] := '0';
  4333.         Inc(I);
  4334.       End;
  4335.  
  4336.       Exp := 0;
  4337.     End
  4338.     Else
  4339.     Begin
  4340.       { Scientific: exactly <Width> Digits With <Precision> Decimals
  4341.         And adjusted Exponent. }
  4342.       If Placehold[1] + Placehold[2] = 0 Then Placehold[1] := 1;
  4343.  
  4344.       Decimals := Placehold[3] + Placehold[4];
  4345.       Width := Placehold[1] + Placehold[2] + Decimals;
  4346.  
  4347.       Str(Value: Width + 8, Digits);
  4348.  
  4349.       //WriteLn('Digits: ', Digits);
  4350.  
  4351.       { Find and cut out exponent. Always the
  4352.         last 6 characters in the string.
  4353.         -> 0000E+0000                         }
  4354.  
  4355.       I := Length(Digits) - 5;
  4356.  
  4357.       Val(Copy(Digits, I  + 1, 5), Exp, J);
  4358.  
  4359.       //WriteLn('Exp: ', Exp);
  4360.  
  4361.       Exp := Exp + 1 - (Placehold[1] + Placehold[2]);
  4362.       Delete(Digits, I, 6);
  4363.  
  4364.       //WriteLn('Exp: ', Exp);
  4365.  
  4366.       { Str() always returns at least one digit after the decimal point.
  4367.         If we don't want it, we have to remove it. }
  4368.       If (Decimals = 0) And (Placehold[1] + Placehold[2] <= 1) Then
  4369.       Begin
  4370.         If Digits[4] >= '5' Then
  4371.         Begin
  4372.           Inc(Digits[2]);
  4373.           If Digits[2] > '9' Then
  4374.           Begin
  4375.             Digits[2] := '1';
  4376.             Inc(Exp);
  4377.           End;
  4378.         End;
  4379.         Delete(Digits, 3, 2);
  4380.         DecimalPoint := Length(Digits) + 1;
  4381.       End
  4382.       Else
  4383.       Begin
  4384.         //WriteLn(Digits);
  4385.  
  4386.         { Move decimal point at the desired position }
  4387.         Delete(Digits, 3, 1);
  4388.         DecimalPoint := 2 + Placehold[1] + Placehold[2];
  4389.         If Decimals <> 0 Then Insert('.', Digits, DecimalPoint);
  4390.       End;
  4391.  
  4392.       //WriteLn(Digits);
  4393.  
  4394.       { Convert optional zeroes to spaces. }
  4395.       I := Length(Digits);
  4396.       J := DecimalPoint + Placehold[3];
  4397.       While (I > J) And (Digits[I] = '0') Do
  4398.       Begin
  4399.         Digits[I] := ' ';
  4400.         Dec(I);
  4401.       End;
  4402.  
  4403.       { If integer number and no obligatory decimal paces, remove decimal point }
  4404.  
  4405.       If (DecimalPoint < Length(Digits)) And (Digits[DecimalPoint + 1] = ' ') Then
  4406.           Digits[DecimalPoint] := ' ';
  4407.  
  4408.       If Digits[1] = ' ' Then
  4409.       Begin
  4410.         Delete(Digits, 1, 1);
  4411.         Dec(DecimalPoint);
  4412.       End;
  4413.  
  4414.       { Calculate exponent string }
  4415.       Str(Abs(Exp), Exponent);
  4416.       While Length(Exponent) < ExpSize Do Insert('0', Exponent, 1);
  4417.       If Exp >= 0 Then
  4418.       Begin
  4419.         If ExpFmt In [1, 3] Then Insert('+', Exponent, 1);
  4420.       End
  4421.       Else Insert('-', Exponent, 1);
  4422.       If ExpFmt < 3 Then Insert('E', Exponent, 1) Else Insert('e', Exponent, 1);
  4423.     End;
  4424.  
  4425.     DigitExponent := DecimalPoint - 2;
  4426.     If Digits[1] = '-' Then Dec(DigitExponent);
  4427.  
  4428.     UnexpectedDigits := DecimalPoint - 1 - (Placehold[1] + Placehold[2]);
  4429.   End;
  4430.  
  4431.   Function PutResult: LongInt;
  4432.   Var
  4433.     SQ, DQ: Boolean;
  4434.     Fmt, Buf: PChar;
  4435.     Dig, N: Integer;
  4436.   Begin
  4437.     SQ := False;
  4438.     DQ := False;
  4439.     Fmt := FmtStart;
  4440.     Buf := Buffer;
  4441.     Dig := 1;
  4442.  
  4443.     //WriteLn('Putting result: ');
  4444.  
  4445.     While Fmt < FmtStop Do
  4446.     Begin
  4447.       //Write(Fmt[0]);
  4448.  
  4449.       Case Fmt[0] Of
  4450.         #34:
  4451.         Begin
  4452.           If Not SQ Then DQ := Not DQ;
  4453.           Inc(Fmt);
  4454.         End;
  4455.  
  4456.         #39:
  4457.         Begin
  4458.           If Not DQ Then SQ := Not SQ;
  4459.           Inc(Fmt);
  4460.         End;
  4461.  
  4462.       Else
  4463.  
  4464.         If Not (SQ Or DQ) Then
  4465.         Begin
  4466.           Case Fmt[0] Of
  4467.             '0', '#', '.':
  4468.             Begin
  4469.               If (Dig = 1) And (UnexpectedDigits > 0) Then
  4470.               Begin
  4471.                 { Everything unexpected is written before the first digit }
  4472.                 For N := 1 To UnexpectedDigits Do
  4473.                 Begin
  4474.                   Buf[0] := Digits[N];
  4475.                   Inc(Buf);
  4476.                   If thousand And (Digits[N] <> '-') Then
  4477.                   Begin
  4478.                     If (DigitExponent Mod 3 = 0) And (DigitExponent > 0) Then
  4479.                     Begin
  4480.                       Buf[0] := ThousandSeparator;
  4481.                       Inc(Buf);
  4482.                     End;
  4483.                     Dec(DigitExponent);
  4484.                   End;
  4485.                 End;
  4486.                 Inc(Dig, UnexpectedDigits);
  4487.               End;
  4488.  
  4489.               If Digits[Dig] <> ' ' Then
  4490.               Begin
  4491.                 If Digits[Dig] = '.' Then Buf[0] := DecimalSeparator
  4492.                 Else Buf[0] := Digits[Dig];
  4493.                 Inc(Buf);
  4494.                 If thousand And (DigitExponent Mod 3 = 0) And (DigitExponent > 0) Then
  4495.                 Begin
  4496.                   Buf[0] := ThousandSeparator;
  4497.                   Inc(Buf);
  4498.                 End;
  4499.               End;
  4500.               Inc(Dig);
  4501.               Dec(DigitExponent);
  4502.               Inc(Fmt);
  4503.             End;
  4504.  
  4505.             'e', 'E':
  4506.             Begin
  4507.               If ExpFmt <> 0 Then
  4508.               Begin
  4509.                 Inc(Fmt);
  4510.                 If Fmt < FmtStop Then
  4511.                 Begin
  4512.                   If Fmt[0] In ['+', '-'] Then
  4513.                   Begin
  4514.                     Inc(Fmt, ExpSize);
  4515.  
  4516.                     //WriteLn('Exponent: ', Exponent);
  4517.  
  4518.                     For N := 1 To Length(Exponent) Do Buf[N - 1] := Exponent[N];
  4519.                     Inc(Buf, Length(Exponent));
  4520.                     ExpFmt := 0;
  4521.                   End;
  4522.                   Inc(Fmt);
  4523.                 End;
  4524.               End
  4525.               Else
  4526.               Begin
  4527.                 { No legal exponential format. Simply write
  4528.                   the 'E' to the reult. }
  4529.                 Buf[0] := Fmt[0];
  4530.                 Inc(Buf);
  4531.                 Inc(Fmt);
  4532.               End;
  4533.             End;
  4534.  
  4535.           Else
  4536.             { Usual character }
  4537.             If Fmt[0] <> ',' Then
  4538.             Begin
  4539.               Buf[0] := Fmt[0];
  4540.               Inc(Buf);
  4541.             End;
  4542.             Inc(Fmt);
  4543.           End; { Case }
  4544.         End
  4545.  
  4546.         Else { IF }
  4547.  
  4548.         Begin
  4549.           { Character inside single or double quotes }
  4550.           Buf[0] := Fmt[0];
  4551.           Inc(Buf);
  4552.           Inc(Fmt);
  4553.         End;
  4554.       End; { Case }
  4555.     End; { While .. Begin }
  4556.  
  4557.     //WriteLn;
  4558.  
  4559.     Result := LongInt(Buf) - LongInt(Buffer);
  4560.   End;
  4561.  
  4562. Begin
  4563.   If Value > 0 Then GetSectionRange(1)
  4564.   Else If Value < 0 Then GetSectionRange(2)
  4565.   Else GetSectionRange(3);
  4566.  
  4567.   If FmtStart = Nil Then
  4568.   Begin
  4569.     //WriteLn('No format sections available.');
  4570.     Result := FloatToText(Buffer, Value, ffGeneral, 15, 4);
  4571.   End
  4572.   Else
  4573.   Begin
  4574.     GetFormatOptions;
  4575.     //WriteLn('Parsing complete');
  4576.     If (ExpFmt = 0) And (Abs(Value) >= 1E18) Then Result := FloatToText(Buffer, Value, ffGeneral, 15, 4)
  4577.     Else
  4578.     Begin
  4579.       FloatToStr;
  4580.       //WriteLn('FloatToStr() complete: "', Digits, '" / ', Exponent);
  4581.       //WriteLn('Unexpected digits: ', UnexpectedDigits);
  4582.       //WriteLn('DigitExponent: ', DigitExponent);
  4583.       Result := PutResult;
  4584.       //WriteLn('PutResult() complete');
  4585.     End;
  4586.   End;
  4587. End;
  4588.  
  4589.  
  4590. Function FormatFloat(Const format: String; Value: Extended): String;
  4591. Var
  4592.   Temp: cstring[128];
  4593. Begin
  4594.   Temp := format;
  4595.   SetLength(Result, FloatToTextFmt(@Result[1], Value, @Temp));
  4596. End;
  4597.  
  4598.  
  4599. Procedure FloatToDecimal(Var Result: TFloatRec; Value: Extended; Precision, Decimals: Integer);
  4600. Var
  4601.   Buffer: String[24];
  4602.   Error, N: Integer;
  4603. Begin
  4604. {  If Precision > 15 Then Precision := 15;
  4605.    If Decimals > 15 Then Decimals := 15; }
  4606.  
  4607.   Str(Value:23, Buffer);
  4608.   {WriteLn('Buffer is: ', Buffer);}
  4609.  
  4610.   Result.Negative := (Buffer[1] = '-');
  4611.   Val(Copy(Buffer, 19, 5), Result.Exponent, Error);
  4612.   Inc(Result. Exponent);
  4613.   {WriteLn('Exponent is: ', Result.Exponent);}
  4614.  
  4615.   Result.Digits[0] := Buffer[2];
  4616.   Move(Buffer[4], Result.Digits[1], 14);
  4617.  
  4618.   If Decimals + Result.Exponent < Precision Then N := Decimals + Result.Exponent
  4619.   Else N := Precision;
  4620.  
  4621.   {WriteLn('Cut point is ', N);}
  4622.  
  4623.   If N > 15 Then N := 15;
  4624.  
  4625.   {WriteLn('That makes ', N, ' with our precision.');}
  4626.  
  4627.   {WriteLn;}
  4628.  
  4629.   If N = 0 Then
  4630.   Begin
  4631.     If Result.Digits[0] >= '5' Then
  4632.     Begin
  4633.       Result.Digits[0] := '1';
  4634.       Result.Digits[1] := #0;
  4635.       Inc(Result.Exponent);
  4636.     End
  4637.     Else Result.Digits[0] := #0;
  4638.   End
  4639.   Else If N > 0 Then
  4640.   Begin
  4641.     If Result.Digits[N] >= '5' Then
  4642.     Begin
  4643.       { Round up }
  4644.       Repeat
  4645.         Result.Digits[N] := #0;
  4646.         Dec(N);
  4647.         Inc(Result.Digits[N]);
  4648.       Until (N = 0) Or (Result.Digits[N] < ':');
  4649.       If Result.Digits[0] = ':' Then
  4650.       Begin
  4651.         Result.Digits[0] := '1';
  4652.         Inc(Result.Exponent);
  4653.       End;
  4654.     End
  4655.     Else
  4656.     Begin
  4657.       { Cut zeros }
  4658.       Result.Digits[N] := '0';
  4659.       While (Result.Digits[N] = '0') And (N > -1) Do
  4660.       Begin
  4661.         Result.Digits[N] := #0;
  4662.         Dec(N);
  4663.       End;
  4664.     End;
  4665.   End
  4666.   Else Result.Digits[0] := #0;
  4667.  
  4668.   If Result.Digits[0] = #0 Then
  4669.   Begin
  4670.     { Zero has neither Exponent nor signum }
  4671.     Result.Exponent := 0;
  4672.     Result.Negative := False;
  4673.   End;
  4674. End;
  4675.  
  4676. { Time encoding And decoding }
  4677.  
  4678. Procedure FastDiv(P, Q: LongWord; Var X, Y: LongInt); Assembler;
  4679. Asm
  4680.   MOV EAX, P;
  4681.   Xor EDX, EDX;
  4682.   Div DWord Ptr Q;
  4683.   MOV EBX, X;
  4684.   MOV [EBX], EAX;
  4685.   MOV EBX, Y;
  4686.   MOV [EBX], EDX;
  4687. End;
  4688.  
  4689. Function _EncodeDate(Var date: TDateTime; Year, Month, Day: LongInt): Boolean;
  4690. Begin
  4691.   If (Year <= 9999) And (Month In [1..12]) And (Day In [1..31]) Then
  4692.   Begin
  4693.     If Month > 2 Then Dec (Month, 3)
  4694.     Else
  4695.     Begin
  4696.       Inc (Month, 9);
  4697.       Dec (Year);
  4698.     End;
  4699.     date:= (146097 * (Year Div 100)) Shr 2
  4700.          + (1461 * (Year Mod 100)) Shr 2
  4701.          + (153 * Month + 2) Div 5 + Day - 306;
  4702.     Result := True;
  4703.   End
  4704.   Else Result := False;
  4705. End;
  4706.  
  4707. /*
  4708. Function _EncodeDate(Var date: TDateTime; Year, Month, Day: LongWord): Boolean;
  4709. Var
  4710.   LeapYear: Boolean;
  4711. Begin
  4712.   If (Year <= 9999) And (Month In [1..12]) And (Day In [1..31]) Then
  4713.   Begin
  4714.     LeapYear := (Year Mod 4 = 0) And Not (Year Mod 100 = 0) Or (Year Mod 400 = 0);
  4715.     Dec(Year);
  4716.     date := Year * 365 + Year Div 4 - Year Div 100 + Year Div 400
  4717.             + 1 + DaysPassed[LeapYear, Month] + Day - 1;
  4718.     Result := True;
  4719.   End
  4720.   Else Result := False;
  4721. End;
  4722. */
  4723.  
  4724. Function _EncodeTime(Var Time: TDateTime; Hour, Min, Sec, MSec: LongInt): Boolean;
  4725. Begin
  4726.   If (Hour < 24) And (Min < 60) And (Sec < 60) And (MSec < 1000) Then
  4727.   Begin
  4728.     Time := (((Hour * 60 + Min) * 60 + Sec) * 1000 + MSec) / MSecsPerDay;
  4729.     Result := True
  4730.   End
  4731.   Else Result := False;
  4732. End;
  4733.  
  4734. Function EncodeDate(Year, Month, Day: Word): TDateTime;
  4735. Begin
  4736.   If Not _EncodeDate(Result, Year, Month, Day) Then
  4737.     FmtLoadConvertError(SDateEncodeError, [Year, Month, Day]);
  4738. End;
  4739.  
  4740. Function EncodeTime(Hour, Min, Sec, MSec: Word): TDateTime;
  4741. Begin
  4742.   If Not _EncodeTime(Result, Hour, Min, Sec, MSec) Then
  4743.     FmtLoadConvertError(STimeEncodeError, [Hour, Min, Sec, MSec]);
  4744. End;
  4745.  
  4746. Procedure DecodeDate(date: TDateTime; Var Year, Month, Day: Word);
  4747. Const
  4748.   Days400 = 146097;
  4749.   Days4   = 1461;
  4750. Var
  4751.   Y, M, D, Tmp1, Tmp2, Tmp3, Tmp4: LongInt;
  4752. Begin
  4753.   Tmp1 := Trunc (date) + 306;
  4754.   Tmp2 := 4 * Tmp1 - 1;
  4755.  
  4756.   FastDiv(Tmp2, Days400, Tmp3, Tmp1);
  4757.  
  4758.   Tmp2 := Tmp1 Shr 2;
  4759.   Tmp4 := 4 * Tmp2 + 3;
  4760.  
  4761.   FastDiv(Tmp4, Days4, Tmp1, Tmp2);
  4762.  
  4763.   Tmp2 := (Tmp2 + 4) Shr 2;
  4764.  
  4765.   Y := 100 * Tmp3 + Tmp1;
  4766.   Tmp3 := 5 * Tmp2 - 3;
  4767.  
  4768.   FastDiv(Tmp3, 153, M, Tmp2);
  4769.  
  4770.   D := (Tmp2 + 5) Div 5;
  4771.   If M < 10 Then Inc (M, 3)
  4772.   Else
  4773.   Begin
  4774.     Dec (M, 9);
  4775.     Inc (Y);
  4776.   End;
  4777.  
  4778.   Year := Y;
  4779.   Month := M;
  4780.   Day := D;
  4781. End;
  4782.  
  4783. /*
  4784. Procedure DecodeDate(date: TDateTime; Var Year, Month, Day: Word);
  4785. Const
  4786.   Days400 = 146097;
  4787.   Days100 = 36524;
  4788.   Days4   = 1461;
  4789. Var
  4790.   cnt, DayNum: LongInt;
  4791.   LeapYear: Boolean;
  4792. Begin
  4793.   DayNum := Trunc(date);
  4794.  
  4795.   Year := 1;
  4796.  
  4797.   While DayNum > Days400 Do
  4798.     Begin
  4799.       Inc(Year, 400);
  4800.       Dec(DayNum, Days400);
  4801.     End;
  4802.  
  4803.   cnt := 0;
  4804.   While (DayNum > Days100) And (cnt < 3) Do
  4805.     Begin
  4806.       Inc(Year, 100);
  4807.       Dec(DayNum, Days100);
  4808.       Inc(cnt);
  4809.     End;
  4810.  
  4811.   While DayNum > Days4 Do
  4812.     Begin
  4813.       Inc(Year, 4);
  4814.       Dec(DayNum, Days4);
  4815.     End;
  4816.  
  4817.   cnt := 0;
  4818.   While (DayNum > 365) And (cnt < 3) Do
  4819.     Begin
  4820.       Inc(Year);
  4821.       Dec(DayNum, 365);
  4822.       Inc(cnt);
  4823.     End;
  4824.  
  4825.   LeapYear := (Year Mod 4 = 0) And Not (Year Mod 100 = 0) Or (Year Mod 400 = 0);
  4826.  
  4827.   Month := 0;
  4828.   While DaysPassed[LeapYear, Month + 1] < DayNum Do
  4829.     Inc(Month);
  4830.  
  4831.   Day := DayNum - DaysPassed[LeapYear, Month];
  4832. End;
  4833. */
  4834.  
  4835. Procedure DecodeTime(Time: TDateTime; Var Hour, Min, Sec, MSec: Word);
  4836. Begin
  4837.   Time := Frac(Time) * 24;
  4838.   Hour := Trunc(Time);
  4839.   Time := Frac(Time) * 60;
  4840.   Min  := Trunc(Time);
  4841.   Time := Frac(Time) * 60;
  4842.   Sec  := Trunc(Time);
  4843.   MSec := Trunc(Frac(Time) * 1000);
  4844. End;
  4845.  
  4846. Function DayOfWeek(date: TDateTime): Integer;
  4847. Begin
  4848.   Result := (1 + Trunc(date)) Mod 7;
  4849.   If Result = 0 Then Result := 7;
  4850. End;
  4851.  
  4852. Function date: TDateTime;
  4853. {$IFDEF OS2}
  4854. Var
  4855.   dt: DateTime;
  4856. {$ENDIF}
  4857. {$IFDEF Win95}
  4858. Var
  4859.   dt: SYSTEMTIME;
  4860. {$ENDIF}
  4861. Begin
  4862.   {$IFDEF OS2}
  4863.   DosGetDateTime (dt);
  4864.   date := EncodeDate(dt.Year, dt.Month, dt.Day);
  4865.   {$ENDIF}
  4866.   {$IFDEF Win95}
  4867.   GetLocalTime(dt);
  4868.   date := EncodeDate(dt.wYear, dt.wMonth, dt.wDay);
  4869.   {$ENDIF}
  4870. End;
  4871.  
  4872. Function Time: TDateTime;
  4873. {$IFDEF OS2}
  4874. Var
  4875.   dt: DateTime;
  4876. {$ENDIF}
  4877. {$IFDEF Win95}
  4878. Var
  4879.   dt: SYSTEMTIME;
  4880. {$ENDIF}
  4881. Begin
  4882.   {$IFDEF OS2}
  4883.   DosGetDateTime (dt);
  4884.   Time := EncodeTime(dt.Hour, dt.Min, dt.Sec, dt.Hundredths * 10);
  4885.   {$ENDIF}
  4886.   {$IFDEF Win95}
  4887.   GetLocalTime(dt);
  4888.   Time := EncodeTime(dt.wHour, dt.wMinute, dt.wSecond, dt.wMilliSeconds * 10);
  4889.   {$ENDIF}
  4890. End;
  4891.  
  4892. Function now: TDateTime;
  4893. {$IFDEF OS2}
  4894. Var
  4895.   dt: DateTime;
  4896. {$ENDIF}
  4897. {$IFDEF Win95}
  4898. Var
  4899.   dt: SYSTEMTIME;
  4900. {$ENDIF}
  4901. Begin
  4902.   {$IFDEF OS2}
  4903.   DosGetDateTime (dt);
  4904.   now := EncodeDate(dt.Year, dt.Month, dt.Day) + EncodeTime(dt.Hour, dt.Min, dt.Sec, dt.Hundredths * 10);
  4905.   {$ENDIF}
  4906.   {$IFDEF Win95}
  4907.   GetLocalTime(dt);
  4908.   now := EncodeDate(dt.wYear, dt.wMonth, dt.wDay) + EncodeTime(dt.wHour, dt.wMinute, dt.wSecond, dt.wMilliSeconds * 10);
  4909.   {$ENDIF}
  4910. End;
  4911.  
  4912. { --- date/Time To String conversion --- }
  4913.  
  4914. Procedure DateTimeToString(Var Result: String; Const format: String; DateTime: TDateTime);
  4915. Var
  4916.   Year, Month, Day, Hour, Min, Sec, MSec, Hour12: Word;
  4917.   BeforeNoon: Boolean;
  4918.  
  4919.   Procedure _DateTimeToString(Var Result: String; Const format: String; recursive: Boolean);
  4920.     { internal Function To Control recursion In format specifiers. Avoids
  4921.       stack overflow when format Strings contain Macros For other format
  4922.       Strings. }
  4923.  
  4924.   Var
  4925.     Start, Count, Pos, len, LastHourPos, LastHourSize, Tmp: Integer;
  4926.     Token: Char;
  4927.     UseMinutes: Boolean;
  4928.  
  4929.     Procedure AppendInt(I, Digits: Integer);
  4930.     Var
  4931.       S: String[5];
  4932.       P: Integer;
  4933.     Begin
  4934.       Str(I:Digits, S);
  4935.       P := 1;
  4936.       While S[P] = ' ' Do
  4937.       Begin
  4938.         S[P] := '0';
  4939.         Inc(P);
  4940.       End;
  4941.       AppendStr(Result, S);
  4942.     End;
  4943.  
  4944.     Procedure AppendStr(Const S: String);
  4945.     Begin
  4946.       Insert(S, Result, Length(Result) + 1);
  4947.     End;
  4948.  
  4949.     Function CountChar(C: Char; Max: Integer): Integer;
  4950.     Var
  4951.       Result: Integer;
  4952.     Begin
  4953.       Result := 1;
  4954.       While (Pos <= len) And (UpCase(format[Pos]) = C) And (Result < Max) Do
  4955.       Begin
  4956.         Inc(Pos);
  4957.         Inc(Result);
  4958.       End;
  4959.       CountChar := Result;
  4960.     End;
  4961.  
  4962.     Function IsSubStr(Const S: String): Boolean;
  4963.     Begin
  4964.       IsSubStr := (uppercase(Copy(format, Pos, Length(S))) = S);
  4965.     End;
  4966.  
  4967.     Procedure GetNextToken(BeforeNoon: Boolean);
  4968.     Begin
  4969.       Start := Pos;
  4970.       Token := UpCase(format[Pos]);
  4971.       Inc(Pos);
  4972.       Case Token Of
  4973.         #34,
  4974.         #39: Begin
  4975.                Inc(Start);
  4976.                While (Pos <= len) And (format[Pos] <> Token) Do Inc(Pos);
  4977.                Count := Pos - Start;
  4978.                If Pos < len Then Inc(Pos);
  4979.                Token := '$';
  4980.              End;
  4981.         'D': Count := CountChar('D', 6);
  4982.         'M': Count := CountChar('M', 4);
  4983.         'Y': Count := CountChar('Y', 4);
  4984.         'H',
  4985.         'N',
  4986.         'S',
  4987.         'T': Count := CountChar(Token, 2);
  4988.         'A': Begin
  4989.                If IsSubStr('MPM') Then
  4990.                Begin
  4991.                  Inc(Pos, 3);
  4992.                  Count := 0;
  4993.                End
  4994.                Else If IsSubStr('/P') Then
  4995.                Begin
  4996.                  Inc(Pos, 2);
  4997.                  If Not BeforeNoon Then Inc(Start, 2);
  4998.                  Count := 1;
  4999.                End
  5000.                Else If IsSubStr('M/PM') Then
  5001.                Begin
  5002.                  Inc(Pos, 4);
  5003.                  If Not BeforeNoon Then Inc(Start, 3);
  5004.                  Count := 2;
  5005.                End
  5006.                Else
  5007.                Begin
  5008.                  Token := '$';
  5009.                  Count := 1;
  5010.                End;
  5011.              End;
  5012.         'C',
  5013.         '/',
  5014.         ':': Begin
  5015.                { Nope }
  5016.              End;
  5017.         Else Begin
  5018.                Token := '$';
  5019.                Count := 1;
  5020.                While (Pos <= len) And Not (UpCase(format[Pos]) In
  5021.                    [#34, #39, 'A', 'C', 'D', 'H', 'M', 'N', 'S', 'T', 'Y', ':', '/']) Do
  5022.                Begin
  5023.                  Inc(Pos);
  5024.                  Inc(Count);
  5025.                End;
  5026.              End;
  5027.       End;
  5028.  
  5029.       If (Token = 'M') And UseMinutes Then Token := 'N';
  5030.  
  5031.       Case Token Of
  5032.         'H': UseMinutes := True;
  5033.         'A', 'C', 'D', 'M', 'N', 'S', 'T', 'Y': UseMinutes := False;
  5034.       End;
  5035.     End;
  5036.  
  5037.   Begin
  5038.     Pos := 1;
  5039.     len := Length(format);
  5040.     LastHourPos := 0;
  5041.     UseMinutes := False;
  5042.  
  5043.     If len = 0 Then _DateTimeToString(Result, 'C', True)
  5044.     Else While (Pos <= len) Do
  5045.     Begin
  5046.       GetNextToken(BeforeNoon);
  5047.       // WriteLn('Token=', Token, ' Start=', Start, ' Count=', Count);
  5048.       Case Token Of
  5049.         'C': If recursive Then
  5050.              Begin
  5051.                _DateTimeToString(Result, ShortDateFormat, False);
  5052.                If (Hour + Min + Sec) > 0 Then
  5053.                Begin
  5054.                  AppendStr(' ');
  5055.                  _DateTimeToString(Result, LongTimeFormat, False);
  5056.                End;
  5057.              End
  5058.              Else AppendStr('C');
  5059.         'D': Case Count Of
  5060.                1: AppendInt(Day, 1);
  5061.                2: AppendInt(Day, 2);
  5062.                3: AppendStr(ShortDayNames[DayOfWeek(DateTime)]);
  5063.                4: AppendStr(LongDayNames[DayOfWeek(DateTime)]);
  5064.                5: If recursive Then _DateTimeToString(Result, ShortDateFormat, False)
  5065.                   Else AppendStr('DDDDD');
  5066.                6: If recursive Then _DateTimeToString(Result, LongDateFormat, False)
  5067.                   Else AppendStr('DDDDDD');
  5068.              End;
  5069.         'M': Case Count Of
  5070.                1: AppendInt(Month, 1);
  5071.                2: AppendInt(Month, 2);
  5072.                3: AppendStr(ShortMonthNames[Month]);
  5073.                4: AppendStr(LongMonthNames[Month]);
  5074.              End;
  5075.         'Y': Case Count Of
  5076.                1, 2: AppendInt(Year Mod 100, 2);
  5077.                3, 4: AppendInt(Year, 4);
  5078.              End;
  5079.         'H': Begin
  5080.                LastHourPos := Length(Result) + 1;
  5081.                LastHourSize := Count;
  5082.                AppendInt(Hour, Count);
  5083.              End;
  5084.         'N': AppendInt(Min, Count);
  5085.         'S': AppendInt(Sec, Count);
  5086.         'T': Case Count Of
  5087.                1: If recursive Then _DateTimeToString(Result, ShortTimeFormat, False)
  5088.                   Else AppendStr('T');
  5089.                2: If recursive Then _DateTimeToString(Result, LongTimeFormat, False)
  5090.                   Else AppendStr('TT');
  5091.              End;
  5092.         'A': Begin
  5093.                If LastHourPos <> 0 Then
  5094.                Begin
  5095.                  If (LastHourSize = 1) And (Hour < 10) Then Tmp := 1
  5096.                  Else Tmp := 2;
  5097.                  Delete(Result, LastHourPos, Tmp);
  5098.                  If (LastHourSize = 2) And (Hour12 < 10) Then
  5099.                      Insert('0' + IntToStr(Hour12), Result, LastHourPos)
  5100.                  Else Insert(IntToStr(Hour12), Result, LastHourPos);
  5101.                  LastHourPos := 0;
  5102.                End;
  5103.                Case Count Of
  5104.                  0: If BeforeNoon Then AppendStr(TimeAMString)
  5105.                     Else AppendStr(TimePMString);
  5106.                  1: AppendStr(format[Start]);
  5107.                  2: AppendStr(format[Start] + format[Start  + 1]);
  5108.                End
  5109.              End;
  5110.         '/': AppendStr(DateSeparator);
  5111.         ':': AppendStr(TimeSeparator);
  5112.         '$': AppendStr(Copy(format, Start, Count));
  5113.       End;
  5114.     End;
  5115.   End;
  5116.  
  5117. Begin
  5118.   DateTime := DateTime + 5.79e-6;  // avoid rounding problems
  5119.  
  5120.   DecodeDate(DateTime, Year, Month, Day);
  5121.   DecodeTime(DateTime, Hour, Min, Sec, MSec);
  5122.  
  5123.   If (Hour = 0) Or (Hour > 12) Then
  5124.   Begin
  5125.     If Hour = 0 Then Hour12 := 12
  5126.     Else Hour12 := Hour - 12;
  5127.     BeforeNoon := False;
  5128.   End
  5129.   Else
  5130.   Begin
  5131.     BeforeNoon := True;
  5132.     Hour12 := Hour;
  5133.   End;
  5134.   Result := '';
  5135.  
  5136.   If Length(format) <> 0 Then _DateTimeToString(Result, format, True)
  5137.   Else _DateTimeToString(Result, 'C', True)
  5138. End;
  5139.  
  5140. Function DateToStr(date: TDateTime): String;
  5141. Begin
  5142.   DateTimeToString(Result, ShortDateFormat, date);
  5143. End;
  5144.  
  5145. Function TimeToStr(Time: TDateTime): String;
  5146. Begin
  5147.   DateTimeToString(Result, LongTimeFormat, Time);
  5148. End;
  5149.  
  5150. Function DateTimeToStr(DateTime: TDateTime): String;
  5151. Begin
  5152.   DateTimeToString(Result, ShortDateFormat + ' ' + LongTimeFormat, DateTime);
  5153. End;
  5154.  
  5155. Function FormatDateTime(Const format: String; DateTime: TDateTime): String;
  5156. Begin
  5157.   DateTimeToString(Result, format, DateTime);
  5158. End;
  5159.  
  5160. { --- String To date/Time conversions --- }
  5161.  
  5162. Procedure IgnoreSpaces(Const S: String; Var Pos: Integer; len: Integer);
  5163. Begin
  5164.   While (Pos <= len) And (S[Pos] = ' ') Do Inc(Pos);
  5165. End;
  5166.  
  5167. Function GetNumber(Var Num: Integer; Const S: String; Var Pos: Integer; len: Integer): Boolean;
  5168. Begin
  5169.   Result := False;
  5170.   Num := 0;
  5171.   IgnoreSpaces(S, Pos, len);
  5172.   While (Pos <= len) And (S[Pos] In ['0'..'9']) Do
  5173.   Begin
  5174.     Result := True;
  5175.     Num := Num * 10 + Ord(S[Pos]) - 48;
  5176.     Inc(Pos);
  5177.   End;
  5178. End;
  5179.  
  5180. {$HINTS OFF}
  5181. Function CompareString(Const SubStr, S: String; Var Pos: Integer; len: Integer): Boolean;
  5182. Begin
  5183.   If CompareText(SubStr, Copy(S, 1, Length(SubStr))) = 0 Then
  5184.   Begin
  5185.     Result := True;
  5186.     Inc(Pos, Length(SubStr));
  5187.   End
  5188.   Else Result := False;
  5189. End;
  5190. {$HINTS ON}
  5191.  
  5192. Function CompareChar(C: Char; S: String; Var Pos: Integer; len: Integer): Boolean;
  5193. Begin
  5194.   If (Pos <= len) And (UpCase(C) = UpCase(S[Pos])) Then
  5195.   Begin
  5196.     Result := True;
  5197.     Inc(Pos);
  5198.   End
  5199.   Else Result := False;
  5200. End;
  5201.  
  5202. Function CutString(Var S: String; separator: Char): String;
  5203. Var
  5204.   P: Integer;
  5205. Begin
  5206.   P := Pos(separator, S);
  5207.   If P = 0 Then P := Length(S) + 1;
  5208.   Result := Copy(S, 1, P - 1);
  5209.   Delete(S, 1, P);
  5210. End;
  5211.  
  5212. Function ParseDate(Var date: TDateTime; Const S: String; Var Pos: Integer; len: Integer): Boolean;
  5213. Var
  5214.   Head, Temp: String[15];
  5215.   N, Year, Month, Day: Integer;
  5216.   Number: Array[1..3] Of Integer;
  5217.   order: String[3];
  5218.  
  5219.   Function GetCurrentYear: Integer;
  5220.   Var
  5221.     Y, M, D: Word;
  5222.   Begin
  5223.     DecodeDate(now, Y, M, D);
  5224.     Result := Y;
  5225.   End;
  5226.  
  5227. Begin
  5228.   order := 'XXX';
  5229.  
  5230.   Result := False;
  5231.  
  5232.   If Not GetNumber(Number[1], S, Pos, len) Then Exit;
  5233.   If Not CompareChar(DateSeparator, S, Pos, len) Then Exit;
  5234.   If Not GetNumber(Number[2], S, Pos, len) Then Exit;
  5235.   If Not CompareChar(DateSeparator, S, Pos, len) Then Exit;
  5236.   If Not GetNumber(Number[3], S, Pos, len) Then Number[3] := -1;
  5237.  
  5238. {  For N := 1 To 3 Do WriteLn(Number[N]); }
  5239.  
  5240.   Temp := ShortDateFormat;
  5241.  
  5242.   For N := 1 To 3 Do
  5243.   Begin
  5244.     Head := CutString(Temp, '/');
  5245.     If Length(Head) <> 0 Then order[N] := UpCase(Head[1]);
  5246.   End;
  5247.  
  5248.   If order = 'MDY' Then
  5249.   Begin
  5250.     Month := Number[1];
  5251.     Day := Number[2];
  5252.     Year := Number[3];
  5253.   End
  5254.   Else If order = 'DMY' Then
  5255.   Begin
  5256. {    WriteLn('DMY'); }
  5257.     Day := Number[1];
  5258.     Month := Number[2];
  5259.     Year := Number[3];
  5260.   End
  5261.   Else If order = 'YMD' Then
  5262.   Begin
  5263.     If Number[3] = -1 Then
  5264.     Begin
  5265.       Year := -1;
  5266.       Month := Number[1];
  5267.       Day := Number[2];
  5268.     End
  5269.     Else
  5270.     Begin
  5271.       Year := Number[1];
  5272.       Month := Number[2];
  5273.       Day := Number[3];
  5274.     End;
  5275.   End;
  5276.  
  5277.   If Year = -1 Then Year := GetCurrentYear
  5278.   Else If Year < 100 Then Inc(Year, 1900);
  5279.  
  5280.   Result := True;
  5281.   Result := _EncodeDate(date, Year, Month, Day);
  5282. End;
  5283.  
  5284. Function ParseTime(Var Time: TDateTime; Const S: String; Var Pos: Integer; len: Integer): Boolean;
  5285. Var
  5286.   Hour, Min, Sec: Integer;
  5287. Begin
  5288.   Result := False;
  5289.  
  5290.   If Not GetNumber(Hour, S, Pos, len) Then Exit;
  5291.   If Not CompareChar(TimeSeparator, S, Pos, len) Then Exit;
  5292.   If Not GetNumber(Min, S, Pos, len) Then Exit;
  5293.   If CompareChar(TimeSeparator, S, Pos, len) And Not GetNumber(Sec, S, Pos, len) Then Exit;
  5294.  
  5295.   IgnoreSpaces(S, Pos, len);
  5296.   If CompareChar('A', S, Pos, len) Then
  5297.   Begin
  5298.     CompareChar('M', S, Pos, len);
  5299.     If Hour = 12 Then Hour := 0;
  5300.   End
  5301.   Else If CompareChar('P', S, Pos, len) Then
  5302.   Begin
  5303.     CompareChar('M', S, Pos, len);
  5304.     If (Hour >= 1) And (Hour <= 11) Then Inc(Hour, 12);
  5305.   End;
  5306.  
  5307.   Result := _EncodeTime(Time, Hour, Min, Sec, 0);
  5308. End;
  5309.  
  5310. Function StrToDate(Const S: String): TDateTime;
  5311. Var
  5312.   Pos, len: Integer;
  5313. Begin
  5314.   Pos := 1;
  5315.   len := Length(S);
  5316.   If Not ParseDate(Result, S, Pos, len) Then FmtLoadConvertError(SInvalidDate, [S]);
  5317. End;
  5318.  
  5319. Function StrToTime(Const S: String): TDateTime;
  5320. Var
  5321.   Pos, len: Integer;
  5322. Begin
  5323.   Pos := 1;
  5324.   len := Length(S);
  5325.   If Not ParseTime(Result, S, Pos, len) Then FmtLoadConvertError(SInvalidTime, [S]);
  5326. End;
  5327.  
  5328. Function StrToDateTime(Const S: String): TDateTime;
  5329. Var
  5330.   Time: TDateTime;
  5331.   Pos, len: Integer;
  5332. Begin
  5333.   Pos := 1;
  5334.   len := Length(S);
  5335.   If Not ParseDate(Result, S, Pos, len) Then FmtLoadConvertError(SInvalidDateTime, [S]);
  5336.   If ParseTime(Time, S, Pos, len) Then Result := Result + Time;
  5337. End;
  5338.  
  5339. { --- Initialization File support --- }
  5340.  
  5341. {$IFDEF GUI}
  5342.  
  5343. Function GetProfileStr(Const Section, Entry, Default: String): String;
  5344. Var
  5345.   CDefault,OutBuf: cstring;
  5346. Begin
  5347.   CDefault := Default;
  5348.   {$IFDEF OS2}
  5349.   Fillchar(OutBuf, 255, 0); {sometimes the #0 character is not copied (cdp.ini)}
  5350.   PrfQueryProfileString(HINI_UserProfile, Section, Entry, Default, OutBuf, 255);
  5351.   Result := OutBuf;
  5352.   {$ENDIF}
  5353.   {$IFDEF Win95}
  5354.   If entry='' Then GetProfileString('USER',section,Default,CDefault,255)
  5355.   Else GetProfileString('USER',section,entry,CDefault,255);
  5356.   result:=CDefault;
  5357.   {$ENDIF}
  5358. End;
  5359.  
  5360. {$HINTS OFF}
  5361. Function GetProfileChar(Const Section, Entry: String; Default: Char): Char;
  5362. Var
  5363.   InBuf, OutBuf: cstring[2];
  5364. Begin
  5365.   InBuf[0] := Default;
  5366.   InBuf[1] := #0;
  5367.   {$IFDEF OS2}
  5368.   PrfQueryProfileString(HINI_UserProfile,
  5369.                         Section, Entry,
  5370.                         InBuf, OutBuf, 2);
  5371.   Result := OutBuf[0];
  5372.   {$ENDIF}
  5373.   {$IFDEF Win95}
  5374.   GetProfileString('USER',section,InBuf,OutBuf,255);
  5375.   Result:= OutBuf[0];
  5376.   {$ENDIF}
  5377. End;
  5378. {$HINTS ON}
  5379.  
  5380. Function GetProfileInt(Const Section, Entry: string; Default: Integer): Integer;
  5381. {$IFDEF Win95}
  5382. Var
  5383.   S: String;
  5384.   C: Integer;
  5385. {$ENDIF}
  5386. Begin
  5387.   {$IFDEF OS2}
  5388.   Result := PrfQueryProfileInt(HINI_UserProfile,Section, Entry,Default);
  5389.   {$ENDIF}
  5390.   {$IFDEF Win95}
  5391.   S:=GetProfileStr(section,entry,'');
  5392.   Val(S,Result,C);
  5393.   If C<>0 Then Result:=Default;
  5394.   {$ENDIF}
  5395. End;
  5396.  
  5397. Procedure GetFormatSettings;
  5398. Const
  5399.   key = 'PM_National';
  5400. Var
  5401.   N: Integer;
  5402. Begin
  5403.   TimeAMString := GetProfileStr(key, 's1159', 'am');
  5404.   TimePMString := GetProfileStr(key, 's2359', 'pm');
  5405.   CurrencyString := GetProfileStr(key, 'sCurrency', '$');
  5406.   ThousandSeparator := GetProfileChar(key, 'sThousand', ',');
  5407.   DecimalSeparator := GetProfileChar(key, 'sDecimal', '.');
  5408.   DateSeparator := GetProfileChar(key, 'sDate', '/');
  5409.   TimeSeparator := GetProfileChar(key, 'sTime', ':');
  5410.   ListSeparator := GetProfileChar(key, 'sList', ';');
  5411.  
  5412.   DateOrder := GetProfileInt(key, 'iDate', 0);
  5413.   Case DateOrder Of
  5414.     0: Begin
  5415.          ShortDateFormat := 'mm/dd/yyyy';
  5416.          LongDateFormat := 'dddd, mmmm d. yyyy';
  5417.        End;
  5418.     1: Begin
  5419.          ShortDateFormat := 'dd/mm/yyyy';
  5420.          LongDateFormat := 'dddd, d. mmmm yyyy';
  5421.        End;
  5422.     2: Begin
  5423.          ShortDateFormat := 'yyyy/mm/dd';
  5424.          LongDateFormat := 'dddd, yyyy mmmm d.';
  5425.        End;
  5426.   End;
  5427.  
  5428.   CurrencyFormat := GetProfileInt(key, 'iCurrency', 0);
  5429.  
  5430.   Case CurrencyFormat Of
  5431.     0: NegCurrFormat := 1;
  5432.     1: NegCurrFormat := 5;
  5433.     2: NegCurrFormat := 9;
  5434.     3: NegCurrFormat := 8;
  5435.   End;
  5436.  
  5437.   CurrencyDecimals := GetProfileInt(key, 'iDigits', 2);
  5438.  
  5439.   Case GetProfileInt(key, 'iLzero', 0) Of
  5440.     0: Begin
  5441.          ShortTimeFormat := 'h:mm';
  5442.          LongTimeFormat := 'h:mm:ss';
  5443.        End;
  5444.     1: Begin
  5445.          ShortTimeFormat := 'hh:mm';
  5446.          LongTimeFormat := 'hh:mm:ss';
  5447.        End;
  5448.   End;
  5449.  
  5450.   If GetProfileInt(key, 'iTime', 0) = 0 Then
  5451.   Begin
  5452.     ShortTimeFormat := ShortTimeFormat + ' ampm';
  5453.     LongTimeFormat := LongTimeFormat + ' ampm';
  5454.     TwelveHours := True;
  5455.   End
  5456.   Else TwelveHours := False;
  5457.  
  5458.   For N := 1 To 12 Do
  5459.   Begin
  5460.     ShortMonthNames[N] := LoadNLSStr(SShortMonthNames + N - 1);
  5461.     LongMonthNames[N] := LoadNLSStr(SLongMonthNames + N - 1);
  5462.   End;
  5463.  
  5464.   For N := 1 To 7 Do
  5465.   Begin
  5466.     ShortDayNames[N] := LoadNLSStr(SShortDayNames + N - 1);
  5467.     LongDayNames[N] := LoadNLSStr(SLongDayNames + N - 1);
  5468.   End;
  5469. End;
  5470.  
  5471. {$ELSE}
  5472.  
  5473. Procedure GetFormatSettings; { VIO-only! }
  5474. Var
  5475.   cc: COUNTRYCODE;
  5476.   CI: COUNTRYINFO;
  5477.   L: LongInt;
  5478. Begin
  5479.   cc.country :=  0;
  5480.   cc.codepage := 0;
  5481.   If DosQueryCtryInfo(SizeOf(CI), cc, CI, L) <> NO_ERROR Then Halt(255);
  5482.  
  5483.   CurrencyString := CI.szCurrency;
  5484.   CurrencyFormat := CI.fsCurrencyFmt;
  5485.  
  5486.   ThousandSeparator := CI.szThousandsSeparator[0];
  5487.   DecimalSeparator := CI.szDecimal[0];
  5488.   DateSeparator := CI.szDateSeparator[0];
  5489.   TimeSeparator := CI.szTimeSeparator[0];
  5490.   ListSeparator := CI.szDataSeparator[0];
  5491.   CurrencyDecimals := CI.cDecimalPlace;
  5492.  
  5493.   Case CurrencyFormat Of
  5494.     0: NegCurrFormat := 1;
  5495.     1: NegCurrFormat := 5;
  5496.     2: NegCurrFormat := 9;
  5497.     3: NegCurrFormat := 8;
  5498.   End;
  5499.  
  5500.   DateOrder := CI.fsDateFmt;
  5501.   Case DateOrder Of
  5502.     0: Begin
  5503.          ShortDateFormat := 'mm/dd/yyyy';
  5504.          LongDateFormat := 'dddd, mmmm d. yyyy';
  5505.        End;
  5506.     1: Begin
  5507.          ShortDateFormat := 'dd/mm/yyyy';
  5508.          LongDateFormat := 'dddd, d. mmmm yyyy';
  5509.        End;
  5510.     2: Begin
  5511.          ShortDateFormat := 'yyyy/mm/dd';
  5512.          LongDateFormat := 'dddd, yyyy mmmm d.';
  5513.        End;
  5514.   End;
  5515.  
  5516.   Case CI.fsTimeFmt Of
  5517.     0: Begin
  5518.          ShortTimeFormat := 'hh:mm ampm';
  5519.          LongTimeFormat := 'hh:mm:ss ampm';
  5520.          TwelveHours := True;
  5521.        End;
  5522.     1: Begin
  5523.          ShortTimeFormat := 'hh:mm';
  5524.          LongTimeFormat := 'hh:mm:ss';
  5525.          TwelveHours := False;
  5526.        End;
  5527.   End;
  5528.  
  5529.   DosQueryCollate(256, cc, CollatingSequence, L);
  5530. End;
  5531.  
  5532. {$ENDIF}
  5533.  
  5534. Function StringOfChars(CH: Char; Count: Integer): String;
  5535. Begin
  5536.   SetLength(Result, Count);
  5537.   FillChar(Result[1], Count, CH);
  5538. End;
  5539.  
  5540. {Exception management}
  5541. Constructor Exception.CreateFmt(Const Msg:String;Const Args:Array Of Const);
  5542. Begin
  5543.      Inherited Create(format(Msg,Args));
  5544. End;
  5545.  
  5546. Constructor Exception.CreateRes(Ident:Word);
  5547. Begin
  5548.      Inherited Create(LoadStr(Ident));
  5549. End;
  5550.  
  5551. Constructor Exception.CreateResFmt(Ident:Word;Const Args:Array Of Const);
  5552. Begin
  5553.      Inherited Create(format(LoadStr(Ident),Args));
  5554. End;
  5555.  
  5556. Constructor Exception.CreateResNLS(Ident:Word);
  5557. Begin
  5558.      Inherited Create(LoadNLSStr(Ident));
  5559. End;
  5560.  
  5561. Constructor Exception.CreateResNLSFmt(Ident:Word;Const Args:Array Of Const);
  5562. Begin
  5563.      Inherited Create(format(LoadNLSStr(Ident),Args));
  5564. End;
  5565.  
  5566. Constructor Exception.CreateHelp(Const Msg:String;AHelpContext:LongInt);
  5567. Begin
  5568.      Inherited Create(Msg);
  5569.      HelpContext:=AHelpContext;
  5570. End;
  5571.  
  5572. Constructor Exception.CreateFmtHelp(Const Msg:String;Const Args:Array Of Const;AHelpContext:LongInt);
  5573. Begin
  5574.      Inherited Create(format(Msg,Args));
  5575.      HelpContext:=AHelpContext;
  5576. End;
  5577.  
  5578. Constructor Exception.CreateResHelp(Ident:Word;AHelpContext:LongInt);
  5579. Begin
  5580.      Inherited Create(LoadStr(Ident));
  5581.      HelpContext:=AHelpContext;
  5582. End;
  5583.  
  5584. Constructor Exception.CreateResFmtHelp(Ident:Word;Const Args:Array Of Const;AHelpContext:LongInt);
  5585. Begin
  5586.      Inherited Create(format(LoadStr(Ident),Args));
  5587.      HelpContext:=AHelpContext;
  5588. End;
  5589.  
  5590. Constructor Exception.CreateResNLSHelp(Ident:Word;AHelpContext:LongInt);
  5591. Begin
  5592.      Inherited Create(LoadNLSStr(Ident));
  5593.      HelpContext:=AHelpContext;
  5594. End;
  5595.  
  5596. Constructor Exception.CreateResNLSFmtHelp(Ident:Word;Const Args:Array Of Const;AHelpContext:LongInt);
  5597. Begin
  5598.      Inherited Create(format(LoadNLSStr(Ident),Args));
  5599.      HelpContext:=AHelpContext;
  5600. End;
  5601.  
  5602. Var AH,AQ:LongWord;
  5603.  
  5604. Begin
  5605.   {$IFDEF OS2}
  5606.   InitPM;
  5607.   {$ENDIF}
  5608.   SetCurrentLanguageTable('SIBYL_NLS_Default');
  5609.   GetFormatSettings;
  5610. End.
  5611.  
  5612. { -- date -- -- changes ----------------------------------------------
  5613.  
  5614.   28-Feb-96   assume fmShareDenyNone, If no sharing Mode Is specified.
  5615.               added support For File locking.
  5616.   08-Mar-96   added lots Of comments. added resources And loading Of
  5617.               Error Messages And Month / Day Names.
  5618.               FIXED A bug In FormatStr.
  5619.   14-Apr-96   removed Some forgotten debugging Code.
  5620.   18-Apr-96   added windows-only AnsiLowerCase And AnsiCompareStr.
  5621.               FIXED A bug In DayOfWeek.
  5622.               Faster EncodeDate / DecodeDate.
  5623.   12-may-96   Error codes returned by File Open FUNCTIONs were always -1.
  5624.   24-may-96   added Trim, TrimLeft, TrimRight, And QuotedStr FUNCTIONs As
  5625.               In Delphi 2.0.
  5626.   11-Jun-96   bug In FloatToStrF, ffGeneral With values < 0.001 always used
  5627.               FIXED Point.
  5628.   27-Jul-96   removed SetLength, already declared In System Unit.
  5629.   27-Aug-96   added SysErrorMessage.
  5630.   26-Dec-96   FIXED Error In date encoding. changed numerous Parameters In
  5631.               API calls from LongInt To LongWord where ULONG was expected.
  5632.   27-Dec-96   added support For AnsiStrings As Open Array Parameters In
  5633.               String formatting FUNCTIONs.
  5634.   02-Feb-97   FIXED Some bugs:
  5635.               - FileWrite returned -1 ON Success instead Of ON failure.
  5636.               - DateTimeToFileDate didn't work With New Compiler.
  5637.               changed File access Mode For FileCreate To RD/WR/exclusive.
  5638.  
  5639.  
  5640. ---------------------------
  5641. Bemerkungen für Jörg: (nur der Form halber)
  5642. -
  5643. Function FileCreate
  5644.   fmOpenReadWrite Or fmShareExclusive
  5645. -
  5646. Function DateTimeToFileDate
  5647.   Result := (FileDate Shl 16) Or FILETIME;
  5648.  
  5649.