////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2023 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// String manipulation procedures.                                            //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20010804 - Creation (uses CRW16) & test                                    //
// 20011029 - TText & test (Ok)                                               //
// 20011031 - UnifyAlias,UnifyFileAlias                                       //
// 20011031 - TText derived from TLatch                                       //
// 20011222 - UnifySection                                                    //
// 20030323 - Struggle for safety (add some try/except checks)...             //
// 20050109 - RemoveBrackets                                                  //
// 20050224 - IsSameText                                                      //
// 20060302 - StrIScan,StrRIScan,StrIPos,IsSameChar.                          //
// 20060908 - ScanVar: 4 bugs fixed                                           //
// 20070522 - URL_Encode(..,AllowChars)                                       //
// 20070717 - add URL_Packed; edit URL_XXcode                                 //
// 20070720 - edit URL_XXcode (speed optimized)                               //
// 20090105 - HasChars                                                        //
// 20120520 - ValidateCRLF                                                    //
// 20160428 - SkipWords                                                       //
// 20170302 - iValDef, iVal, rValDef, rVal                                    //
// 20171006 - IsSectionName                                                   //
// 20181118 - CookieScan                                                      //
// 20190913 - ExtractBaseName                                                 //
// 20191029 - NBSP                                                            //
// 20200721 - LineEnding,sLineBreak,DirectorySeparator,PathDelim,             //
//            PathSeparator,PathSep                                           //
// 20200828 - PosEx,LastPos,CountPos,NthPos                                   //
// 20200924 - StrFetch,AnsiDeQuotedStr,AnsiSkipQuotedStr                      //
// 20211015 - JustSpaces,HasListedExtension,ExtractFirstParam,SkipFirstParam, //
//            IsOption                                                        //
// 20211018 - GetOptionValue,HasOptionValue,QuoteMark,TrimLeftChars,          //
//            TrimRightChars                                                  //
// 20220117 - IsLexeme,lex_Name,etc                                           //
// 20220620 - IsLexeme uses lex_regexp_test,lex_FsmName..Lex_DimName          //
// 20221203 - PosEol                                                          //
// 20221217 - lex_SqlName,lex_FbdName                                         //
// 20221219 - lex_Section,lex_AtCall,lex_AtCmnd                               //
// 20230511 - Modified for FPC (A.K.)                                         //
// 20230531 - StringToSetOfChars,SetOfCharsToString                           //
// 20230909 - ExtractNameValuePair                                            //
// 20230916 - SortTextLines                                                   //
// 20230925 - TrimDef                                                         //
// 20231011 - ForEachStringLine                                               //
////////////////////////////////////////////////////////////////////////////////

unit _crw_str; // String functions.

{$I _crw_sysdef}

{$IFDEF FPC}{$mode Delphi}{$ENDIF}{$H+}

{$WARN 5023 off : Unit "$1" not used in $2}

interface

uses
 _crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
 {$IFDEF UNIX} cthreads, dl, {$ENDIF}
 {$IFDEF WINDOWS} windows, {$ENDIF}
 sysutils, classes, math,
 _crw_alloc, _crw_fifo, _crw_fpu, _crw_ef, _crw_utf8;

 {
 Magic symbols
 }
const
 { Special ASCII chars }
 ASCII_NUL  = char($00);  { -- Null  }
 ASCII_SOH  = char($01);  { ^A Start Of Heading }
 ASCII_STX  = char($02);  { ^B Start of TeXt }
 ASCII_ETX  = char($03);  { ^C End of TeXt }
 ASCII_EOT  = char($04);  { ^D End Of Transmission }
 ASCII_ENQ  = char($05);  { ^E ENQuiry }
 ASCII_ACK  = char($06);  { ^F ACKnowledge }
 ASCII_BEL  = char($07);  { ^G Bell }
 ASCII_BS   = char($08);  { ^H BackSpace }
 ASCII_HT   = char($09);  { ^I Horizontal Tabulation }
 ASCII_LF   = char($0A);  { ^J Line Feed }
 ASCII_VT   = char($0B);  { ^K Vertical Tabulation   }
 ASCII_FF   = char($0C);  { ^L Form Feed }
 ASCII_CR   = char($0D);  { ^M Carriage Return }
 ASCII_SO   = char($0E);  { ^N Shift out }
 ASCII_SI   = char($0F);  { ^O Shift in }
 ASCII_DLE  = char($10);  { ^P Data Link Escape }
 ASCII_DC1  = char($11);  { ^Q Data Control 1 }
 ASCII_DC2  = char($12);  { ^R Data Control 2 }
 ASCII_DC3  = char($13);  { ^S Data Control 3 }
 ASCII_DC4  = char($14);  { ^T Data Control 4 }
 ASCII_NAK  = char($15);  { ^U Negative AcKnowledge }
 ASCII_SYN  = char($16);  { ^V SYNcronize idle }
 ASCII_ETB  = char($17);  { ^W End of Transmission Block }
 ASCII_CAN  = char($18);  { ^X CANcel }
 ASCII_EM   = char($19);  { ^Y End of Medium }
 ASCII_SUB  = char($1A);  { ^Z SUBstitute }
 ASCII_ESC  = char($1B);  { -- ESCape }
 ASCII_FS   = char($1C);  { -- File Separator }
 ASCII_GS   = char($1D);  { -- Group Separator }
 ASCII_RS   = char($1E);  { -- Record Separator }
 ASCII_US   = char($1F);  { -- Unit Separator }
 ASCII_DEL  = char($7F);  { -- Delete }
 ASCII_SP   = char($20);  { -- Space }
 ASCII_NBSP = char($A0);  { -- NO-BREAK SPACE }
 { another magic chars }
 ASCII_TAB  = ASCII_HT;   { Horizontal Tabulation, synonym }
 ASCII_XON  = ASCII_DC1;  { Uses for RS-232 software flow control }
 ASCII_XOFF = ASCII_DC3;  { Uses for RS-232 software flow control }
 NBSP       = ASCII_NBSP; { NO-BREAK SPACE }
// CR         = ASCII_CR;   { Carriage Return }
// LF         = ASCII_LF;   { Line Feed }
// FF         = ASCII_FF;   { Form Feed }
// TAB        = ASCII_HT;   { Tabulator }
 CRLF       = #13#10;     { DOS & Win line break }
 QuoteMark  = '"';        { "Quotation Mark" as defined in Unicode also known as "quote marks" }
 Apostrophe = '''';       { "Apostrophe"     as defined in Unicode also known as "apostrophe-quote" , "apl quote" }

const
 JustSpaces = [#0..' '];  { Uses by Trim, IsEmptyStr etc. }
 JustBlanks = [ASCII_HT,' ']; { Space chars uses as blank }
 EolnDelims = [ASCII_CR,ASCII_LF]; { EndOfLine delimiters }

const
 MaxSizeInt  = High(SizeInt);
 MaxSizeUInt = High(SizeUInt);

 {
 ********************************
 String Ansi/Wide type conversion
 ********************************
 }

 { Convert String to WideString. }
function StrToWide(const s:String):WideString;

 { Convert WideString to String. }
function WideToStr(const s:WideString):String;

 { Convert Ansi string to Oem on Windows. }
function StrAnsiToOem(const AnsiStr:LongString):LongString;

{ Convert Oem string to Ansi on Windows. }
function StrOemToAnsi(const OemStr:LongString):LongString;

 {
 ***********************
 NULL-terminated strings
 ***********************
 This version not fast, but very safety.
 }

 { StrLen returns the number of characters in Str, not counting the null terminator. }
function  StrLen(Str: PChar): SizeInt;

 { StrLLen returns StrLen or MaxLen, if Strlen(Str) > MaxLen }
function  StrLLen(Str: PChar; MaxLen: SizeInt): SizeInt;

 { StrEnd returns a pointer to the null character that terminates Str. }
function  StrEnd(Str: PChar): PChar;

 { StrCopy copies Source to Dest and returns Dest. }
function  StrCopy(Dest, Source: PChar): PChar;

 { StrECopy copies Source to Dest and returns StrEnd(Dest). }
function  StrECopy(Dest, Source: PChar): PChar;

 { StrLCopy copies at most MaxLen characters from Source to Dest and returns Dest. }
function  StrLCopy(Dest, Source: PChar; MaxLen: SizeInt): PChar;

 { StrPCopy copies the Pascal style string Source into Dest and returns Dest. }
function  StrPCopy(Dest: PChar; const Source: LongString): PChar;

 { StrPLCopy copies at most MaxLen characters from Source to Dest and returns Dest. }
function  StrPLCopy(Dest: PChar; const Source: LongString; MaxLen: SizeInt): PChar;

 { StrCat appends a copy of Source to the end of Dest and returns Dest. }
function  StrCat(Dest, Source: PChar): PChar;

 { StrPCat appends a copy of Source string to the end of Dest and returns Dest. }
function  StrPCat(Dest:PChar; const Source: LongString): PChar;

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

 {
 StrComp compares Str1 to Str2. The return value is less than
 0 if Str1 < Str2, 0 if Str1 = Str2, or greater than 0 if
 Str1 > Str2.
 }
function  StrComp(Str1, Str2: PChar): Integer;

 {
 StrIComp compares Str1 to Str2, without case sensitivity. The
  return value is the same as StrComp.
 }
function  StrIComp(Str1, Str2: PChar): Integer;

 {
 StrLComp compares Str1 to Str2, for a maximum length of
 MaxLen characters. The return value is the same as StrComp.
 }
function  StrLComp(Str1, Str2: PChar; MaxLen: SizeInt): Integer;

 {
 StrLIComp compares Str1 to Str2, for a maximum length of
 MaxLen characters, without case sensitivity. The return value
 is the same as StrComp.
 }
function  StrLIComp(Str1, Str2: PChar; MaxLen: SizeInt): Integer;

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

 {
 StrIScan returns a pointer to the first occurrence of Chr in Str,
 without case sensitivity. If Chr does not occur in Str, returns NIL.
 The null terminator is considered to be part of the string.
 }
function  StrIScan(Str: PChar; Chr: Char): PChar;

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

 {
 StrRIScan returns a pointer to the last occurrence of Chr in Str,
 without case sensititity. If Chr does not occur in Str, returns NIL.
 The null terminator is considered to be part of the string.
 }
function  StrRIScan(Str: PChar; Chr: Char): PChar;

 { StrUpper converts Str to upper case and returns Str. }
function  StrUpper(Str: PChar): PChar;

 { StrLower converts Str to lower case and returns Str. }
function  StrLower(Str: PChar): PChar;

 {
 StrPos returns a pointer to the first occurrence of Str2 in Str1.
 If Str2 does not occur in Str1, StrPos returns NIL.
 }
function  StrPos(Str1, Str2: PChar): PChar;

 {
 StrIPos returns a pointer to the first occurrence of Str2 in Str1,
 without case sensitivity. If Str2 does not occur in Str1, returns NIL.
 }
function  StrIPos(Str1, Str2: PChar): PChar;

 { StrPas converts Str to a Pascal style string. }
function  StrPas(Str:PChar):LongString;

 { pass lead symbols from PassChars set }
function  StrPass(Str:PChar; const PassChars:TCharSet):PChar;

 { StrMove copies exactly Count characters from Source to Dest and returns Dest. Source and Dest may overlap. }
function  StrMove(Dest, Source: PChar; Count: SizeInt): PChar;

 { Number of lines in text = Number of CR,LF,CRLF,LFCR delimers plus 1 in next Count chars }
function  GetTextNumLines(Text:LongString; UnixStyle:Boolean=false): SizeInt; overload;
function  GetTextNumLines(Text:PChar; Count:SizeInt=MaxSizeInt; UnixStyle:Boolean=false): SizeInt; overload;

 { Case insensitive version of Pos }
function PosI(const Sub:LongString; const Str:LongString):SizeInt;

 { Return 0-based position of substring (Sub) in string (Str) starting from 0-based Offset or return -1 }
function PosEx(Sub:PChar; SubLen:SizeInt; Str:PChar; StrLen:SizeInt; Offset:SizeInt):SizeInt; overload;

 { Return 1-based position of substring (Sub) in string (Str) starting from 1-based StartPos or return 0 }
function PosEx(const Sub,Str:LongString; StartPos:SizeInt):SizeInt; overload;

 { Return last position of substring (Sub) in string (Str) or return 0 }
function LastPos(const Sub,Str:LongString):SizeInt;

 { Return counter of substrings (sub) in string (str) or 0. }
function CountPos(const Sub,Str:LongString):SizeInt;

 { Return N-th position of substrings (sub) in string (str) or 0. }
function NthPos(const Sub,Str:LongString; n:SizeInt):SizeInt;

 { Return position (1-based) of CR or LF or zero if one not found. }
function PosEol(Buf:LongString; Start:SizeInt=1; SkipLines:SizeInt=0):SizeInt; overload;
function PosEol(Buf:PChar; Count:SizeInt; Start:SizeInt=1; SkipLines:SizeInt=0):SizeInt; overload;

 {
 String Line iterator - to be called for all lines of EOL delimited text.
 }
type                                           // String line iterator callback
 TStringLineIterator=function(n:SizeInt;       // Line number, starting from 0
                              Line:LongString; // Line to be processed
                              Custom:Pointer   // User custom data
                              ):Boolean;       // TRUE=Continue, FALSE=Break

 {
 Handle EOL delimited text (StringLines) line by line: call Iterator for each
 line of text. User defined data (Custom) can be used to implement iterations.
 Iterator have to return TRUE to proceed iterations or FALSE to terminate.
 Return number of lines processed (number of succeed Iterator calls).
 }
function ForEachStringLine(const StringLines:LongString; // Text lines to handle
                           Iterator:TStringLineIterator; // Per line iterator
                           Custom:Pointer):SizeInt;      // Custom user data

 {
 *******************************
 Alphabets for string conversion
 *******************************
 }
const
 Abc_Hex_Table  = '0123456789ABCDEF';                  { to convert numerical to string  }
 Abc_Latin_Up   = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';        { Latin   upper alphabet, All     }
 Abc_Latin_Lo   = 'abcdefghijklmnopqrstuvwxyz';        { Latin   lower alphabet, All     }
 Abc_Eng_Up     = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';        { English upper alphabet, All     }
 Abc_Eng_Lo     = 'abcdefghijklmnopqrstuvwxyz';        { English lower alphabet, All     }
 Abc_RusWin_Up  = #$C0#$C1#$C2#$C3#$C4#$C5#$A8#$C6#$C7 { Russian upper alphabet, CP_1251 }
                + #$C8#$C9#$CA#$CB#$CC#$CD#$CE#$CF#$D0
                + #$D1#$D2#$D3#$D4#$D5#$D6#$D7#$D8#$D9
                + #$DA#$DB#$DC#$DD#$DE#$DF;
 Abc_RusWin_Lo  = #$E0#$E1#$E2#$E3#$E4#$E5#$B8#$E6#$E7 { Russian lower alphabet, CP_1251 }
                + #$E8#$E9#$EA#$EB#$EC#$ED#$EE#$EF#$F0
                + #$F1#$F2#$F3#$F4#$F5#$F6#$F7#$F8#$F9
                + #$FA#$FB#$FC#$FD#$FE#$FF;
 Abc_RusDos_Up  = #$80#$81#$82#$83#$84#$85#$F0#$86#$87 { Russian upper alphabet, CP_866  }
                + #$88#$89#$8A#$8B#$8C#$8D#$8E#$8F#$90
                + #$91#$92#$93#$94#$95#$96#$97#$98#$99
                + #$9A#$9B#$9C#$9D#$9E#$9F;
Abc_RusDos_Lo   = #$A0#$A1#$A2#$A3#$A4#$A5#$F1#$A6#$A7 { Russian lower alphabet, CP_866  }
                + #$A8#$A9#$AA#$AB#$AC#$AD#$AE#$AF#$E0
                + #$E1#$E2#$E3#$E4#$E5#$E6#$E7#$E8#$E9
                + #$EA#$EB#$EC#$ED#$EE#$EF;

 {
 #128..#255 chars table to convert chars from one codepage to another
 Win     = codepage 1251, default for Russian Windows ( and for CRW32 )
 DOS     = codepage 866,  default for Russian DOS     ( and for CRW16 )
 Koi     = KOI8,          default for very old Unix   ( no other info )
 }
const
 Abc_RusWin = #$80#$81#$82#$83#$84#$85#$86#$87#$88#$89#$8A#$8B#$8C#$8D#$8E#$8F
            + #$90#$91#$92#$93#$94#$95#$96#$97#$98#$99#$9A#$9B#$9C#$9D#$9E#$9F
            + #$A0#$A1#$A2#$A3#$A4#$A5#$A6#$A7#$A8#$A9#$AA#$AB#$AC#$AD#$AE#$AF
            + #$B0#$B1#$B2#$B3#$B4#$B5#$B6#$B7#$B8#$B9#$BA#$BB#$BC#$BD#$BE#$BF
            + #$C0#$C1#$C2#$C3#$C4#$C5#$C6#$C7#$C8#$C9#$CA#$CB#$CC#$CD#$CE#$CF
            + #$D0#$D1#$D2#$D3#$D4#$D5#$D6#$D7#$D8#$D9#$DA#$DB#$DC#$DD#$DE#$DF
            + #$E0#$E1#$E2#$E3#$E4#$E5#$E6#$E7#$E8#$E9#$EA#$EB#$EC#$ED#$EE#$EF
            + #$F0#$F1#$F2#$F3#$F4#$F5#$F6#$F7#$F8#$F9#$FA#$FB#$FC#$FD#$FE#$FF;
 Abc_RusDos = #$B0#$B1#$B2#$B3#$B4#$B5#$B6#$B7#$B8#$B9#$BA#$BB#$BC#$BD#$BE#$BF
            + #$C0#$C1#$C2#$C3#$C4#$C5#$C6#$C7#$C8#$C9#$CA#$CB#$CC#$CD#$CE#$CF
            + #$D0#$D1#$D2#$D3#$D4#$D5#$D6#$D7#$F0#$D9#$DA#$DB#$DC#$DD#$DE#$DF
            + #$D8#$F8#$F2#$F3#$F4#$F5#$F6#$F7#$F1#$FC#$FA#$FB#$F9#$FD#$FE#$FF
            + #$80#$81#$82#$83#$84#$85#$86#$87#$88#$89#$8A#$8B#$8C#$8D#$8E#$8F
            + #$90#$91#$92#$93#$94#$95#$96#$97#$98#$99#$9A#$9B#$9C#$9D#$9E#$9F
            + #$A0#$A1#$A2#$A3#$A4#$A5#$A6#$A7#$A8#$A9#$AA#$AB#$AC#$AD#$AE#$AF
            + #$E0#$E1#$E2#$E3#$E4#$E5#$E6#$E7#$E8#$E9#$EA#$EB#$EC#$ED#$EE#$EF;
 Abc_RusKoi = #$80#$81#$82#$83#$84#$85#$86#$87#$88#$89#$3F#$8B#$8C#$8D#$8E#$8F
            + #$90#$91#$92#$93#$94#$95#$96#$97#$98#$99#$3F#$3F#$9C#$9D#$3F#$9F
            + #$3F#$A1#$A2#$3F#$A4#$A5#$A6#$A7#$B3#$3F#$AA#$AB#$AC#$AD#$AE#$AF
            + #$A8#$3F#$B2#$B1#$B4#$3F#$B6#$3F#$A3#$BC#$3F#$BB#$3F#$BD#$BE#$3F
            + #$E1#$E2#$F7#$E7#$E4#$E5#$F6#$FA#$E9#$EA#$EB#$EC#$ED#$EE#$EF#$F0
            + #$F2#$F3#$F4#$F5#$E6#$E8#$E3#$FE#$FB#$FD#$FF#$F9#$F8#$FC#$E0#$F1
            + #$C1#$C2#$D7#$C7#$C4#$C5#$D6#$DA#$C9#$CA#$CB#$CC#$CD#$CE#$CF#$D0
            + #$D2#$D3#$D4#$D5#$C6#$C8#$C3#$DE#$DB#$DD#$DF#$D9#$D8#$DC#$C0#$D1;

 {
 ***********************
 String case conversion.
 ***********************
 }
type
 TCharTable = packed array[Char] of Char;   { Table to convert char to char }

var
 LoCaseTable : TCharTable; { Table uses to lower case conversion, Win }
 UpCaseTable : TCharTable; { Table uses to upper case conversion, Win }

 { Setup char conversion table }
procedure SetupCharTable(var T: TCharTable; const s,d:LongString);

 { Setup case conversion table LoCaseTable, UpCaseTable ... }
procedure SetCaseTable_Latins;
procedure SetCaseTable_NoCase;
procedure SetCaseTable_Default;
procedure SetCaseTable_EngDos;
procedure SetCaseTable_EngWin;
procedure SetCaseTable_RusDos;
procedure SetCaseTable_RusWin;

 { Uppercase character, uses UpCaseTable }
function  UpCase(c:Char):Char;

 { Lowercase character, uses LoCaseTable }
function  LoCase(c:Char):Char;

 { Convert string to lower case, uses UpCaseTable }
function  LoCaseStr(const S:LongString):LongString;

 { Convert string to upper case, uses UpCaseTable }
function  UpCaseStr(const S:LongString):LongString;

 { Compare chars without case sensivity }
function IsSameChar(C1,C2:Char):Boolean;

 { Compare strings with case sensivity }
function IsSameStr(S1,S2:LongString):Boolean;

 { Compare strings without case sensivity }
function IsSameText(const S1,S2:LongString):Boolean;

 {
 **************************
 String codepage conversion
 **************************
 Win     = codepage 1251, default for Russian Windows ( and for CRW32 )
 DOS     = codepage 866,  default for Russian DOS     ( and for CRW16 )
 Koi     = KOI8,          default for Unix            ( no other info )
 }
var
 WinToDosTable : TCharTable;
 DosToWinTable : TCharTable;
 WinToKoiTable : TCharTable;
 KoiToWinTable : TCharTable;

function  WinToDos(c:Char):Char;
function  DosToWin(c:Char):Char;
function  WinToDosStr(const S:LongString):LongString;
function  DosToWinStr(const S:LongString):LongString;
function  WinToKoi(c:Char):Char;
function  KoiToWin(c:Char):Char;
function  WinToKoiStr(const S:LongString):LongString;
function  KoiToWinStr(const S:LongString):LongString;

 {
 ***********************************
 General purpose string manipulation
 ***********************************
 }

 { Protected version of sysutils.Format }
function Format(const Fmt:LongString; const Args: array of const):LongString;

 { Create set of chars presents in S }
function  Str2CharSet(const S:LongString):TCharSet;

 { Create string of chars presents in S }
function  CharSet2Str(const S:TCharSet):LongString;

 { Copy string tail starting from pos }
function TailStr(const S:LongString; Pos:SizeInt):LongString;

 { Copy rightmost Count chars }
function  RightStr(const S:LongString; Count:SizeInt):LongString;
function  StrRight(const S:LongString; Count:SizeInt):LongString;

 { Copy leftmost Count chars }
function  LeftStr(const S:LongString; Count:SizeInt):LongString;
function  StrLeft(const S:LongString; Count:SizeInt):LongString;

 { String left  part ahead of delimeter or empty string. }
function StrAheadOf(const S:LongString; Delim:Char):LongString;

 { String right part after of delimeter or original str. }
function StrAfterOf(const S:LongString; Delim:Char):LongString;

 { Return a string of Len chars filled with Ch }
function  CharStr(Len:SizeInt; Ch:Char=' '):LongString;

 { Return a string right-padded to length Len with Ch, blank by default }
function  Pad(const S:LongString; Len:SizeInt; Ch:Char=' '):LongString;
function  RightPad(const S:LongString; Len:SizeInt; Ch:Char=' '):LongString;

 { Return a string left-padded to length len with ch, blank by default }
function  LeftPad(const S:LongString; Len:SizeInt; Ch:Char=' '):LongString;

 { Return a string centered in a string of Ch with specified width}
function  CenterPad(const S:LongString; Width:SizeInt; Ch:Char=' '):LongString;
function  CenterStr(const S:LongString; Width:SizeInt; Ch:Char=' '):LongString;

 { Return a string with leading chars removed }
function  TrimLeadChars(const S:LongString; const TrimChars:TCharSet):LongString;
function  TrimLeftChars(const S:LongString; const TrimChars:TCharSet):LongString;

 { Return a string with trailing chars removed }
function  TrimTrailChars(const S:LongString; const TrimChars:TCharSet):LongString;
function  TrimRightChars(const S:LongString; const TrimChars:TCharSet):LongString;

 { Return a string with leading and trailing chars removed }
function  TrimChars(const S:LongString; const LeadTrim,TrailTrim:TCharSet):LongString;

 { Return a string with leading [#0..' '] white space removed }
function  TrimLead(const S:LongString):LongString;

 { Return a string with trailing [#0..' '] white space removed }
function  TrimTrail(const S:LongString):LongString;

 { Return a string with leading and trailing [#0..' '] white space removed }
function  Trim(const S:LongString):LongString;

 { Return Trim(S) or Def if result is empty. }
function TrimDef(const S,Def:LongString):LongString;

 { Sort text lines with given comparator or use default sort. }
function SortTextLines(const aTextLines:LongString;
                             Comparator:TStringListSortCompare=nil):LongString;

 {
 Constants uses by UnifyAlias,UnifyFileAlias
 }
const
 ua_None    = $0000;             // No conversions
 ua_Upper   = $0001;             // Convert to upper
 ua_Lower   = $0002;             // Convert to lower
 ua_TrimL   = $0004;             // Trim Left
 ua_TrimR   = $0008;             // Trim Right
 ua_DirSep  = $0010;             // Convert directory separators - / or \
 ua_FExpand = $0020;             // Apply FExpand
 ua_NameDef = $0100;             // Use default for names
 ua_FileDef = $0200;             // Use default for files
 ua_SectDef = $0400;             // Use default for sections
 ua_Trim    = ua_TrimL+ua_TrimR; // Trim Left and Right
 ua_Case    = ua_Upper+ua_Lower; // Mask for Up/Lo case
 ua_ModeDef = ua_NameDef+ua_FileDef+ua_SectDef;
 UnifyAliasDefMode     : Integer = ua_Trim+ua_Upper;
 UnifyFileAliasDefMode : Integer = ua_Trim+ua_Upper+ua_DirSep+ua_FExpand;
 UnifySectionDefMode   : Integer = ua_Trim+ua_Upper;

 {
 This function uses to unify names, including register conversion and trimming.
 This function uses to be sure, that equivalent names is really equals.
 For example, two strings " one " and "One" is equivalent, but different.
 After unify operation, both names are "ONE".
 In current realization UnifyAlias(Name) equivalent to UpcaseStr(Trim(Name)).
 }
function  UnifyAlias(const Name:LongString; Mode:Integer=ua_NameDef):LongString;

 {
 This function uses to unify file names, including register conversion, trimming,
 and full file path conversion for files. This function uses to be sure,
 for example, that equivalent file names is really equals. For example, two files
 "c:\daq\1110\config\1110.cfg" and "C:\DAQ\1110\DATA\..\CONFIG\1110.CFG"
 is equivalent, but different. After unify operation, both files are
 "C:\DAQ\1110\CONFIG\1110.CFG".
 In current realization UnifyFileAlias(FileName) equivalent to UpcaseStr(Trim(FExpand(Name))).
 }
function  UnifyFileAlias(const FileName:LongString; Mode:Integer=ua_FileDef):LongString;

 { Compare file names }
function IsSameFileName(const S1,S2:LongString; Mode:Integer=ua_FileDef):Boolean;

 {
 Example:
  UnifySection('Section')   = '[Section]'
  UnifySection('[Section')  = '[Section]'
  UnifySection('Section]')  = '[Section]'
  UnifySection('[Section]') = '[Section]'
 }
function UnifySection(const aSectionName:LongString; Mode:Integer=ua_SectDef):LongString;

 {
 Check if string aName looks like section name, i.e. [..] or not.
 }
function IsSectionName(const aName:LongString):Boolean;

 {
 StrFetch(s,i) is safe analog of s[i]. Return #0 if index (i) out of range.
 }
function StrFetch(const s:LongString; i:SizeInt):Char;

 {
 Extract first quoted phrase from string (s). First char should be quote (q).
 Example: AnsiDeQuotedStr('"One two" three four','"') -> 'One two'
 }
function AnsiDeQuotedStr(const s:LongString; q:Char):LongString;

 {
 Skip first quoted phrase from string (s). First char should be quote (q).
 Example: AnsiDeQuotedStr('"One two" three four','"') -> ' three four'
 }
function AnsiSkipQuotedStr(const s:LongString; q:Char):LongString;

 {
 Example:
 RemoveBrackets('[System]')='System'
 }
function RemoveBrackets(const s:LongString; const Brackets:LongString='[]'):LongString;

 {
 Functions for command line parsing.
 ExtractFirstParam extract parameter (may be quoted). Result is first parameter as unquoted string.
 SkipFirstParam skip first parameter (may be quoted). Result is string tail after first parameter removed.
 AnsiQuotedIfNeed apply quotes if needed only (if string includes spaces).
 IsOption check if argument (arg) looks like option (-a,/a,--all etc).
 GetOptionValue extract value (after = char) from option  (like -name=value).
 HasOptionValue check if argument is an option with value (like -name=value)
 Examples:
 if IsOption(arg,'-a','--all') then ApplyOption('-a');
 if IsOption(arg,'--filename') then filename:=GetOptionValue(arg);
 }
const    CmdOptionChars = ['-','/']; // Chars which uses for command options like -a or /a
const    om_NoSlash     = 1;         // Option mode flag disable slash char in options (as Linix does)
const    om_UseCase     = 2;         // Option mode flag to use case sensitive compare (as Linux does)
{$IFDEF WINDOWS}
const    om_Default     = 0;         // Option mode uses by default (Windows).
{$ELSE}
const    om_Default     = 3;         // Option mode uses by default (Unix).
{$ENDIF}
function ExtractFirstParam(const s:LongString; quote:Char=QuoteMark; const Spaces:TCharSet=JustSpaces):LongString;
function SkipFirstParam(const s:LongString; quote:Char=QuoteMark; const Spaces:TCharSet=JustSpaces):LongString;
function AnsiQuotedIfNeed(const s:LongString; quote:Char=QuoteMark; const Spaces:TCharSet=JustSpaces):LongString;
function IsOption(const arg:LongString; const shortopt:LongString=''; const longopt:LongString='';
                  Mode:Integer=om_Default; Delim:Char='='):Boolean;
function GetOptionValue(const arg:LongString; Delim:Char='='):LongString;
function HasOptionValue(const arg:LongString; Delim:Char='='):Boolean;

 {
 Extract (Name,Value) pair from argument (arg) like "Name <Sign> Value".
 Default Sign is "=", so default statement is "Name=Value".
 Mode flags (1,2) uses to Trim result (Name,Value).
 Return position of Sign in arg string.
 }
function ExtractNameValuePair(const arg:LongString; out Name,Value:LongString;
                              const Sign:Char='='; Mode:Integer=3):Integer;

 {
 IsLexeme(arg,typ) check argument string (arg) is lexeme of specified type (typ).
 }
const               // Lexeme POSIX-class     RegExp/Pascal equivalent              Comment
 lex_Ansi    = 0;   // Lexeme is ANSI string  length(s)>0                           any non-zero string (s<>'')
 lex_Utf8    = 1;   // Lexeme is UTF8 string  --                                    any valid UTF8 encoded string
 lex_Name    = 2;   // Lexeme is name,        --                                    [:word:] and not start with digit
 lex_Word    = 3;   // Lexeme [:word:]        [[:alnum:]_]                          word of letters,digits,underscore
 lex_Blank   = 4;   // Lexeme [:blank:]       [ \t]                                 spaces and tabulations
 lex_Space   = 5;   // Lexeme [:space:]       [[:blank:]\v\r\n\f]                   space chars
 lex_Cntrl   = 6;   // Lexeme [:cntrl:]       [\x00-\x1F\x7F]                       control chars
 lex_Alpha   = 7;   // Lexeme [:alpha:]       [[:upper:][:lower:]]                  latin letters
 lex_Lower   = 8;   // Lexeme [:lower:]       [a-z]                                 lower case latin letters
 lex_Upper   = 9;   // Lexeme [:upper:]       [A-Z]                                 upper case latin letters
 lex_Digit   = 10;  // Lexeme [:digit:]       [0-9]                                 digits
 lex_Alnum   = 11;  // Lexeme [:alnum:]       [[:alpha:][:digit:]]                  letters,digits
 lex_xDigit  = 12;  // Lexeme [:xdigit:]      [[:digit:]A-Fa-f]                     hexadecimal digits
 lex_Punct   = 13;  // Lexeme [:punct:]       [!"#$%&'()*+,-./:;<=>?@[\\\]_`{|}~]   punctuation
 lex_Print   = 14;  // Lexeme [:print:]       [\x20-\x7E], i.e. [[:graph:] ]        printable chars with space
 lex_Graph   = 15;  // Lexeme [:graph:]       [\x21-\x7E]                           printable chars
 lex_Ascii   = 16;  // Lexeme [:ascii:]       [\x00-\x7F]                           ASCII characters
 lex_iParam  = 17;  // Lexeme is Integer      $hex or decimal integer               valid integer parameter
 lex_fParam  = 18;  // Lexeme is Float        float value                           valid float   parameter
 lex_sParam  = 19;  // Lexeme is String       "string param" or StringParam         valid string  parameter
 lex_Base64  = 20;  // Lexeme is Base64       [0-9A-Za-z\+/=]*                      valid Base64 data string
 lex_FsmName = 21;  // Lexeme is FSM name                                           name with [&:-] allowed
 lex_SmiName = 22;  // Lexeme is SMI name                                           name compatible with SMI
 lex_DimName = 23;  // Lexeme is DIM name                                           name compatible with DIM
 lex_SqlName = 24;  // Lexeme is SQL name     [a-zA-Z][0-9_a-zA-Z]*                 name compatible with SQL GOST R ISO/MEK 9075-93
 lex_Fbdname = 25;  // ---- Fireberd name     [a-zA-Z][0-9_\$a-zA-Z]*               name compatible with SQL Firebird
 lex_Section = 26;  // ---- Section name      [\[][^[:cntrl:]]*[\]]                 [Section Name]
 lex_AtCall  = 27;  // ---- @Command          [@][^[:cntrl:] ]                      Call of @Command ... (fast short  test)
 lex_AtCmnd  = 28;  // ---- @Command          [@][\t^[:cntrl:]]+                    Text of @Command ... (more strict test)

const // Uses regexp_test for regular expressions with IsLexeme
 lex_regexp_test : function(rex:Integer; arg:LongString):Boolean = nil;

function IsLexeme(arg:PChar; leng:SizeInt; typ:Integer):Boolean; overload;
function IsLexeme(arg:LongString; typ:Integer):Boolean; overload;

 { Wrap InSt at Margin, storing the result in OutSt and the remainder in Overlap }
procedure WordWrap(const InSt:LongString; var OutSt, Overlap:LongString;
                     Margin:SizeInt; PadToMargin:Boolean);

 { Return string Str with substrings Find replaced by Replace }
function ReplaceString(Str:LongString; const Find,Replace:LongString;
                       Flags:TReplaceFlags=[rfReplaceAll]):LongString;

 { Replace ^L,^R,^C,^N,^B <--> '^L','^R','^C','^N','^B'  }
function ReplaceAlignStr(const Str:LongString; Invert:Boolean):LongString;

 {
 Validate EOL (LF,CR,CRLF) text line delimiters.
 Also add/remove tail EOL if Tail flag equals +1/-1.
 }
function ValidateEOL(const aData:LongString; aTail:Integer=0; aEOL:LongString=EOL):LongString;
function ValidateCRLF(const aData:LongString; aTail:Integer=0; aEOL:LongString=CRLF):LongString;

 {
 *******************
 String word parsing
 *******************
 }

 { This set uses as spases for word parsing }
const
 ScanSpaces : TCharSet = [' ',ASCII_TAB,ASCII_CR,ASCII_LF,',',';','='];

 { Given a set of word delimiters, return number of words in S }
function  WordCount(const S:LongString; const WordDelims:TCharSet):Integer;

 { Given a set of word delimiters, return the N'th word in S }
function  ExtractWord(N:Integer; const S:LongString; const WordDelims:TCharSet):LongString;

 { Skip N words, lead spaces and return tail of S }
function SkipWords(n:Integer; const s:LongString; const ScanSpaces:TCharSet):LongString;

 { Return zero or order number of word Name in string Str }
function  WordIndex(const Name,Str:LongString; const Delims:TCharSet; CaseSensitive:Boolean=false):Integer;

 { Extract word and convert to integer }
function  ExtractInt(N:Integer; const S:LongString; const WordDelims:TCharSet; var Value:LongInt):Boolean;

 { Extract word and convert to double }
function  ExtractReal(N:Integer; const S:LongString; const WordDelims:TCharSet; var Value:Double):Boolean;

 {
 ****************************
 Numeric to string conversion
 ****************************
 }
function  BinB(x:Byte):LongString;     { Return binary string for byte }
function  BinW(x:Word):LongString;     { Return binary string for word }
function  BinL(x:LongWord):LongString; { Return binary string for long word }
function  OctB(x:Byte):LongString;     { Return octal string for byte }
function  OctW(x:Word):LongString;     { Return octal string for word }
function  OctL(x:LongInt):LongString;  { Return octal string for longint }
function  HexB(x:Byte):LongString;     { Return hex string for byte }
function  HexW(x:Word):LongString;     { Return hex string for word }
function  HexL(x:LongWord):LongString; { Return hex string for long word }

 { Convert long integer to string }
function  Long2Str(L:LongInt):LongString;

 { Convert double to string with given fixed float point format }
function  Real2Str(R:Double; Width:Integer=0; Places:Integer=0):LongString;

  { Return decimal string for longint }
function  d2s(d:LongInt; Width:Integer=0):LongString;

  { Return float point value, use format given by f2sFormat }
function  f2s(f:Double):LongString;

const
 f2sWidthDefault  = 0;
 f2sDigitsDefault = 14;

procedure f2sFormat(Width:Integer=f2sWidthDefault; Decimals:Integer=f2sDigitsDefault);
procedure f2sFormatOld;

 {
 Float point value in "free" format, similar to format('%w.dG',[X])
 w is string width
 d is number of digits after point
 exponent dropped if possible
 }
function  FormatG(X:Double; w:Integer; d:Integer):LongString;

 {
 ****************************
 String to Numeric conversion
 ****************************
 }

 { Convert string "a" to integer value "i". If first symbol is $, convert as hex-value. }
function  atoi(a:PChar; out i:LongInt):Boolean;

 { Convert string "a" to real value "f". if first symbol is $, convert as hex-value. }
function  atof(a:PChar; out f:Double):Boolean;

 { Convert a string to an integer, returning true if successful }
function  Str2Int(const S:LongString; out I:Integer):Boolean;

 { Convert a string to a word, returning true if successful }
function  Str2Word(const S:LongString; out I:Word):Boolean;

 { Convert a string to an longint, returning true if successful }
function  Str2Long(const S:LongString; out I:LongInt):Boolean;

 { Convert a string to a real, returning true if successful }
function  Str2Real(const S:LongString; out R:Double):Boolean;

 { Convert a string to real, check if value changed }
function SmartStr2Real(const S:LongString; var R:Double):Boolean;

 { Convert a string to integer with default value on error }
function iValDef(const S:LongString; Def:Integer):Integer;

 { Convert a string to integer with default 0 on error }
function iVal(const S:LongString):Integer;

 { Convert a string to real with default value on error }
function rValDef(const S:LongString; Def:Double):Double;

 { Convert a string to real with default _NAN on error }
function rVal(const S:LongString):Double;

 { Convert a Binary-string to an longint, returning true if successful }
function  StrBin2Long(const S:LongString; out L:LongInt):Boolean;

 { Convert a Octal-string to an longint, returning true if successful }
function  StrOct2Long(const S:LongString; out L:LongInt):Boolean;

 { Convert a Hex-string to an longint, returning true if successful }
function  StrHex2Long(const S:LongString; out L:LongInt):Boolean;

 {
 Форматное чтение переменных с префиксом для идентификации.
 Формат состоит из слов,разделенных символом CR или ; типа
 prefix1%format1+CR+
 prefix2%format2+CR+
 ....
 prefixN%formatN
 Префикс-строка для поиска в тексте (может отсутствовать)
 Форматы должны быть одной из указанных строк:
  %s - чтение ShortString(Data) после префикса до символа CR,LF или конца строки,
       но не более 255 символов
  %a - чтение ShortString(Data) после префикса и пробелов слова,содержащего
       символы, отличные от пробелов (ScanSpaces), но не более 255 символов
  %d - чтение LongInt(Data) после префикса и пробелов
  %w - чтение Word
  %i - чтение Integer
  %b - чтение Boolean (0,1,False,True,Yes,No-по первой букве)
  %f - чтение Double(Data) после префикса и пробелов
  %c - чтение Char(Data) сразу после префикса
 ScanVar возвращает указатель на символ после последней прочтенной
 переменной в тексте или nil в случае:
  если не найден префикс поиска в тексте ( если он был в формате)
  если не найден ни один из форматов %s,%f,%d,%c,%a,%w,%i,%b
  в строке формата
 пример:
  var
   Data:record S:ShortString; D:LongInt; F:Double; C:Char end;
  const
   InputStr='Найти Var1=Cтрока'+CR+
            '      Var2= 100'+CR+
            '      Var3= -3.14'+CR+
            '      Var4=&';
   begin
    if ScanVar(svAsIs,InputStr,'Var1=%s'+CR+
                               'Var2=%d'+CR+
                               'Var3=%f'+CR+
                               'Var4=%c',Data)=nil then error;
  результат:
   Data.S='Строка';
   Data.D=100;
   Data.F:=-3.14;
   Data.C='&';
 Режим чтения задает способ выделения переменной
 svUpCase/svLoCase
  Переводят строку формата в верхний/нижний регистр и нужны для того чтобы
  переменные читались независимо от регистра, надо только сам текст тоже
  привести к этому регистру. Например:
   S=StrUpper('SomeVar=1000')
   ScanVar(svUpCase,S,'somevar%d'...    - прочитается
   ScanVar(svNoCase,S,'somevar%d'...    - не прочитается, разные регистры
 svLSpace/svRSpace
  Анализируют наличие пробелов слева/справа от выделенного префикса, чтобы
  одинаковые фрагменты слов не приводили к ошибочному чтению.
  Например, в строке
   S='Var10 = 1, Var1 = 10'
  фрагмент Var1 - общий для обеих переменных, тогда
   ScanVar(0,S,'Var1%s'... прочитает 0, так как воспримет в качестве
   префикса вхождение Var1 в строку Var10
   ScanVar(svRSpace+svLSpace прочитает правильно, так как выделит только
   цельное слово Var1 (так чтобы слева и справа от слова были пробелы)
  В то же время в конструкции S='Sin(10)' надо читать
  ScanVar(0,'Sin(%f'... , а не ScanVar(svRSpace,'Sin(%f'...
  так как значение идет сразу после префикса без пробела
 svOrigin
  начинает поиск каждого префикса с начала текста, чтобы чтение переменных
  не зависело от их порядка, например
  если S='Var2 = 1, Var1 = 2', то
       ScanVar(0,'Var1%d;Var2%d' - не прочитает так как Var1 - после Var2
       ScanVar(svOrigin,'Var1%d;Var2%d'- прочитает
  в то же время для жестких конструкций svOrigin не пригоден, например
  если S='Var = 1 , 2, 3, 4', то надо читать ScanVar(0,'Var%w;,%w;,%w;,%w
  так как при чтении ScanVar(svOrigin,.... вместо 3, 4 будет прочитано
  2, 2 - число после ПЕРВОЙ запятой в тексте
  Отметим, что пустой префикс не ведет переходу на начало текста то есть
  в предыдущем примере можно читать ScanVar(0,'Var%w;%w;%w;%w'....
 !!!!!!
 БУДЬТЕ ВНИМАТЕЛЬНЫ С ВЫБОРОМ РЕЖИМА
 !!!!!!
 }
function  ScanVar(svMode:Cardinal; Str:PChar; const Format:LongString; var Data):PChar;

 { ScanVar svMode flags }
const                               { svMode parameter flags }
 svNoCase      = 0;                 { no case conversion of Format }
 svUpCase      = $0001;             { convert Format to upper case }
 svLoCase      = $0002;             { convert Format to lower case }
 svCaseMask    = svUpCase+svLoCase;
 svLSpace      = $0004;             { check : space chars presents before prefix ?}
 svRSpace      = $0008;             { check : space chars presents after  prefix ?}
 svSpaces      = svLSpace+svRSpace;
 svOrigin      = $0010;             { each prefix seach from text start }
 svAsIs        = 0;                 { read 'as is, in order' }
 svConfig      = svUpCase+svLSpace+svRSpace+svOrigin;  { standard for ini-files }
 svConfigNC    = svConfig and not svCaseMask;

 { uses as delimers in Format string }
const
 ScanWordDelims:TCharSet=[ASCII_CR,ASCII_LF,';'];

 { uses in words }
const
 WordSet:TCharSet=['_', 'a'..'z', 'A'..'Z', '0'..'9', #$80..#$FF ];

 {
 Scan text buffer (Buff) of maximum size (Size) to search Name=Value expression and return Value.
 Text lines delimeted by CR,LF,NUL or Delim chars. Mode uses to specify Delim char and options.
 Lower byte (bits 0..7) of Mode contains Delim char uses to separate Name=Value exptressions.
 Bits 8..10 uses to set scan options. See csm_XXX constats to study options.
 Bits 16..23 uses to set char marker which returns if expression not found.
 For example: Mode=Ord(';')+csm_Default        - use ";" terminator, case insensitive,trim name and value
              Mode=Ord(';')+(Ord(#13) shl 16)  - use ";" terminator, return CR if expression not found
 Mode bit[0]="case insensitive", bit[1]="Trim name", but[2]="Trim Value"
 Examples: CookieScan('X=1; Y=2','X',Ord(';')) = '1'
           CookieScan('X=1'+EOL+'Y=2','Y') = '2'
 }
const                       // CookieScan Mode flags:
 csm_CaseSense = $00000100; // Name comparison is case sensitive
 csm_SkipTrimN = $00000200; // Don't Trim name before comparison
 csm_SkipTrimV = $00000400; // Don't Trim result Value
 csm_Default   = 0;         // Default is case insensitive, trim name and value

function CookieScan(const Buff,Name:LongString; Mode:Integer=csm_Default):LongString; overload;
function CookieScan(Buff:PChar; Size:SizeInt; const Name:LongString; Mode:Integer=csm_Default):LongString; overload;

 {
 **********************
 Files pathname parsing
 **********************
 }
const
 DirDelimiters  = ['\','/'];      { Separete directories }
 DosDelimiters  = ['\','/',':'];  { Separete directories and drives }

 {
 Is string S contains any non-space chars ? Space chars are [#0..' '].
 Example:  IsEmptyStr(' any ') = false
           IsEmptyStr('     ') = true
 }
function  IsEmptyStr(const S:LongString):Boolean;

 {
 Convert string to set of chars and back.
 }
function StringToSetOfChars(const S:LongString):TCharSet;
function SetOfCharsToString(const S:TCharSet):LongString;

 {
 Return true if string S has chars in C charset.
 }
function HasChars(const S:LongString; const C:TCharSet):Boolean; overload;
function HasChars(const S:LongString; const C:LongString):Boolean; overload;

 {
 Find pos of last delimiter from Delimiters set in string S or zero if none.
 This function similar sysutils.LastDelimers.
 Example: LastDelimiter(['.'],'c:\bp\bin\bpc.exe') = 14
          LastDelimiter(['!'],'c:\bp\bin\bpc.exe') = 0
 }
function  LastDelimiter(const Delimiters:TCharSet; const S:LongString):SizeInt;

 {
 Validate path delimeters ('\' or '/') in given FileName.
 Replace wrong directory delimiters to specified delimiter Delim.
 }
function ValidatePathDelim(const FileName:LongString; Delim:Char=PathDelim):LongString;

 {
 Trim DirName and add a trailing backslash to a directory name, if need.
 Example: AddBackSlash('c:\bp\') = 'c:\bp\'
          AddBackSlash('c:\bp ')  = 'c:\bp\'
 AddPathDelim is new (recommended), AddBackSlash is obsolete.
 }
function  AddBackSlash(const DirName:LongString; Delim:Char=PathDelim):LongString;
function  AddPathDelim(const DirName:LongString; Delim:Char=PathDelim):LongString;

 {
 Trim DirName and remove trailing backslash from a directory name, if need.
 Example: DropBackSlash('c:\bp\') = 'c:\bp'
          DropBackSlash('c:\bp ')  = 'c:\bp'
 DropPathDelim is new (recommended), DropBackSlash is obsolete.
 }
function  DropBackSlash(const DirName:LongString):LongString;
function  DropPathDelim(const DirName:LongString):LongString;

 {
 Is this file a wild card, as *.ext, name.* and so on?
 Example: IsWildcard('c:\bins\*.exe') = true
          IsWildcard('c:\readme.txt') = false
 }
function  IsWildCard(const FileName:LongString):Boolean;

 {
 Is this file path relative or absolute ( as ?:?? or \??? )?
 Example: IsRelativePath('c:\bp\bin\bpc.exe') = false
          IsRelativePath('\bp\bin\bpc.exe') = false
          IsRelativePath('bp\bin\bpc.exe') = true
          IsRelativePath('..\bin\bpc.exe') = true
 }
function  IsRelativePath(const S:LongString):Boolean;

 {
 Return whether and position of extension separator dot in a pathname.
 Example: HasExtension('\binobj\read.me', DotPos) = true, Dotpos = 13
          HasExtension('\bin.obj\readme', DotPos) = false
 }
function  HasExtension(const Name:LongString; out DotPos:SizeInt):Boolean; overload;
function  HasExtension(const Name:LongString):Boolean; overload;

 {
 Return a pathname with the specified extension attached, if yet no extension.
 Extension not change if there are yet extension specified.
 Example: DefaultExtension('\bp\bin\bpc.exe','.bak') = '\bp\bin\bpc.exe'
          DefaultExtension('\bp\bin\bpc',    '.bak') = '\bp\bin\bpc.bak'
 }
function  DefaultExtension(const Name,Ext:LongString):LongString;

 {
 Return a pathname with the specified path attached, if relative path.
 Path not change if there are yet absolute path specified.
 Example: DefaultPath('bin\bpc.exe','c:\bp')  = 'c:\bp\bin\bpc.exe
          DefaultPath('\bin\bpc.exe','c:\bp') = '\bin\bpc.exe
 }
function  DefaultPath(const Name,Path:LongString):LongString;

 {
 Force the specified extension onto the file name, replace existing extension.
 Example: ForceExtension('\bp\bin\bpc.exe','.bak') = '\bp\bin\bpc.bak'
          ForceExtension('\bp\bin\bpc',    '.bak') = '\bp\bin\bpc.bak'
 }
function  ForceExtension(const Name,Ext:LongString):LongString;

 {
 Force the specified path onto the file name, replace existing path.
 Example: ForcePath('c:\bp','\bin\bpc.exe') = 'c:\bp\bpc.exe'
 }
function  ForcePath(const NewPath,Name:LongString):LongString;

 {
 Extract file name without path, but with extension.
 Similar to sysutils.ExtractFileName.
 Example: ExtractFileName('c:\bp\bin\bpc.exe') = 'bpc.exe'
 }
function  ExtractFileNameExt(const FileName: LongString):LongString;

 {
 Extract file name without path and extension.
 Not similar to sysutils.ExtractFileName.
 Example: ExtractFileName('c:\bp\bin\bpc.exe') = 'bpc'
 }
function  ExtractFileName(const FileName: LongString):LongString;
function  ExtractBaseName(const FileName: LongString):LongString;

 {
 Extract file extension with leading dot.
 Example: ExtractFileExt('c:\bp\bin\bpc.exe') = '.exe'
 }
function  ExtractFileExt(const FileName: LongString): LongString;

 {
 Extract file path without trailing backslash, like Delphi's ExtractFileDir.
 Example: ExtractFileDir('c:\bp\bin\bpc.exe')  = 'c:\bp\bin'
 }
function  ExtractFilePath(const FileName: LongString): LongString;
function  ExtractFileDir(const FileName: LongString): LongString;

 {
 Extracts file drive or server path.
 Example: ExtractFileDrive('c:\bp\bin') =  'c:'
          ExtractFileDrive('\\alex\bp\bin') =  '\\alex\bp'
 }
function  ExtractFileDrive(FileName: LongString): LongString;

 {
 Extracts file extension from filter description.
 Example:
  Filter:='text (*.txt)|*.TXT|'+
          'RTF  (*.rtf)|*.RTF|'+
          'DOC  (*.doc)|*.DOC|';
  ExtractFilterExt(Filter,2)='.RTF'
 }
function ExtractFilterExt(const Filter:LongString; Index:Integer):LongString;

 {
 Return a full pathname for given Path. If path is empty then return current dir.
 Allow slash as backslash for Unix-like file names compatibility.
 Example: FExpand('c:\bp\bin\temp\..\x.doc') = 'c:\bp\bin\x.doc'
 }
function  FExpand(const Path:LongString):LongString;

 {
 Return Path with converted to relative path vs Base.
 Also convert file to uppercase and normalize as FExpand.
 Example: MakeRelativePath('c:\bp\rtl\dos\dos.pas','c:\bp\rtl\bin\*.*') = '..\DOS\DOS.PAS'
 }
function  MakeRelativePath(const Path,Base:LongString):LongString;

 {
 Return true only if Path has extension listed in PathExt list.
 For example: if HasListedExtension(FileName,'.exe;.com') then Echo('It`s EXE or COM file.');
 }
function HasListedExtension(const Path,PathExt:LongString; Delim:Char=PathSep; Spaces:TCharSet=JustSpaces):Boolean;

 {
 *******************************************************
 TText, collection of strings. Thread safety and simple.
 *******************************************************
 }
const
 DefaultTTextCapacity = 0;
 DefaultTTextStep     = 1024;

const
 tfl_CaseSens = 1;   // TText.FindLine Mode uses case sensitive
 tfl_Inverted = 2;   // TText.FindLine Mode uses inverted search (find last)
 tfl_TrimLead = 4;   // TText.FindLine Mode uses line trim (drop lead spaces)
 tfl_TrimTail = 8;   // TText.FindLine Mode uses line trim (drop tail spaces)
 tfl_TrimBoth = 4+8; // TText.FindLine Mode uses line trim (drop both spaces)

type
 TTextForEachAction = procedure(Index      : LongInt;
                          const TextLine   : ShortString;
                            var Terminate  : Boolean;
                                CustomData : Pointer );

type
 TText = class(TLatch)
 private
  myItems   : PPointerArray;
  myCount   : LongInt;
  myStep    : LongInt;
  function    GetStep:LongInt;
  procedure   SetStep(NewStep:LongInt);
  function    GetCount:LongInt;
  procedure   SetCount(NewCount:LongInt);
  function    GetCapacity:LongInt;
  procedure   SetCapacity(NewCapacity:LongInt);
  function    GetText:LongString;
  procedure   SetText(const aText:LongString);
 public
  constructor Create(aCapacity : LongInt = DefaultTTextCapacity;
                     aStep     : LongInt = DefaultTTextStep);
  destructor  Destroy; override;
  function    GetLn( NumLn:LongInt ): ShortString;
  procedure   PutLn( NumLn:LongInt; const aLine:ShortString );
  procedure   DelLn( NumLn:LongInt );
  procedure   InsLn( NumLn:LongInt; const aLine:ShortString);
  procedure   AddLn( const aLine:ShortString );
  procedure   ForEach(Action:TTextForEachAction; CustomData:Pointer; Backward:Boolean=false);
  function    MaxLength:LongInt;
  function    MemUsed:LongInt;
  procedure   Concat(aText:TText);
  procedure   Copy(aText:TText);
  procedure   Read(var F:Text);
  function    ReadFile(const aFileName:ShortString; AppendMode:Boolean=false):Integer;
  procedure   Write(var F:Text);
  function    WriteFile(const aFileName:ShortString; AppendMode:Boolean=false):Integer;
  procedure   Echo;
  procedure   UpCase;
  procedure   LoCase;
  procedure   WinToDos;
  procedure   DosToWin;
  procedure   WinToKoi;
  procedure   KoiToWin;
  function    FindLine(aLine:LongString; Mode:Integer=0):Integer;
  function    FindVar(const VarName:ShortString):Integer;
  function    GetVar(const VarName:ShortString):ShortString;
  procedure   SetVar(const VarName:ShortString; const VarValue:ShortString);
  property    Step            : LongInt     read GetStep     write SetStep;
  property    Count           : LongInt     read GetCount    write SetCount;
  property    Capacity        : LongInt     read GetCapacity write SetCapacity;
  property    Text            : LongString  read GetText     write SetText;
  property    Line[i:LongInt] : ShortString read GetLn       write PutLn; default;
 end;

procedure ConcatText(First,Second:TText); overload;
procedure ConcatText(First:TText; const Second:LongString); overload;

function  NewText(aCapacity : LongInt = DefaultTTextCapacity;
                  aStep     : LongInt = DefaultTTextStep):TText;
function  NewTextCopy(aTextToCopy : TText = nil;
                      aCapacity   : LongInt = DefaultTTextCapacity;
                      aStep       : LongInt = DefaultTTextStep):TText;
function  NewTextRead(const aFileName : LongString = '';
                            aCapacity : LongInt = DefaultTTextCapacity;
                            aStep     : LongInt = DefaultTTextStep):TText;
procedure Kill(var TheObject:TText); overload;

 {
 ************************************************************
 String allocation functions and other utilites uses by TText
 ************************************************************
 }
const
 AdjustStrBits = 3; { 0..7 available }

function  AdjustStrSize(const S:ShortString):Integer;
procedure StrSet(var P:PShortString; const S:ShortString);
procedure StrReset(var P:PShortString; const S:ShortString);
procedure StrAssign(var S:ShortString; P:PShortString);

 {
 *******************************************************************************
 Simplified interface for TText
 text_new               - create new text
 text_ref(txt)          - get text object fy reference
 text_free(txt)         - free text       (like txt.Free)
 text_getln(txt,i);     - get line (i)    (like s:=txt[i])
 text_putln(txt,i,s)    - assign line (i) (like txt[i]:=s)
 text_insln(txt,i,s)    - insert line (i) (like Insert(i,s))
 text_addln(txt,s)      - add line to txt (like txt.Addln(s))
 text_delln(txt,i)      - delete  line(i) (like txt.Delete(i))
 text_numln(txt)        - number of lines (like txt.Count)
 text_tostring(txt)     - get text (like s:=txt.Text)
 text_fromstring(txt,s) - set text (like txt.Text:=s) and return reference (txt)
 *******************************************************************************
 }
function text_new:TText;
function text_ref(txt:Integer):TText;
function text_free(txt:Integer):Boolean;
function text_getln(txt:Integer; i:Integer):LongString;
function text_putln(txt:Integer; i:Integer; s:LongString):Boolean;
function text_insln(txt:Integer; i:Integer; s:LongString):Boolean;
function text_addln(txt:Integer; s:LongString):Boolean;
function text_delln(txt:Integer; i:Integer):Boolean;
function text_numln(txt:Integer):Integer;
function text_tostring(txt:Integer):LongString;
function text_fromstring(txt:Integer; s:LongString):Integer;

 {
 **********************************
 Routines for multilanguage support
 **********************************
 }
const
 lng_UNKNOWN = 0;
 lng_ENGLISH = 1;
 lng_RUSSIAN = 2;
 Language : Integer = {$IFDEF RUSSIAN} lng_RUSSIAN; {$ELSE} lng_ENGLISH; {$ENDIF}

function RusEng(const Rus:LongString='';
                const Eng:LongString=''
                ):LongString;

 {
 Gets system error message by error code.
 }
function SysErrorMessage(ErrorCode: Integer): LongString; inline;

 {
 ************
 HTTP and CGI
 ************
 }
const
 UrlAllowChars = [#33..#255]-['%','+',' ',ASCII_TAB,ASCII_CR,ASCII_LF,',',';','='];
 um_Safe          = 1;     // Do not raise exception
 um_StrictSpace   = 2;     // Use %20 instead of + to encode space char
 um_StrictPercent = 4;     // Use %25 instead of %% to encode % char
 um_StrictDecode  = 8;     // Use strict URL decoding
 um_Strict        = um_StrictSpace+um_StrictPercent+um_StrictDecode;

function URL_Packed(const S:LongString; Mode:Integer=um_Safe; const AllowChars:TCharSet=UrlAllowChars):LongString;
function URL_Encode(const S:LongString; Mode:Integer=um_Safe+um_Strict; const AllowChars:TCharSet=[]):LongString;
function URL_Decode(const S:LongString; Mode:Integer=um_Safe):LongString;
function HTTP_StatusMessage(StatusCode:Integer):LongString;

 // Sanity test to check functionality.
function Test_crw_str_sanity:LongString;

implementation

{$PUSH}
{$WARN 4104 off : Implicit string type conversion from "$1" to "$2"}
{$WARN 4105 off : Implicit string type conversion with potential data loss from "$1" to "$2"}
function StrToWide(const s:String):WideString;
begin
 Result:=s
end;
function WideToStr(const s:WideString):String;
begin
 Result:=s
end;
{$POP}

function StrAnsiToOem(const AnsiStr:LongString):LongString;
begin
 Result:=AnsiStr;
 {$IFDEF WINDOWS}
 if (Result<>'') then UniqueString(Result);
 if (Result<>'') then CharToOem(PChar(AnsiStr),PChar(Result));
 {$ENDIF WINDOWS}
end;

function StrOemToAnsi(const OemStr:LongString):LongString;
begin
 Result:=OemStr;
 {$IFDEF WINDOWS}
 if (Result<>'') then UniqueString(Result);
 if (Result<>'') then OemToChar(PChar(OemStr),PChar(Result));
 {$ENDIF WINDOWS}
end;

 {
 ***********************
 NULL-terminated strings
 ***********************
 }

function StrLen(Str: PChar): SizeInt;
begin
 Result:=0;
 if Assigned(Str) then while Str[Result] <> #0 do inc(Result);
end;

function StrLLen(Str: PChar; MaxLen: SizeInt): SizeInt;
begin
 Result:=0;
 if Assigned(Str) then while (Str[Result] <> #0) and (Result<MaxLen) do inc(Result);
end;

function StrEnd(Str: PChar): PChar;
begin
 Result:=Str;
 if Assigned(Result) then while Result[0] <> #0 do inc(Result);
end;

function StrCopy(Dest, Source: PChar): PChar;
var Len:SizeInt;
begin
 Result:=Dest;
 if Assigned(Dest) then begin
  Len:=0;
  if Assigned(Source) then while Source[Len] <> #0 do inc(Len);
  SafeMove(Source[0],Dest[0],Len);
  Dest[Len]:=#0;
 end;
end;

function StrECopy(Dest, Source: PChar): PChar;
var Len:SizeInt;
begin
 Result:=Dest;
 if Assigned(Dest) then begin
  Len:=0;
  if Assigned(Source) then while Source[Len] <> #0 do inc(Len);
  SafeMove(Source[0],Dest[0],Len);
  Dest[Len]:=#0;
  Result:=@Dest[Len];
 end;
end;

function StrLCopy(Dest, Source: PChar; MaxLen: SizeInt): PChar;
var Len:SizeInt;
begin
 Result:=Dest;
 if Assigned(Dest) then begin
  Len:=0;
  if Assigned(Source) then while (Source[Len] <> #0) and (Len<MaxLen) do inc(Len);
  SafeMove(Source[0],Dest[0],Len);
  Dest[Len]:=#0;
 end;
end;

function StrPCopy(Dest: PChar; const Source: LongString): PChar;
begin
 Result:=StrLCopy(Dest,@Source[1],Length(Source));
end;

function StrPLCopy(Dest: PChar; const Source: LongString; MaxLen: SizeInt): PChar;
begin
 Result:=StrLCopy(Dest,@Source[1],Min(Length(Source),MaxLen));
end;

function StrCat(Dest, Source: PChar): PChar;
begin
 Result:=Dest;
 StrCopy(StrEnd(Dest),Source);
end;

function StrPCat(Dest:PChar; const Source: LongString): PChar;
begin
 Result:=Dest;
 StrLCopy(StrEnd(Dest),@Source[1],Length(Source));
end;

function StrLCat(Dest, Source: PChar; MaxLen: SizeInt): PChar;
begin
 Result:=Dest;
 StrLCopy(StrEnd(Dest),Source,MaxLen-StrLen(Dest));
end;

function StrComp(Str1, Str2: PChar): Integer;
begin
 Result:=0;
 if Assigned(Str1) and Assigned(Str2) then
 while true do begin
  if (Str1[0]=#0) or (Str2[0]=#0) or (Str1[0]<>Str2[0]) then begin
   Result:=ord(Str1[0])-ord(Str2[0]);
   Break;
  end;
  inc(Str1);
  inc(Str2);
 end;
end;

function StrIComp(Str1, Str2: PChar): Integer;
begin
 Result:=0;
 if Assigned(Str1) and Assigned(Str2) then
 while true do begin
  if (Str1[0]=#0) or (Str2[0]=#0) or (UpcaseTable[Str1[0]]<>UpcaseTable[Str2[0]]) then begin
   Result:=ord(UpcaseTable[Str1[0]])-ord(UpcaseTable[Str2[0]]);
   Break;
  end;
  inc(Str1);
  inc(Str2);
 end;
end;

function StrLComp(Str1, Str2: PChar; MaxLen: SizeInt): Integer;
var i:SizeInt;
begin
 Result:=0;
 if Assigned(Str1) and Assigned(Str2) then
 for i:=0 to MaxLen-1 do begin
  if (Str1[0]=#0) or (Str2[0]=#0) or (Str1[0]<>Str2[0]) then begin
   Result:=ord(Str1[0])-ord(Str2[0]);
   Break;
  end;
  inc(Str1);
  inc(Str2);
 end;
end;

function StrLIComp(Str1, Str2: PChar; MaxLen: SizeInt): Integer;
var i:SizeInt;
begin
 Result:=0;
 if Assigned(Str1) and Assigned(Str2) then
 for i:=0 to MaxLen-1 do begin
  if (Str1[0]=#0) or (Str2[0]=#0) or (UpcaseTable[Str1[0]]<>UpcaseTable[Str2[0]]) then begin
   Result:=ord(UpcaseTable[Str1[0]])-ord(UpcaseTable[Str2[0]]);
   Break;
  end;
  inc(Str1);
  inc(Str2);
 end;
end;

function StrScan(Str: PChar; Chr: Char): PChar;
begin
 Result:=nil;
 if Assigned(Str) then
 while Str[0]<>#0 do begin
  if Str[0]=Chr then begin
   Result:=Str;
   Break;
  end;
  inc(Str);
 end;
end;

function StrIScan(Str: PChar; Chr: Char): PChar;
begin
 Result:=nil;
 if Assigned(Str) then
 while Str[0]<>#0 do begin
  if UpcaseTable[Str[0]]=UpcaseTable[Chr] then begin
   Result:=Str;
   Break;
  end;
  inc(Str);
 end;
end;

function StrRScan(Str: PChar; Chr: Char): PChar;
var i:SizeInt;
begin
 Result:=nil;
 if Assigned(Str) then
 for i:=StrLen(Str)-1 downto 0 do begin
  if Str[i]=Chr then begin
   Result:=@Str[i];
   Break;
  end;
 end;
end;

function StrRIScan(Str: PChar; Chr: Char): PChar;
var i:SizeInt;
begin
 Result:=nil;
 if Assigned(Str) then
 for i:=StrLen(Str)-1 downto 0 do begin
  if UpcaseTable[Str[i]]=UpcaseTable[Chr] then begin
   Result:=@Str[i];
   Break;
  end;
 end;
end;

function StrUpper(Str: PChar): PChar;
begin
 Result:=Str;
 if Assigned(Str) then
 while Str[0] <> #0 do begin
  Str[0]:=UpCaseTable[Str[0]];
  inc(Str);
 end;
end;

function StrLower(Str: PChar): PChar;
begin
 Result:=Str;
 if Assigned(Str) then
 while Str[0] <> #0 do begin
  Str[0]:=LoCaseTable[Str[0]];
  inc(Str);
 end;
end;

function StrPos(Str1, Str2: PChar): PChar;
var Len:SizeInt;
begin
 Result:=nil;
 Len:=StrLen(Str2);
 if Assigned(Str1) and Assigned(Str2) then
 while Assigned(Str1) do begin
  Str1:=StrScan(Str1,Str2[0]);
  if Str1<>nil then begin
   if Str1[0]=#0 then Break;
   if StrLComp(Str1,Str2,Len)=0 then begin
    Result:=Str1;
    Break;
   end;
   inc(Str1);
  end;
 end;
end;

function StrIPos(Str1, Str2: PChar): PChar;
var Len:SizeInt;
begin
 Result:=nil;
 Len:=StrLen(Str2);
 if Assigned(Str1) and Assigned(Str2) then
 while Assigned(Str1) do begin
  Str1:=StrIScan(Str1,Str2[0]);
  if Str1<>nil then begin
   if Str1[0]=#0 then Break;
   if StrLIComp(Str1,Str2,Len)=0 then begin
    Result:=Str1;
    Break;
   end;
   inc(Str1);
  end;
 end;
end;

function StrPas(Str:PChar):LongString;
begin
 if Assigned(Str) then Result:=Str else Result:='';
end;

function StrPass(Str:PChar; const PassChars:TCharSet):PChar;
begin
 Result:=Str;
 if Assigned(Result) then
 while (Result[0]<>#0) and (Result[0] in PassChars) do inc(Result);
end;

function StrMove(Dest, Source: PChar; Count: SizeInt): PChar;
begin
 Result:=Dest;
 SafeMove(Source[0],Dest[0],Count);
end;

function  GetTextNumLines(Text:PChar; Count:SizeInt=MaxSizeInt; UnixStyle:Boolean=false): SizeInt;
var Index,N:SizeInt; UsesLFCR,UsesCRLF:Boolean;
begin
 Result:=0; Index:=0; N:=0;
 if Assigned(Text) then begin
  UsesLFCR:=not UnixStyle;
  UsesCRLF:=not UnixStyle;
  while (Index<Count) do begin
   case Text[Index] of
    #0       : Break;
    ASCII_LF : begin
                if UsesLFCR and (Text[Index+1]=ASCII_CR) then Inc(Index);
                Inc(Result); N:=0;
               end;
    ASCII_CR : begin
                if UsesCRLF and (Text[Index+1]=ASCII_LF) then Inc(Index);
                Inc(Result); N:=0;
               end;
    else       Inc(N);
   end;
   Inc(Index);
  end;
  if (N>0) then Inc(Result);
 end;
end;

function  GetTextNumLines(Text:LongString; UnixStyle:Boolean=false): SizeInt;
begin
 Result:=GetTextNumLines(PChar(Pointer(Text)),Length(Text),UnixStyle);
end;

function PosI(const Sub:LongString; const Str:LongString):SizeInt;
begin
 Result:=Pos(UpperCase(Sub),UpperCase(Str));
end;

function PosEx(Sub:PChar; SubLen:SizeInt; Str:PChar; StrLen:SizeInt; Offset:SizeInt):SizeInt; overload;
var i,j,n,Count:SizeInt;
begin
 Result:=-1;
 if (Sub=nil) or (SubLen<=0) then Exit;
 if (Str=nil) or (StrLen<=0) then Exit;
 Count:=StrLen-Offset-SubLen+1; if (Offset<0) or (Count<=0) then Exit;
 n:=0;
 for i:=0 to Count-1 do if (Sub[0]=Str[Offset+i]) then begin
  inc(n); for j:=1 to SubLen-1 do if (Sub[j]=Str[Offset+i+j]) then inc(n) else Break;
  if (n=SubLen) then begin Result:=Offset+i; Exit; end else n:=0;
 end;
end;

function PosEx(const Sub,Str:LongString; StartPos:SizeInt):SizeInt; overload;
begin
 Result:=PosEx(PChar(Sub),Length(Sub),PChar(Str),Length(Str),StartPos-1)+1;
end;

function LastPos(const Sub,Str:LongString):SizeInt;
var i,p:SizeInt;
begin
 p:=0;
 i:=0;
 repeat
  i:=PosEx(Sub,Str,i+1);
  if (i>0) then p:=i;
 until (i<=0);
 LastPos:=p;
end;

function CountPos(const Sub,Str:LongString):SizeInt;
var i,n:SizeInt;
begin
 n:=0;
 i:=0;
 repeat
  i:=PosEx(Sub,Str,i+1);
  if (i>0) then n:=n+1;
 until (i<=0);
 CountPos:=n;
end;

function NthPos(const Sub,Str:LongString; n:SizeInt):SizeInt;
var i,p:SizeInt;
begin
 p:=0;
 i:=0;
 if (n>0) then
 repeat
  i:=PosEx(Sub,Str,i+1);
  if (i>0) then begin
   if (n=1) then p:=i;
   if (p>0) then i:=0;
   n:=n-1;
  end;
 until (i<=0);
 NthPos:=p;
end;

function PosEol(Buf:LongString; Start:SizeInt=1; SkipLines:SizeInt=0):SizeInt;
begin
 if (Buf<>'') then Result:=PosEol(PChar(Buf),Length(Buf),Start,SkipLines) else Result:=0;
end;

function PosEol(Buf:PChar; Count:SizeInt; Start:SizeInt=1; SkipLines:SizeInt=0):SizeInt;
const EolChars=[ASCII_CR,ASCII_LF]; // Windows/Unix/MAC uses CRLF/LF/CR EOL`s.
var i:SizeInt; c1,c2:Char;
begin
 Result:=0;                                     // By default, no
 if (Buf=nil) then Exit;                        // Invalid buffer?
 if (Count<=0) then Exit;                       // Invalid counter?
 if (Start<=0) then Exit;                       // Invalid start pos?
 if (Start>Count) then Exit;                    // Invalid start pos?
 if (SkipLines<=1) then begin                   // SkipLines 0 or 1:
  for i:=Start-1 to Count-1 do                  // Search EOL marker
  if (Buf[i] in EolChars) then begin            // Check is this EOL
   Result:=i+1; Break;                          // Pos of EOL found
  end;
  if (Result<=0) then begin                     // If EOL not found
   if (SkipLines>0) then Result:=Count+1;       // Return pos after text on skip lines queried
   Exit;                                        // or return zero to notify EOL was not found
  end;
  if (SkipLines<=0) then Exit;                  // Return EOL pos if no skip lines query
  c1:=Buf[Result-1]; inc(Result);               // Fetch 1-st EOL char, if skip lines queried
  if (Result>Count) then Exit;                  // Ending EOL char found, no reason to continue
  c2:=Buf[Result-1]; if (c1=c2) then Exit;      // Fetch 2-nd EOL char; assume CR,CR or LF,LF is two different EOL`s
  if (c2 in EolChars) then inc(Result);         // CR,LF or LF,CR case: assume CR,LF or LF,CR is one single EOL
 end else begin
  for i:=1 to SkipLines do begin                // Recursive skip lines:
   Result:=PosEol(Buf,Count,Start,1);           // Skip this line
   if (Result>Count) then Break;                // Out of buffer?
   if (Result<0) then Break;                    // EOL not found?
   Start:=Result;                               // Next iteration
  end;
 end;
end;

function ForEachStringLine(const StringLines:LongString;
                           Iterator:TStringLineIterator;
                           Custom:Pointer):SizeInt;
 // Procedure to handle line number n.
 function HandleLine(n:SizeInt; const Line:LongString):Boolean;
 begin
  if Assigned(Iterator)
  then Result:=Iterator(n,Line,Custom)
  else Result:=true;
 end;
 // Handle lines in buffer, return num.lines.
 function HandleLines(const buf:LongString):Integer;
 var p,s,n,l:SizeInt; Line:LongString;
 begin
  p:=1; s:=1; n:=0; l:=Length(buf); // Init variables
  while (p>=1) and (p<=l) do begin  // Loop per line:
   p:=PosEol(buf,s,0);              // Find EOL
   if (p>0) then begin              // EOL found
    Line:=Copy(buf,s,p-s);          // Extract line
    if HandleLine(n,Line)           // Handle line
    then Inc(n) else Break;         // -- or break
    s:=PosEol(buf,p,1);             // Skip EOL
   end else                         // Handle last line
   if (s<=l) then begin             // Has tail
    Line:=Copy(buf,s,l-s+1);        // Extract tail line
    if HandleLine(n,Line)           // Handle line
    then Inc(n) else Break;         // -- or break
   end;
  end;
  Result:=n;                        // Number of lines handled
 end;
begin
 Result:=0;
 try
  Result:=HandleLines(StringLines);
 except
  on E:Exception do BugReport(E,nil,'ForEachStringLine');
 end;
end;

 {
 **********************
 String case conversion
 **********************
 }

procedure SetupCharTable(var T: TCharTable; const s,d:LongString);
var c:Char; i:SizeInt;
begin
 for c:=low(T) to high(T) do T[c]:=c;
 for i:=1 to Min(Length(s),Length(d)) do T[s[i]]:=d[i];
end;

procedure SetCaseTable_Latins;
begin
 SetupCharTable(LoCaseTable, Abc_Latin_Up, Abc_Latin_Lo);
 SetupCharTable(UpCaseTable, Abc_Latin_Lo, Abc_Latin_Up);
end;

procedure SetCaseTable_NoCase;
begin
 SetupCharTable(LoCaseTable,'','');
 SetupCharTable(UpCaseTable,'','');
end;

procedure SetCaseTable_Default;
begin
 case DefaultSystemCodePage of
  866:  SetCaseTable_RusDos;
  1251: SetCaseTable_RusWin;
  else  SetCaseTable_Latins;
 end;
end;

procedure SetCaseTable_EngDos;
begin
 SetupCharTable(LoCaseTable, Abc_Eng_Up, Abc_Eng_Lo);
 SetupCharTable(UpCaseTable, Abc_Eng_Lo, Abc_Eng_Up);
end;

procedure SetCaseTable_EngWin;
begin
 SetupCharTable(LoCaseTable, Abc_Eng_Up, Abc_Eng_Lo);
 SetupCharTable(UpCaseTable, Abc_Eng_Lo, Abc_Eng_Up);
end;

procedure SetCaseTable_RusDos;
begin
 SetupCharTable(LoCaseTable, Abc_Eng_Up+Abc_RusDos_Up, Abc_Eng_Lo+Abc_RusDos_Lo);
 SetupCharTable(UpCaseTable, Abc_Eng_Lo+Abc_RusDos_Lo, Abc_Eng_Up+Abc_RusDos_Up);
end;

procedure SetCaseTable_RusWin;
begin
 SetupCharTable(LoCaseTable, Abc_Eng_Up+Abc_RusWin_Up, Abc_Eng_Lo+Abc_RusWin_Lo);
 SetupCharTable(UpCaseTable, Abc_Eng_Lo+Abc_RusWin_Lo, Abc_Eng_Up+Abc_RusWin_Up);
end;

function UpCase(c:Char):Char;
begin
 Result:=UpCaseTable[c];
end;

function LoCase(c:Char):Char;
begin
 Result:=LoCaseTable[c];
end;

function LoCaseStr(const S:LongString):LongString;
var i:SizeInt;
begin
 Result:='';
 SetLength(Result,Length(S));
 for i:=0 to Length(Result)-1 do PChar(Result)[i]:=LoCaseTable[PChar(S)[i]];
end;

function UpCaseStr(const S:LongString):LongString;
var i:SizeInt;
begin
 Result:='';
 SetLength(Result,Length(S));
 for i:=0 to Length(Result)-1 do PChar(Result)[i]:=UpCaseTable[PChar(S)[i]];
end;

function IsSameChar(C1,C2:Char):Boolean;
begin
 Result:=(UpCaseTable[C1]=UpCaseTable[C2]);
end;

function IsSameStr(S1,S2:LongString):Boolean;
begin
 Result:=(S1=S2);
end;

function IsSameText(const S1,S2:LongString):Boolean;
var i:SizeInt;
begin
 Result:=false;
 if Length(S1)<>Length(S2) then Exit;
 for i:=0 to Length(S1)-1 do
 if UpCaseTable[PChar(S1)[i]]<>UpCaseTable[PChar(S2)[i]] then Exit;
 Result:=true;
end;

function IsSameFileName(const S1,S2:LongString; Mode:Integer=ua_FileDef):Boolean;
var F1,F2:LongString;
begin
 F1:=UnifyFileAlias(S1,Mode);
 F2:=UnifyFileAlias(S2,Mode);
 Result:=IsSameStr(F1,F2);
end;

 {
 **************************
 String codepage conversion
 **************************
 }

function  WinToDos(c:Char):Char;
begin
 Result:=WinToDosTable[c];
end;

function  DosToWin(c:Char):Char;
begin
 Result:=DosToWinTable[c];
end;

function  WinToDosStr(const S:LongString):LongString;
var i:SizeInt;
begin
 Result:='';
 SetLength(Result,Length(S));
 for i:=0 to Length(Result)-1 do PChar(Result)[i]:=WinToDosTable[PChar(S)[i]];
end;

function  DosToWinStr(const S:LongString):LongString;
var i:SizeInt;
begin
 Result:='';
 SetLength(Result,Length(S));
 for i:=0 to Length(Result)-1 do PChar(Result)[i]:=DosToWinTable[PChar(S)[i]];
end;

function  WinToKoi(c:Char):Char;
begin
 Result:=WinToKoiTable[c];
end;

function  KoiToWin(c:Char):Char;
begin
 Result:=KoiToWinTable[c];
end;

function  WinToKoiStr(const S:LongString):LongString;
var i:SizeInt;
begin
 Result:='';
 SetLength(Result,Length(S));
 for i:=0 to Length(Result)-1 do PChar(Result)[i]:=WinToKoiTable[PChar(S)[i]];
end;

function  KoiToWinStr(const S:LongString):LongString;
var i:SizeInt;
begin
 Result:='';
 SetLength(Result,Length(S));
 for i:=0 to Length(Result)-1 do PChar(Result)[i]:=KoiToWinTable[PChar(S)[i]];
end;

 {
 ***********************************
 General purpose string manipulation
 ***********************************
 }
function Format(const Fmt:LongString; const Args: array of const):LongString;
begin
 Result:='';
 try
  Result:=SysUtils.Format(Fmt, Args);
 except
  on E:Exception do BugReport(E,nil,'Format');
 end;
end;

function Str2CharSet(const S:LongString):TCharSet;
var i:SizeInt;
begin
 Result:=[];
 for i:=1 to length(S) do include(Result,S[i]);
end;

function CharSet2Str(const S:TCharSet):LongString;
var c:Char;
begin
 Result:='';
 for c:=low(c) to high(c) do if c in S then Result:=Result+c;
end;

function TailStr(const S:LongString; Pos:SizeInt):LongString;
begin
 Result:=Copy(S,Pos,length(S)-Pos+1);
end;

function RightStr(const S:LongString; Count:SizeInt):LongString;
begin
 Result:=Copy(S,Length(S)+1-Count,Count);
end;

function StrRight(const S:LongString; Count:SizeInt):LongString;
begin
 Result:=Copy(S,Length(S)-Count+1,Count);
end;

function LeftStr(const S:LongString; Count:SizeInt):LongString;
begin
 Result:=Copy(S,1,Count);
end;

function StrLeft(const S:LongString; Count:SizeInt):LongString;
begin
 Result:=Copy(S,1,Count);
end;

function StrAheadOf(const S:LongString; Delim:Char):LongString;
begin
 Result:=Copy(S,1,Pos(Delim,S)-1);
end;

function StrAfterOf(const S:LongString; Delim:Char):LongString;
begin
 Result:=Copy(S,Pos(Delim,S)+1,Length(S));
end;

function CharStr(Len:SizeInt; Ch:Char=' '):LongString;
begin
 if (Len<=0) then Result:='' else Result:=StringOfChar(Ch,Len);
end;

function Pad(const S:LongString; Len:SizeInt; Ch:Char=' '):LongString;
var n:SizeInt;
begin
 n:=Len-Length(S);
 if (n<=0) then Result:=S else Result:=S+CharStr(n,Ch);
end;

function RightPad(const S:LongString; Len:SizeInt; Ch:Char=' '):LongString;
var n:SizeInt;
begin
 n:=Len-Length(S);
 if (n<=0) then Result:=S else Result:=S+CharStr(n,Ch);
end;

function LeftPad(const S:LongString; Len:SizeInt; Ch:Char=' '):LongString;
var n:SizeInt;
begin
 n:=Len-Length(S);
 if (n<=0) then Result:=S else Result:=CharStr(n,Ch)+S;
end;

function CenterPad(const S:LongString; Width:SizeInt; Ch:Char=' '):LongString;
var n,l,r:SizeInt;
begin
 n:=Width-Length(S); l:=n div 2; r:=n-l;
 if (n<=0) then Result:=S else Result:=CharStr(l,Ch)+S+CharStr(r,Ch);
end;

function CenterStr(const S:LongString; Width:SizeInt; Ch:Char=' '):LongString;
var n,l,r:SizeInt;
begin
 n:=Width-Length(S); l:=n div 2; r:=n-l;
 if (n<=0) then Result:=S else Result:=CharStr(l,Ch)+S+CharStr(r,Ch);
end;

function TrimLeadChars(const S:LongString; const TrimChars:TCharSet):LongString;
var i,j:SizeInt;
begin
 i:=1;
 j:=Length(S);
 while (i<=j) and (S[i] in TrimChars) do Inc(i);
 Result:=Copy(S, i, j-i+1);
end;

function TrimLeftChars(const S:LongString; const TrimChars:TCharSet):LongString;
var i,j:SizeInt;
begin
 i:=1;
 j:=Length(S);
 while (i<=j) and (S[i] in TrimChars) do Inc(i);
 Result:=Copy(S, i, j-i+1);
end;

function TrimTrailChars(const S:LongString; const TrimChars:TCharSet):LongString;
var i,j:SizeInt;
begin
 i:=1;
 j:=Length(S);
 while (i<=j) and (S[j] in TrimChars) do Dec(j);
 Result:=Copy(S, i, j-i+1);
end;

function TrimRightChars(const S:LongString; const TrimChars:TCharSet):LongString;
var i,j:SizeInt;
begin
 i:=1;
 j:=Length(S);
 while (i<=j) and (S[j] in TrimChars) do Dec(j);
 Result:=Copy(S, i, j-i+1);
end;

function TrimChars(const S:LongString; const LeadTrim,TrailTrim:TCharSet):LongString;
var i,j:SizeInt;
begin
 i:=1;
 j:=Length(S);
 while (i<=j) and (S[i] in LeadTrim ) do Inc(i);
 while (i<=j) and (S[j] in TrailTrim) do Dec(j);
 Result:=Copy(S, i, j-i+1);
end;

function TrimLead(const S: LongString): LongString;
var i,j:SizeInt;
begin
 i:=1;
 j:=Length(S);
 while (i<=j) and (S[i] <= ' ') do Inc(i);
 Result:=Copy(S, i, j-i+1);
end;

function TrimTrail(const S: LongString): LongString;
var i,j:SizeInt;
begin
 i:=1;
 j:=Length(S);
 while (i<=j) and (S[j] <= ' ') do Dec(j);
 Result:=Copy(S, i, j-i+1);
end;

function Trim(const S: LongString): LongString;
var i,j:SizeInt;
begin
 i:=1;
 j:=Length(S);
 while (i<=j) and (S[i] <= ' ') do Inc(i);
 while (i<=j) and (S[j] <= ' ') do Dec(j);
 Result:=Copy(S, i, j-i+1);
end;

function TrimDef(const S,Def:LongString):LongString;
begin
 Result:=Trim(S);
 if (Result='') then Result:=Def;
end;

function SortTextLines(const aTextLines:LongString;
                             Comparator:TStringListSortCompare=nil):LongString;
var Lines:TStringList;
begin
 Result:='';
 if (aTextLines<>'') then
 try
  Lines:=TStringList.Create;
  try
   Lines.Text:=aTextLines;
   if Assigned(Comparator)
   then Lines.CustomSort(Comparator)
   else Lines.Sort;
   Result:=Lines.Text;
  finally
   Kill(Lines);
  end;
 except
  on E:Exception do BugReport(E,nil,'SortText');
 end;
end;

function UnifyAlias(const Name:LongString; Mode:Integer=ua_NameDef):LongString;
begin
 Result:=Name;
 if (Result='') then Exit;
 if ((Mode and ua_NameDef)<>0) then Mode:=UnifyAliasDefMode;
 case (Mode and ua_Trim) of
  ua_Trim  : Result:=Trim(Result);
  ua_TrimL : Result:=TrimLeft(Result);
  ua_TrimR : Result:=TrimRight(Result);
 end;
 case (Mode and ua_Case) of
  ua_Upper: Result:=UpCaseStr(Result);
  ua_Lower: Result:=LoCaseStr(Result);
 end;
end;

function UnifyFileAlias(const FileName:LongString; Mode:Integer=ua_FileDef):LongString;
begin
 if IsEmptyStr(FileName) then Result:='' else begin
  if ((Mode and ua_FileDef)<>0) then Mode:=UnifyFileAliasDefMode;
  Result:=UnifyAlias(FileName,Mode and not ua_ModeDef);
  if ((Mode and ua_DirSep)<>0) then Result:=ValidatePathDelim(Result);
  if ((Mode and ua_FExpand)<>0) then Result:=FExpand(Result);
 end;
end;

function UnifySection(const aSectionName:LongString; Mode:Integer=ua_SectDef):LongString;
begin
 if ((Mode and ua_SectDef)<>0) then Mode:=UnifySectionDefMode;
 Result:=UnifyAlias(aSectionName,Mode and not ua_ModeDef);
 if (StrFetch(Result,1)<>'[') then Result:='['+Result;
 if (StrFetch(Result,Length(Result))<>']') then Result:=Result+']';
end;

function IsSectionName(const aName:LongString):Boolean;
var Len:SizeInt;
begin
 Len:=Length(aName);
 if (Len<2) then Result:=false else
 Result:=(aName[1]='[') and (aName[Len]=']');
end;

function StrFetch(const s:LongString; i:SizeInt):Char;
begin
 if (i>=1) and (i<=Length(s)) then Result:=s[i] else Result:=#0;
end;

function AnsiDeQuotedStr(const s:LongString; q:Char):LongString;
var p:PChar;
begin
 Result:=s;
 if (s='') then exit;
 if (s[1]<>q) then exit;
 p:=PChar(s);
 Result:=SysUtils.AnsiExtractQuotedStr(p,q);
end;

function AnsiSkipQuotedStr(const s:LongString; q:Char):LongString;
var p:PChar;
begin
 Result:=s;
 if (s='') then exit;
 if (s[1]<>q) then exit;
 p:=PChar(s);
 Result:=SysUtils.AnsiExtractQuotedStr(p,q);
 if (p=nil) then Result:='' else Result:=p;
end;

function RemoveBrackets(const s:LongString; const Brackets:LongString):LongString;
var i,j:SizeInt;
begin
 Result:=s;
 if Length(Result)>0 then
 if Length(Brackets)>1 then begin
  i:=1;
  j:=Length(Result);
  if Result[1]=Brackets[1] then Inc(i);
  if Result[Length(Result)]=Brackets[2] then Dec(j);
  Result:=System.Copy(Result,i,j-i+1);
 end;
end;

function ExtractFirstParam(const s:LongString; quote:Char=QuoteMark; const Spaces:TCharSet=JustSpaces):LongString;
begin
 Result:=s;
 if (s='') then Exit;
 if (quote=#0) then Exit;
 Result:=TrimLeftChars(s,Spaces);
 if (StrFetch(Result,1)=quote)
 then Result:=AnsiDequotedStr(Result,quote)
 else Result:=ExtractWord(1,Result,Spaces);
end;

function SkipFirstParam(const s:LongString; quote:Char=QuoteMark; const Spaces:TCharSet=JustSpaces):LongString;
begin
 Result:=s;
 if (s='') then Exit;
 if (quote=#0) then Exit;
 Result:=TrimLeftChars(s,Spaces);
 if (StrFetch(Result,1)=quote)
 then Result:=AnsiSkipQuotedStr(Result,quote)
 else Result:=SkipWords(1,Result,Spaces);
 Result:=TrimLeftChars(Result,Spaces);
end;

function AnsiQuotedIfNeed(const s:LongString; quote:Char=QuoteMark; const Spaces:TCharSet=JustSpaces):LongString;
begin
 Result:=s; if (Result='') then Exit; if (quote=#0) then Exit;                        // Nothing to do with empty data
 if (StrFetch(Result,1)=quote) and (StrFetch(Result,Length(Result))=quote) then Exit; // String is already quoted, skip
 if HasChars(Result,Spaces) then Result:=AnsiQuotedStr(Result,quote);                 // Need quotes if string has spaces
end;

function IsOption(const arg:LongString; const shortopt:LongString=''; const longopt:LongString='';
                  Mode:Integer=om_Default; Delim:Char='='):Boolean;
var OptChars:TCharSet; na,ns,nl,la,ls,ll,p:SizeInt;
begin                                                                       // Check if arg is Option:
 Result:=false;                                                             // By default NO
 if (arg='') then Exit;                                                     // Empty string is not option
 OptChars:=CmdOptionChars;                                                  // Set option chars to check
 if ((Mode and om_NoSlash)<>0) then Exclude(OptChars,'/');                  // Exclude slash if need
 na:=0; ns:=0; nl:=0; la:=Length(arg); ls:=0; ll:=0;                        // Initialize counters
 if (StrFetch(arg,1) in OptChars) then inc(na);                             // Check 1-st arg char is option
 if (na=0) then Exit;                                                       // NO, it's not an option
 if (StrFetch(arg,2) in OptChars) then inc(na);                             // Check 2-nd arg char is option
 if (Delim<>#0) then begin                                                  // Apply delimiter (usually =)
  p:=Pos(Delim,arg); if (p>0) then la:=p-1;                                 // Drop arg tail since delimiter
  if (p>0) and (la<=na) then Exit;                                          // Empty option before delimiter!
 end;                                                                       //
 if (shortopt<>'') then begin                                               // If short option present
  if (StrFetch(shortopt,1) in OptChars) then inc(ns);                       // Check 1-st short option char
  if (ns=0) then Exit;                                                      // Wrong short option!
  if (StrFetch(shortopt,2) in OptChars) then inc(ns);                       // Maybe it's long option?
  ls:=Length(shortopt);                                                     // get shortopt length
 end;                                                                       //
 if (longopt<>'') then begin                                                // If long option present
  if (StrFetch(longopt,1) in OptChars) then inc(nl);                        // Check 1-st long option char
  if (nl=0) then Exit;                                                      // Wrong long option!
  if (StrFetch(longopt,2) in OptChars) then inc(nl);                        // Maybe it's long option?
  ll:=Length(longopt);                                                      // get longopt length
 end;                                                                       //
 if ((ns+nl)=0) then Result:=true;                                          // No short/long options is set.
 if Result then Exit;                                                       // The arg is just an option.
 if (na=ns) and (la=ls) then begin                                          // Check short option is match
  if (na=la) then Result:=true else                                         // Special case: - or --
  if ((Mode and om_UseCase)<>0) then begin                                  // Case sensitive comparison?
   if (Copy(arg,na+1,la-na)=Copy(shortopt,ns+1,ls-ns))                      // Compare case sensitive
   then Result:=true;                                                       // YES, match found.
  end else begin                                                            //
   if SameText(Copy(arg,na+1,la-na),Copy(shortopt,ns+1,ls-ns))              // Compare case insensitive
   then Result:=true;                                                       // YES, match found.
  end;                                                                      //
  if Result then Exit;                                                      // Match found, done.
 end;                                                                       //
 if (na=nl) and (la=ll) then begin                                          // Check long option is match
  if (na=la) then Result:=true else                                         // Special case: - or --
  if ((Mode and om_UseCase)<>0) then begin                                  // Case sensitive comparison?
   if (Copy(arg,na+1,la-na)=Copy(longopt,nl+1,ll-nl))                       // Compare case sensitive
   then Result:=true;                                                       // YES, match found.
  end else begin                                                            //
   if SameText(Copy(arg,na+1,la-na),Copy(longopt,nl+1,ll-nl))               // Compare case insensitive
   then Result:=true;                                                       // YES, match found.
  end;                                                                      //
  if Result then Exit;                                                      // Match found, done.
 end;                                                                       //
end;

function GetOptionValue(const arg:LongString; Delim:Char='='):LongString;
var p:SizeInt;
begin
 Result:='';                                                                // Empty by default
 if not IsOption(arg,'','',0,Delim) then Exit;                              // It is not an option?
 p:=Pos(Delim,arg); if (p=0) then Exit;                                     // Delimeter not found?
 if (p>=Length(arg)) then Exit;                                             // No data after delimeter?
 Result:=Copy(arg,p+1,Length(arg)-p);                                       // Copy data after delimeter
end;

function HasOptionValue(const arg:LongString; Delim:Char='='):Boolean;
var p:SizeInt;
begin
 Result:=false;                                                             // NOT by default
 if not IsOption(arg,'','',0,Delim) then Exit;                              // It is not an option?
 p:=Pos(Delim,arg); if (p=0) then Exit;                                     // Delimeter not found?
 if (p>=Length(arg)) then Exit;                                             // No data after delimeter?
 Result:=true;                                                              // Yes, an option has value
end;

function ExtractNameValuePair(const arg:LongString; out Name,Value:LongString;
                              const Sign:Char='='; Mode:Integer=3):Integer;
var p:Integer;
begin
 p:=Pos(Sign,arg);
 if (p>0) then begin
  Name:=Copy(arg,1,p-1);
  Value:=Copy(arg,p+1,Length(arg)-p);
 end else begin
  Name:=arg;
  Value:='';
 end;
 if HasFlags(Mode,1) and (Name<>'') then Name:=Trim(Name);
 if HasFlags(Mode,2) and (Value<>'') then Value:=Trim(Value);
 Result:=p;
end;

function IsLexeme(arg:PChar; leng:SizeInt; typ:Integer):Boolean; overload;
var i:SizeInt; vi,code:Integer; vf:Extended; st:LongString;
begin
 Result:=false;
 if (arg=nil) then Exit;
 if (leng<=0) then Exit;
 try
  case typ of
   lex_Ansi : begin
    Result:=true;
    Exit;
   end;
   lex_Utf8 : begin
    Result:=utf8_valid(arg,leng);
    Exit;
   end;
   lex_Name: begin
    for i:=0 to leng-1 do
    case arg[i] of
     '0'..'9' : if (i=0) then Exit;
     'A'..'Z','_','a'..'z' : ;
     else Exit;
    end;
   end;
   lex_Word: begin
    for i:=0 to leng-1 do
    case arg[i] of
     '0'..'9','A'..'Z','_','a'..'z' : ;
     else Exit;
    end;
   end;
   lex_Blank: begin
    for i:=0 to leng-1 do
    case arg[i] of
     ASCII_HT,' ' : ;
     else Exit;
    end;
   end;
   lex_Space: begin
    for i:=0 to leng-1 do
    case arg[i] of
     ASCII_HT,ASCII_LF,ASCII_VT,ASCII_FF,ASCII_CR,' ' : ;
     else Exit;
    end;
   end;
   lex_Cntrl: begin
    for i:=0 to leng-1 do
    case arg[i] of
     #$00..#$1F,#$7F : ;
     else Exit;
    end;
   end;
   lex_Alpha: begin
    for i:=0 to leng-1 do
    case arg[i] of
     'A'..'Z','a'..'z' : ;
     else Exit;
    end;
   end;
   lex_Lower: begin
    for i:=0 to leng-1 do
    case arg[i] of
     'a'..'z' : ;
     else Exit;
    end;
   end;
   lex_Upper: begin
    for i:=0 to leng-1 do
    case arg[i] of
     'A'..'Z' : ;
     else Exit;
    end;
   end;
   lex_Digit: begin
    for i:=0 to leng-1 do
    case arg[i] of
     '0'..'9' : ;
     else Exit;
    end;
   end;
   lex_Alnum: begin
    for i:=0 to leng-1 do
    case arg[i] of
     '0'..'9','A'..'Z','a'..'z' : ;
     else Exit;
    end;
   end;
   lex_xDigit: begin
    for i:=0 to leng-1 do
    case arg[i] of
     '0'..'9','A'..'F','a'..'f' : ;
     else Exit;
    end;
   end;
   lex_Punct: begin
    for i:=0 to leng-1 do
    case arg[i] of
     '!','"','#','$','%','&','''','(',')','*','+',',','-','.','/',
     ':',';','<','=','>','?','@','[','\',']','_','`','{','|','}','~' : ;
     else Exit;
    end;
   end;
   lex_Print: begin
    for i:=0 to leng-1 do
    case arg[i] of
     #$20..#$7E : ;
     else Exit;
    end;
   end;
   lex_Graph: begin
    for i:=0 to leng-1 do
    case arg[i] of
     #$21..#$7E : ;
     else Exit;
    end;
   end;
   lex_Ascii: begin
    for i:=0 to leng-1 do
    case arg[i] of
     #$00..#$7F : ;
     else Exit;
    end;
   end;
   lex_iParam : begin
    if (leng>40) then Exit;
    SetString(st,arg,leng);
    Val(st,vi,code);
    if (code<>0) then Exit;
    if (vi<>0) then; // To supress compiler hint.
   end;
   lex_fParam : begin
    if (leng>40) then Exit;
    SetString(st,arg,leng);
    Val(st,vf,code);
    if (code<>0) then Exit;
    if IsNan(vf) then Exit;
   end;
   lex_sParam : begin
    for i:=0 to leng-1 do
    case arg[i] of
     '"' : if (i=0) and (arg[0]<>arg[leng-1]) then Exit; // Quote balance
     ASCII_HT,' ' : if (arg[0]<>'"') or (arg[leng-1]<>'"') then Exit;
     ASCII_NUL..ASCII_BS,ASCII_LF..ASCII_US,ASCII_DEL : Exit;
    end;
   end;
   lex_Base64: begin
    for i:=0 to leng-1 do
    case arg[i] of
     '0'..'9','A'..'Z','a'..'z' : ;
     '+','/','=' : ;
     else Exit;
    end;
   end;
   lex_FsmName,
   lex_SmiName: begin
    for i:=0 to leng-1 do
    case arg[i] of
     'A'..'Z','_','a'..'z','&' : ;
     '0'..'9',':','-' : if (i=0) then Exit;
     else Exit;
    end;
   end;
   lex_DimName: begin
    for i:=0 to leng-1 do
    case arg[i] of
     #$00..#$1F,#$7F,'|','@',';',',' : Exit;
     '+','-','!' : if (i=0) then Exit;
    end;
   end;
   lex_SqlName: begin
    for i:=0 to leng-1 do
    case arg[i] of
     'A'..'Z','a'..'z' : ;
     '0'..'9','_' : if (i=0) then Exit;
     else Exit;
    end;
   end;
   lex_FbdName: begin
    for i:=0 to leng-1 do
    case arg[i] of
     'A'..'Z','a'..'z' : ;
     '0'..'9','_','$' : if (i=0) then Exit;
     else Exit;
    end;
   end;
   lex_Section: begin
    if (leng<2) then Exit;
    if (arg[0]<>'[') then Exit;
    if (arg[leng-1]<>']') then Exit;
    for i:=0 to leng-1 do
    case arg[i] of
     #$00..#$1F,#$7F : Exit;
    end;
   end;
   lex_AtCall: begin
    if (leng<2) then Exit;
    if (arg[0]<>'@') then Exit;
    if (arg[1] in [#0..' ',#$7F]) then Exit;
   end;
   lex_AtCmnd: begin
    if (leng<2) then Exit;
    if (arg[0]<>'@') then Exit;
    if (arg[1] in [#0..' ',#$7F]) then Exit;
    for i:=0 to leng-1 do
    case arg[i] of
     #$00..#$08,#$0A..#$1F,#$7F : Exit;
    end;
   end;
   else begin
    if Assigned(lex_regexp_test) then
    if (typ>=ObjectRegistryOffset) then begin
     SetString(st,arg,leng);
     Result:=lex_regexp_test(typ,st);
    end;
    Exit;
   end;
  end;
  Result:=true;
 except
  on E:Exception do BugReport(E,nil,'IsLexeme');
 end;
end;

function IsLexeme(arg:LongString; typ:Integer):Boolean; overload;
begin
 Result:=IsLexeme(PChar(arg),Length(arg),typ);
end;

procedure WordWrap(const InSt:LongString; var OutSt, Overlap:LongString;
                     Margin:SizeInt; PadToMargin:Boolean);
var EOS,BOS,InStLen:SizeInt;
const Blanks=JustSpaces;
begin
 InStLen:=Length(InSt);
 OutSt:=''; Overlap:='';
 if (InSt='') then Exit;
 if (Margin<1) then Exit;
 {find end of output string}
 if (InStLen>Margin) then begin
  {find end of word at margin, if any}
  EOS:=Margin;
  while (EOS<=InStLen) and not (InSt[EOS] in Blanks) do Inc(EOS);
  if (EOS>InStLen) then EOS:=InStLen;
  {trim trailing blanks}
  while (EOS>0) and (InSt[EOS] in Blanks) do Dec(EOS);
  if (EOS>Margin) then begin
   {look for the space before the current word}
   while (EOS>0) and not (InSt[EOS] in Blanks) do Dec(EOS);
   {if EOS = 0 then we can't wrap it}
   if (EOS=0)
   then EOS:=Margin                  {trim trailing blanks}
   else while (EOS>0) and (InSt[EOS] in Blanks) do Dec(EOS);
  end;
 end else EOS:=InStLen;
 {copy the unwrapped portion of the line}
 OutSt:=Copy(InSt,1,EOS);
 {find start of next word in the line}
 BOS:=EOS+1;
 while (BOS<=InStLen) and (InSt[BOS] in Blanks) do Inc(BOS);
 if (BOS>InStLen) then Overlap:='' else begin
  {copy from start of next word to end of line}
  Overlap:=Copy(InSt,BOS,Length(InSt)-BOS+1);
 end;
 {pad the end of the output string if requested}
 if PadToMargin then OutSt:=Pad(OutSt,Margin,' ');
end;

function ReplaceString(Str:LongString; const Find,Replace:LongString;
                       Flags:TReplaceFlags=[rfReplaceAll]):LongString;
begin
 Result:=StringReplace(Str,Find,Replace,Flags);
end;

function ReplaceAlignStr(const Str:LongString; Invert:Boolean):LongString;
 function Replace(S,A,B:LongString):LongString;
 begin
  Result:=ReplaceString(S,A,B,[rfReplaceAll,rfIgnoreCase]);
 end;
begin
 Result:=Str;
 if Invert then begin
  Result:=Replace(Result, '^C',     ^C       );
  Result:=Replace(Result, '^L',     ^L       );
  Result:=Replace(Result, '^R',     ^R       );
  Result:=Replace(Result, '^N',     ASCII_CR );
  Result:=Replace(Result, '^B',     ASCII_LF );
 end else begin
  Result:=Replace(Result, ^C,       '^C'     );
  Result:=Replace(Result, ^L,       '^L'     );
  Result:=Replace(Result, ^R,       '^R'     );
  Result:=Replace(Result, ASCII_CR, '^N'     );
  Result:=Replace(Result, ASCII_LF, '^B'     );
 end;
end;

function ValidateEOL(const aData:LongString; aTail:Integer=0; aEOL:LongString=EOL):LongString;
var tlbs:TTextLineBreakStyle;
begin
 Result:=aData;
 if (Result<>'') then begin
  if (aEOL=ASCII_LF) then tlbs:=tlbsLF   else
  if (aEOL=ASCII_CR) then tlbs:=tlbsCR   else
  if (aEOL=CRLF)     then tlbs:=tlbsCRLF else Exit;
  Result:=AdjustLineBreaks(aData,tlbs);
  if aTail<>0 then
  if RightStr(aData,Length(aEOL))=aEOL then begin
   if aTail<0 then Result:=Copy(Result,1,Length(Result)-Length(aEOL));
  end else begin
   if aTail>0 then Result:=Result+aEOL;
  end;
 end;
end;

function ValidateCRLF(const aData:LongString; aTail:Integer=0; aEOL:LongString=CRLF):LongString;
begin
 Result:=ValidateEOL(aData,aTail,aEOL);
end;

{
 *******************
 String word parsing
 *******************
 }
function WordCount(const S:LongString; const WordDelims:TCharSet):Integer;
var I,SLen:SizeInt;
begin
 Result:=0;
 SLen:=Length(S); I:=1;
 if (SLen=0) then Exit;
 while (I<=SLen) do begin
  {skip over delimiters}
  while (I<=SLen) and (S[I] in WordDelims) do Inc(I);
  {if we're not beyond end of S, we're at the start of a word}
  if (I<=SLen) then Inc(Result);
  {find the end of the current word}
  while (I<=SLen) and not (S[I] in WordDelims) do Inc(I);
 end;
end;

function ExtractWord(N:Integer; const S:LongString; const WordDelims:TCharSet):LongString;
var I,Count,Len,Pos,SLen:SizeInt;
begin
 Result:='';
 Len:=0; Pos:=0;
 SLen:=Length(S); I:=1; Count:=0;
 if (SLen=0) or (N<=0) then Exit;
 while (I<=SLen) and (Count<>N) do begin
  {skip over delimiters}
  while (I<=SLen) and (S[I] in WordDelims) do Inc(I);
  {if we're not beyond end of S, we're at the start of a word}
  if (I<=SLen) then Inc(Count);
  {find the end of the current word}
  while (I<=SLen) and not (S[I] in WordDelims) do begin
   {if this is the N'th word, remember Pos and Len}
   if (Count=N) then begin
    if (Pos=0) then Pos:=I;
    Inc(Len);
   end;
   Inc(I);
  end;
 end;
 if (Pos>0) and (Len>0) then Result:=Copy(S,Pos,Len);
end;

{
function SkipWords(n:Integer; const s:LongString; const ScanSpaces:TCharSet):LongString;
 function SkipLeft(const s:LongString):LongString;
 var P:Integer;
 begin
  P:=Pos(ExtractWord(1,s,ScanSpaces),s);
  if P>0 then SkipLeft:=Copy(s,P,MaxInt) else SkipLeft:='';
 end;
 function SkipWord(const w,s:LongString):LongString;
 var P,L:Integer;
 begin
  L:=Length(w);
  if L>0 then P:=Pos(w,s) else P:=0;
  if P>0 then SkipWord:=SkipLeft(Copy(s,P+L+1,MaxInt)) else SkipWord:='';
 end;
begin
 if (n>0) and (Length(s)>0)
 then SkipWords:=SkipWords(n-1,SkipWord(ExtractWord(1,s,ScanSpaces),s),ScanSpaces)
 else SkipWords:=s;
end;
}
function SkipWords(n:Integer; const s:LongString; const ScanSpaces:TCharSet):LongString;
var i,len:SizeInt;
begin
 Result:='';
 len:=Length(s);
 if (n>0) and (len>0) then begin
  i:=1;
  while (i<=len) and (n>=0) do begin
   while (i<=len) do if (s[i] in ScanSpaces) then inc(i) else Break;       // Skip lead spaces
   if (i<=len) and (n=0) then begin Result:=Copy(s,i,len-i+1); Break; end; // Result found
   while (i<=len) do if (s[i] in ScanSpaces) then Break else inc(i);       // Skip a word
   dec(n);
  end;
 end else Result:=s;
end;

function WordIndex(const Name,Str:LongString; const Delims:TCharSet; CaseSensitive:Boolean=false):Integer;
var i:Integer; Match:Boolean;
begin
 Result:=0;
 for i:=1 to WordCount(Str,Delims) do begin
  if CaseSensitive
  then Match:=IsSameStr(ExtractWord(i,Str,Delims),Name)
  else Match:=IsSameText(ExtractWord(i,Str,Delims),Name);
  if Match then begin
   Result:=i;
   Break;
  end;
 end;
end;

function ExtractInt(N:Integer; const S:LongString; const WordDelims:TCharSet; var Value:LongInt):Boolean;
begin
 Result:=Str2Long(ExtractWord(N,S,WordDelims),Value);
end;

function ExtractReal(N:Integer; const S:LongString; const WordDelims:TCharSet; var Value:Double):Boolean;
begin
 Result:=Str2Real(ExtractWord(N,S,WordDelims),Value);
end;

 {
 *****************************
 Numeric to string conversion.
 *****************************
 }
const
 Digits:packed array[0..$F] of Char = Abc_Hex_Table;

function BinB(x:Byte):LongString;
const
 nbit = 1;
 mask = (1 shl nbit)-1;
 leng = (sizeof(x)*8+nbit-1) div nbit;
var
 i : Integer;
begin
 Result:='';
 SetLength(Result,leng);
 for i:=0 to leng-1 do begin
  Result[leng-i]:=Digits[x and mask];
  x:=x shr nbit;
 end;
end;

function BinW(x:Word):LongString;
const
 nbit = 1;
 mask = (1 shl nbit)-1;
 leng = (sizeof(x)*8+nbit-1) div nbit;
var
 i : Integer;
begin
 Result:='';
 SetLength(Result,leng);
 for i:=0 to leng-1 do begin
  Result[leng-i]:=Digits[x and mask];
  x:=x shr nbit;
 end;
end;

function BinL(x:LongWord):LongString;
const
 nbit = 1;
 mask = (1 shl nbit)-1;
 leng = (sizeof(x)*8+nbit-1) div nbit;
var
 i : Integer;
begin
 Result:='';
 SetLength(Result,leng);
 for i:=0 to leng-1 do begin
  Result[leng-i]:=Digits[x and mask];
  x:=x shr nbit;
 end;
end;

function OctB(x:Byte):LongString;
const
 nbit = 3;
 mask = (1 shl nbit)-1;
 leng = (sizeof(x)*8+nbit-1) div nbit;
var
 i : Integer;
begin
 Result:='';
 SetLength(Result,leng);
 for i:=0 to leng-1 do begin
  Result[leng-i]:=Digits[x and mask];
  x:=x shr nbit;
 end;
end;

function OctW(x:Word):LongString;
const
 nbit = 3;
 mask = (1 shl nbit)-1;
 leng = (sizeof(x)*8+nbit-1) div nbit;
var
 i : Integer;
begin
 Result:='';
 SetLength(Result,leng);
 for i:=0 to leng-1 do begin
  Result[leng-i]:=Digits[x and mask];
  x:=x shr nbit;
 end;
end;

function OctL(x:LongInt):LongString;
const
 nbit = 3;
 mask = (1 shl nbit)-1;
 leng = (sizeof(x)*8+nbit-1) div nbit;
var
 i : Integer;
begin
 Result:='';
 SetLength(Result,leng);
 for i:=0 to leng-1 do begin
  Result[leng-i]:=Digits[x and mask];
  x:=x shr nbit;
 end;
end;

function HexB(x:Byte):LongString;
const
 nbit = 4;
 mask = (1 shl nbit)-1;
 leng = (sizeof(x)*8+nbit-1) div nbit;
var
 i : Integer;
begin
 Result:='';
 SetLength(Result,leng);
 for i:=0 to leng-1 do begin
  Result[leng-i]:=Digits[x and mask];
  x:=x shr nbit;
 end;
end;

function HexW(x:Word):LongString;
const
 nbit = 4;
 mask = (1 shl nbit)-1;
 leng = (sizeof(x)*8+nbit-1) div nbit;
var
 i : Integer;
begin
 Result:='';
 SetLength(Result,leng);
 for i:=0 to leng-1 do begin
  Result[leng-i]:=Digits[x and mask];
  x:=x shr nbit;
 end;
end;

function HexL(x:LongWord):LongString;
const
 nbit = 4;
 mask = (1 shl nbit)-1;
 leng = (sizeof(x)*8+nbit-1) div nbit;
var
 i : Integer;
begin
 Result:='';
 SetLength(Result,leng);
 for i:=0 to leng-1 do begin
  Result[leng-i]:=Digits[x and mask];
  x:=x shr nbit;
 end;
end;

function Long2Str(L:LongInt):LongString;
begin
 Str(L,Result);
end;

function Real2Str(R:Double; Width:Integer=0; Places:Integer=0):LongString;
begin
 if (Width=0) and (Places=0) then Str(R,Result) else Str(R:Width:Places,Result);
end;

function d2s(d:LongInt; Width:Integer=0):LongString;
begin
 Str(d,Result);
 if abs(Width)>Length(Result) then
 if Width>0 then Result:=LeftPad(Result,Width) else Result:=Pad(Result,-Width);
end;

type
 Tf2sFormat = packed record Width,Decimals : Integer; end;

const
 f2sCurrFormat : Tf2sFormat = (Width:f2sWidthDefault; Decimals:f2sDigitsDefault);
 f2sSaveFormat : Tf2sFormat = (Width:f2sWidthDefault; Decimals:f2sDigitsDefault);

function f2s(f:Double):LongString;
begin
 with f2sCurrFormat do Result:=FormatG(f,Width,Decimals);
end;

procedure f2sFormat(Width:Integer=f2sWidthDefault; Decimals:Integer=f2sDigitsDefault);
begin
 f2sSaveFormat:=f2sCurrFormat;
 f2sCurrFormat.Width:=Width;
 f2sCurrFormat.Decimals:=Decimals;
end;

procedure f2sFormatOld;
begin
 with f2sSaveFormat do f2sFormat(Width,Decimals);
end;

{-$DEFINE FORMATG_FROM_FPC}
{$IFDEF FORMATG_FROM_FPC}
function FormatG(X:Double; w:Integer; d:Integer):LongString;
begin
 Result:=Format('%*.*G', [w,d+1,X]);
end;
{$ELSE FORMATG_FROM_FPC}
function FormatG(X:Double; w:Integer; d:Integer):LongString;
label
 Quit;
var
 ln10 : Extended;   { log(10,X) }
 xAbs : Extended;   { Abs(X)    }
 xMan : Extended;   { Mantissa  }
 sMan : String[40]; { Mantissa as string}
 xPow : Integer;    { power }
 sPow : String[20]; { power as string }
 xInt : LongInt;    { x as integer }
 p    : Integer;    { point position }
begin
 {
 Special case - NAN,INF
 }
 if isNAN(X) then begin
  Result:='NAN';
  goto Quit;
 end;
 if isINF(X) then begin
  if X>0 then Result:='+INF' else Result:='-INF';
  goto Quit;
 end;
 {
 if this is integer, including zero, then convert as integer
 }
 if (X>=low(xInt)) and (X<=high(xInt)) then begin
  xInt:=round(X);
  if X=xInt then begin
   str(xInt,Result);
   goto Quit;
  end;
 end;
 {
 find power and scale
 }
 xAbs:=abs(X);
 ln10:=ln(10.0);
 xPow:=round(ln(xAbs)/ln10);
 case xPow of
  -3..-1:
       begin
         inc(d,-xPow);
         xPow:=0;
         xMan:=X;
       end;
  0..4:
       begin
        xPow:=0;
        xMan:=X;
       end;
  else begin
        xMan:=X/exp(xPow*ln10);
        if abs(xMan)<1-exp(-(d*ln10)) then begin
         dec(xPow);
         xMan:=X/exp(xPow*ln10);
        end;
       end;
 end;
 str(xMan:0:d,sMan);
 p:=pos('.',sMan);
 if p>0 then
 while (ord(sMan[0])>p) and (sMan[ord(sMan[0])]='0') do dec(sMan[0]);
 while (ord(sMan[0])>1) and (sMan[ord(sMan[0])]='.') do dec(sMan[0]);
 {
 Add power string, pass if zero power.
 }
 if xPow=0 then sPow:='' else begin
  str(xPow,sPow);
  sPow:='E'+sPow;
 end;
 {
 Merge and padding width
 }
 Result:=sMan+sPow;
Quit:
 if abs(w)>Length(Result) then
 if w>0 then Result:=LeftPad(Result,w) else Result:=Pad(Result,-w);
end;
{$ENDIF FORMATG_FROM_FPC}

 {
 ****************************
 String to Numeric conversion
 ****************************
 }
var
 CharToNumber : packed array [Char] of Byte;

procedure InitCharToNumber;
begin
 SafeFillChar(CharToNumber,sizeof(CharToNumber),$FF);
 CharToNumber['0']:=$0;
 CharToNumber['1']:=$1;
 CharToNumber['2']:=$2;
 CharToNumber['3']:=$3;
 CharToNumber['4']:=$4;
 CharToNumber['5']:=$5;
 CharToNumber['6']:=$6;
 CharToNumber['7']:=$7;
 CharToNumber['8']:=$8;
 CharToNumber['9']:=$9;
 CharToNumber['A']:=$A; CharToNumber['a']:=$A;
 CharToNumber['B']:=$B; CharToNumber['b']:=$B;
 CharToNumber['C']:=$C; CharToNumber['c']:=$C;
 CharToNumber['D']:=$D; CharToNumber['d']:=$D;
 CharToNumber['E']:=$E; CharToNumber['e']:=$E;
 CharToNumber['F']:=$F; CharToNumber['f']:=$F;
end;

function atoi(a:PChar; out i:LongInt):Boolean;
const
 nbit = 4;
 mask = (1 shl nbit)-1;
 leng = (sizeof(i)*8+nbit-1) div nbit;
var
 p,len:Integer;
begin
 Result:=false;
 if Assigned(a) then
 if a[0]='$' then begin          { if $ is first char, hex value expected }
  inc(a);                        { pass $ char }
  i:=0;
  len:=0;
  while a[0] <> #0 do begin
   p:=CharToNumber[a[0]];
   if p>mask then Break;
   i:=(i shl nbit)+p;
   inc(a);
   inc(len);
  end;
  Result:=(len in [1..leng]) and (p in [0..mask]);
 end else begin                  { decimal value expected }
  val(a,i,p);
  Result:=(p=0);
 end;
 if not Result then i:=0;
end;

function atof(a:PChar; out f:Double):Boolean;
var p:Integer;
begin
 Result:=false;
 if Assigned(a) then
 if a[0]='$' then begin  {hex-value}
  Result:=atoi(a,p);
  f:=p;
 end else begin          {decimal value}
  val(a,f,p);
  Result:=(p=0);
 end;
 if not Result then f:=0;
end;

function Str2Int(const S:LongString; out I:Integer):Boolean;
var code:Integer;
begin
 Val(Trim(S), I, code);
 if code <> 0 then I := code;
 Result := ( code = 0 );
end;

function Str2Word(const S:LongString; out I:Word):Boolean;
var code:Integer;
begin
 Val(Trim(S), I, code);
 if code <> 0 then I := code;
 Result := ( code = 0 );
end;

function Str2Long(const S:LongString; out I:LongInt):Boolean;
var code:Integer;
begin
 Val(Trim(S), I, code);
 if code <> 0 then I := code;
 Result := ( code = 0 );
end;

function Str2Real(const S:LongString; out R:Double):Boolean;
var code:Integer;
begin
 Val(Trim(S), R, code);
 if code <> 0 then R := code;
 Result := ( code = 0 );
end;

function SmartStr2Real(const S:LongString; var R:Double):Boolean;
var Temp:Double;
begin
 Result:=false;
 if Str2Real(S,Temp) then begin
  if (Format('%g',[Temp])<>Format('%g',[R])) then R:=Temp;
  Result:=true;
 end;
end;

function iValDef(const S:LongString; Def:Integer):Integer;
var code:Integer;
begin
 Val(Trim(S), Result, code);
 if code <> 0 then Result := Def;
end;

function iVal(const S:LongString):Integer;
var code:Integer;
begin
 Val(Trim(S), Result, code);
 if code <> 0 then Result := 0;
end;

function rValDef(const S:LongString; Def:Double):Double;
var code:Integer;
begin
 Val(Trim(S), Result, code);
 if code <> 0 then Result := Def;
end;

function rVal(const S:LongString):Double;
var code:Integer;
begin
 Val(Trim(S), Result, code);
 if code <> 0 then Result := _NaN;
end;

function StrBin2Long(const S:LongString; out L:LongInt):Boolean;
const
 nbit = 1;
 mask = (1 shl nbit)-1;
 leng = (sizeof(L)*8+nbit-1) div nbit;
var
 i,j,p,len:Integer;
begin
 i:=1;
 j:=length(S);
 while (i<=j) and (S[i]<=' ') do inc(i);
 while (i<=j) and (S[j]<=' ') do dec(j);
 p:=0;
 L:=0;
 len:=0;
 while i<=j do begin
  p:=CharToNumber[S[i]];
  if p>mask then Break;
  L:=(L shl nbit)+p;
  inc(i);
  inc(len);
 end;
 Result:=(len in [1..leng]) and (p in [0..mask]);
 if not Result then L:=0;
end;

function StrOct2Long(const S:LongString; out L:LongInt):Boolean;
const
 nbit = 3;
 mask = (1 shl nbit)-1;
 leng = (sizeof(L)*8+nbit-1) div nbit;
var
 i,j,p,len:Integer;
begin
 i:=1;
 j:=length(S);
 while (i<=j) and (S[i]<=' ') do inc(i);
 while (i<=j) and (S[j]<=' ') do dec(j);
 p:=0;
 L:=0;
 len:=0;
 while i<=j do begin
  p:=CharToNumber[S[i]];
  if p>mask then Break;
  L:=(L shl nbit)+p;
  inc(i);
  inc(len);
 end;
 Result:=(len in [1..leng]) and (p in [0..mask]);
 if not Result then L:=0;
end;

function StrHex2Long(const S:LongString; out L:LongInt):Boolean;
const
 nbit = 4;
 mask = (1 shl nbit)-1;
 leng = (sizeof(L)*8+nbit-1) div nbit;
var
 i,j,p,len:Integer;
begin
 i:=1;
 j:=length(S);
 while (i<=j) and (S[i]<=' ') do inc(i);
 while (i<=j) and (S[j]<=' ') do dec(j);
 p:=0;
 L:=0;
 len:=0;
 while i<=j do begin
  p:=CharToNumber[S[i]];
  if p>mask then Break;
  L:=(L shl nbit)+p;
  inc(i);
  inc(len);
 end;
 Result:=(len in [1..leng]) and (p in [0..mask]);
 if not Result then L:=0;
end;

function ScanVar(svMode:Cardinal; Str:PChar; const Format:LongString; var Data):PChar;
var
 p          : SizeInt;
 wi,words   : Integer;
 Prefix     : ShortString;
 ValStr     : ShortString;
 FormatWord : ShortString;
 DataPtr    : Pointer;
 VarType    : Char;
 PrefixBuf  : packed array[0..high(Byte)] of Char;
 L          : LongInt;
 D          : Double;
 OriginStr  : PChar;
 {
 Read expected chars to string
 }
 function ReadExpected(const Expected:TCharSet):Boolean;
 begin
  Result:=false;
  if Str=nil then exit;
  while (Str[0] in Expected) and (length(ValStr)<high(Byte)) do begin
   if Str[0] in [#0,ASCII_CR,ASCII_LF] then Break;
   ValStr:=ValStr+Str[0];
   Inc(Str,1);
  end;
  Result:=(length(ValStr)>0);
 end;
 {
 Check for lead and trail space chars, if need
 }
 function CheckSpaces:Boolean;
 var Left,Right:PChar;
 begin
  Result:=false;
  if Str=nil then exit;
  {
  If need check lead spaces. If Str is not start of text, then check previouse symbol
  If that is not space symbol, return false
  }
  if (svMode and svLSpace<>0) and (Str<>OriginStr) then begin
   Left:=Str;
   Dec(Left,1);
   if not (Left[0] in ScanSpaces) then exit;
  end;
  {
  If need check trail spaces. Pass prefix, then check symbol after prefix.
  If that is not space symbol, return false.
  }
  if (svMode and svRSpace<>0) then begin
   Right:=Str;
   Inc(Right,Length(Prefix));
   if not (Right[0] in ScanSpaces) then exit;
  end;
  Result:=true;
 end;
begin
 {
 Is it Ok with Str ?
 }
 Result:=nil;
 if (Str=nil) or (@Data=nil) then exit;
 {
 Initialization
 }
 DataPtr:=@Data;       { points to data record }
 OriginStr:=Str;       { fix original Str value - start of text }
 {
 Cycle on Format words
 }
 words:=WordCount(Format,ScanWordDelims);
 for wi:=1 to words do begin
  {
  Init cycle vars and extract word of format
  }
  Prefix :='';
  ValStr :='';
  FormatWord:=ExtractWord(wi,Format,ScanWordDelims);
  {
  Extract Format word to prefix and type char
  Prefix uses to search data, type char define the type of data
  }
  p:=pos('%',FormatWord);                 { find pos of format marker % }
  if p=0 then exit;                       { marker % not found, break! }
  Prefix:=Trim(copy(FormatWord,1,p-1));   { extract prefix to search for }
  case (svMode and svCaseMask) of         { if need, convert prefix }
   svUpCase:Prefix:=UpCaseStr(Prefix);    { to lower case }
   svLoCase:Prefix:=LoCaseStr(Prefix);    { to upper case }
  end;
  if p+1>Length(FormatWord) then exit;    { no type identifier found }
  VarType:=UpCase(FormatWord[p+1]);       { this char identify type of data }
  {
  find prefix pos, if prefix not empty
  }
  if Prefix<>'' then begin                                   { if prefix exists }
   if (svMode and svOrigin<>0) then Str:=OriginStr;          { start search from text begin? }
   StrPCopy(PrefixBuf,Prefix);                               { prefix as PChar }
   while Str<>nil do begin                                   { search prefix cycle }
    if (svMode and svCaseMask)<>0
    then Str:=StrIPos(Str,PrefixBuf)                         { find prefix position, case sens off }
    else Str:=StrPos(Str,PrefixBuf);                         { find prefix position, case sens on  }
    if Str=nil then exit;                                    { prefix not found! }
    if StrLLen(Str,Length(Prefix))<Length(Prefix) then exit; { length of string too small! }
    if CheckSpaces then begin                                { if need, check lead and trail spaces }
     Inc(Str,Length(Prefix));                                { pass prefix }
     Break;                                                  { and break cycle, prefix found }
    end;
    Inc(Str,Length(Prefix));                                 { pass this, prefix, search next }
   end;
  end;
  if Str=nil then exit;                   {no such prefix!}
  if Str[0]=#0 then exit;                 {end of text!}
  {
  Read the variable with given format and seek to next data pointer
  }
  case VarType of
   'D','W','I': { pass spaces and read longint}
    begin
     Str:=StrPass(Str,ScanSpaces-[ASCII_CR,ASCII_LF]);
     case UpCase(Str[0]) of
      '$','X','H': {Hex value expected}
       begin
        Inc(Str,1);
        if not ReadExpected(['0'..'9','A'..'F','a'..'f']) or
           not StrHex2Long(ValStr,L) then exit;
       end;
      'B': {Bin value expected}
       begin
        Inc(Str,1);
        if not ReadExpected(['0','1']) or
           not StrBin2Long(ValStr,L) then exit;
       end;
      'O': {Oct value expected}
       begin
        Inc(Str,1);
        if not ReadExpected(['0'..'7']) or
           not StrOct2Long(ValStr,L) then exit;
       end;
      else begin {decimal value expected}
       if not ReadExpected(['+','-','0'..'9']) or
          not Str2Long(ValStr,L) then exit;
      end;
     end;
     case VarType of
      'D': begin
            LongInt(DataPtr^):=L;
            DataPtr:=IncPtr(DataPtr,sizeof(LongInt));
           end;
      'W': begin
            Word(DataPtr^):=L;
            DataPtr:=IncPtr(DataPtr,sizeof(Word));
           end;
      'I': begin
            Integer(DataPtr^):=L;
            DataPtr:=IncPtr(DataPtr,sizeof(Integer));
           end;
     end;
    end;
   'F': { pass spaces and read double }
    begin
     Str:=StrPass(Str,ScanSpaces-[ASCII_CR,ASCII_LF]);
     if not ReadExpected(['+','-','.','e','E','0'..'9']) or
        not Str2Real(ValStr,D) then exit;
     Double(DataPtr^):=D;
     DataPtr:=IncPtr(DataPtr,sizeof(Double));
    end;
   'B': { pass spaces and read boolean}
    begin
     Str:=StrPass(Str,ScanSpaces-[ASCII_CR,ASCII_LF]);
     case UpCase(Str[0]) of
      '0','N','F':Boolean(DataPtr^):=False;
      '1','Y','T':Boolean(DataPtr^):=True;
      else exit;
     end;
     Inc(Str,1);
     ReadExpected(WordSet); {skip other chars}
     DataPtr:=IncPtr(DataPtr,sizeof(Boolean));
    end;
   'A': { pass spaces and read regular word }
    begin
     Str:=StrPass(Str,ScanSpaces-[ASCII_CR,ASCII_LF]);
     if not ReadExpected([#1..#255]-ScanSpaces-[ASCII_CR,ASCII_LF]) then exit;
     ShortString(DataPtr^):=ValStr;
     DataPtr:=IncPtr(DataPtr,sizeof(ShortString));
    end;
   'S': { pass spaces and read string until end of text or end of line }
    begin
     Str:=StrPass(Str,ScanSpaces-[ASCII_CR,ASCII_LF]);      {? pass space chars}
     if not ReadExpected([#1..#255]-[ASCII_CR,ASCII_LF]) then exit;
     ShortString(DataPtr^):=ValStr;
     DataPtr:=IncPtr(DataPtr,sizeof(ShortString));
    end;
   'C': { pass spaces and read char }
    begin
     Str:=StrPass(Str,ScanSpaces-[ASCII_CR,ASCII_LF]); {? pass space chars}
     if Str[0]=#0 then exit;
     if Str[0]=ASCII_CR then exit;
     if Str[0]=ASCII_LF then exit;
     Char(DataPtr^):=Str[0];
     Inc(Str,1);
     DataPtr:=IncPtr(DataPtr,sizeof(Char));
    end;
   else exit;
  end;
 end;
 Result:=Str;
end;

function CookieScan(Buff:PChar; Size:SizeInt; const Name:LongString; Mode:Integer=csm_Default):LongString;
var lenline,lenname:SizeInt; line:PChar; c,no,Delim:Char; s,n,v:LongString;
 procedure ProcessLine;
 var p:SizeInt; found:Boolean;
 begin
  if (line<>nil) and (lenline>lenname) then begin
   SetString(s,line,lenline);
   p:=Pos('=',s);
   if p>lenname then begin
    n:=Copy(s,1,p-1); // Get name and compare with Name
    if (Mode and csm_SkipTrimN) = 0 then n:=SysUtils.Trim(n);
    if (Mode and csm_CaseSense) = 0 then found:=SameText(Name,n) else found:=(Name=n);
    if found then begin // Name was found, now get value
     v:=Copy(s,p+1,lenline-p); if (Mode and csm_SkipTrimV) = 0 then v:=SysUtils.Trim(v);
     no:=#0; // Mark success, i.e. clear "no expressions found" marker.
     c:=#0; // Should Break!
    end;
   end;
  end;
 end;
begin
 Result:='';
 if (Name<>'') then
 if Assigned(Buff) then
 try
  Delim:=Chr(Mode);
  s:=''; n:=''; v:='';
  no:=Chr(Mode shr 16);
  line:=nil; lenline:=0;
  lenname:=Length(Name);
  while Size>0 do begin
   c:=Buff[0];
   if (c=#0) or (c=ASCII_CR) or (c=ASCII_LF) or (c=Delim) then begin
    if (line<>nil) then ProcessLine;
    line:=nil; lenline:=0;
    if (c=#0) then Break;
   end else begin
    if (line=nil) then line:=Buff;
    inc(lenline);
   end;
   inc(Buff);
   dec(Size);
  end;
  if (line<>nil) then ProcessLine;
  if (v='') and (no<>#0) then v:=no;
  Result:=v; s:=''; n:=''; v:='';
 except
  on E:Exception do BugReport(E,nil,'CookieScan');
 end;
end;

function CookieScan(const Buff,Name:LongString; Mode:Integer=csm_Default):LongString;
begin
 if (Name<>'') and (Buff<>'')
 then Result:=CookieScan(PChar(Buff),Length(Buff),Name,Mode)
 else Result:='';
end;

 {
 **********************
 Files pathname parsing
 **********************
 }
function  IsEmptyStr(const S:LongString):Boolean;
var i:SizeInt;
begin
 Result:=false;
 for i:=1 to Length(S) do if (S[i]>' ') then Exit;
 Result:=true;
end;

function StringToSetOfChars(const S:LongString):TCharSet;
var i:SizeInt;
begin
 Result:=[];
 for i:=1 to Length(S) do Include(Result,S[i]);
end;

function SetOfCharsToString(const S:TCharSet):LongString;
var c:Char;
begin
 Result:='';
 for c:=Low(c) to High(c) do if (c in S) then Result:=Result+c;
end;

function HasChars(const S:LongString; const C:TCharSet):Boolean;
var i:SizeInt;
begin
 Result:=True;
 for i:=1 to Length(S) do if (S[i] in C) then Exit;
 Result:=False;
end;

function HasChars(const S:LongString; const C:LongString):Boolean;
begin
 Result:=HasChars(S,StringToSetOfChars(C));
end;

function  LastDelimiter(const Delimiters:TCharSet; const S:LongString):SizeInt;
begin
 Result:=Length(S);
 while (Result>0) do begin
  if (S[Result] in Delimiters) then Break;
  Dec(Result);
 end;
end;

function ValidatePathDelim(const FileName:LongString; Delim:Char=PathDelim):LongString;
var i:SizeInt;
begin
 Result:=Trim(FileName);
 for i:=1 to Length(Result) do begin
  if (Result[i]<>Delim) and (Result[i] in DirDelimiters)
  then Result[i]:=Delim;
 end;
end;

function AddBackSlash(const DirName:LongString; Delim:Char=PathDelim):LongString;
begin
 Result:=AddPathDelim(DirName,Delim);
end;

function AddPathDelim(const DirName:LongString; Delim:Char=PathDelim):LongString;
begin
 Result:=Trim(DirName);
 if (Delim in DirDelimiters) then
 if not (StrFetch(Result,Length(Result)) in DirDelimiters)
 then Result:=Result+Delim;
end;

function DropBackSlash(const DirName:LongString):LongString;
begin
 Result:=DropPathDelim(DirName);
end;

function DropPathDelim(const DirName:LongString):LongString;
var RLen:SizeInt; Match:Boolean;
begin
 Result:=Trim(DirName);
 RLen:=Length(Result); if (RLen=0) then Exit;
 Match:=(StrFetch(Result,RLen) in DirDelimiters);
 // For Windows, C:\ and \\ are valid path delimiters
 if (StrFetch(Result,RLen-1) in DosDelimiters) then Match:=false;
 if Match then Result:=Copy(Result,1,RLen-1);
end;

function IsWildCard(const FileName:LongString):Boolean;
begin
 Result:=(LastDelimiter(['*','?'],FileName)>0);
end;

function IsRelativePath(const S:LongString):Boolean;
var i:SizeInt;
begin
 Result:=false;
 for i:=1 to length(S) do begin                { relative path is \??? or ?:??? }
  if S[i]<=' ' then continue;                  { pass leading spaces }
  if S[i] in DirDelimiters then exit;          { first char "\" or "/" means root directory }
  if (i<Length(S)) and (S[i+1]=':') then exit; { second char ":" means drive specified }
  Result:=true;                                { other first char means relative path }
  Break;
 end;
end;

function HasExtension(const Name:LongString; out DotPos:SizeInt):Boolean;
var DosDel:SizeInt; CurrentDir,ParentDir:Boolean;
begin
 Result:=false;
 DotPos:=LastDelimiter(['.'],Name);            { find last pos of dot }
 if (DotPos>0) then begin                      { if found, extension may exist }
  DosDel:=LastDelimiter(DosDelimiters,Name);   { find last pos of backslash }
  if (DotPos>DosDel) then begin                { dot must be after backslash }
   { special check for "\." and "\.." case }
   CurrentDir:=(DotPos=DosDel+1) and IsEmptyStr(Copy(Name,DotPos+1,Length(Name)-DotPos));
   ParentDir:=(DotPos>1) and (Name[Pred(DotPos)]='.');
   Result:=not (CurrentDir or ParentDir);
  end;
 end;
end;

function HasExtension(const Name:LongString):Boolean;
var i:SizeInt;
begin
 Result:=HasExtension(Name,i);
end;

function DefaultExtension(const Name,Ext:LongString):LongString;
var DotPos:SizeInt; Dot:String[3];
begin
 Result:=Trim(Name);
 if not HasExtension(Result,DotPos) then begin
  if (not IsEmptyStr(Ext)) and (Pos('.',Trim(Ext))<>1) then Dot:='.' else Dot:='';
  Result:=Result+Dot+Trim(Ext);
 end;
end;

function DefaultPath(const Name,Path:LongString):LongString;
begin
 Result:=Trim(Name);
 if IsRelativePath(Result) and not (IsEmptyStr(Result) or IsEmptyStr(Path))
 then Result:=AddPathDelim(Path)+Result;
end;

function ForceExtension(const Name,Ext:LongString):LongString;
var DotPos:SizeInt; Dot:String[3];
begin
 Result:=Trim(Name);
 if HasExtension(Name,DotPos) then Result:=Copy(Result,1,DotPos-1);
 if (not IsEmptyStr(Ext)) and (Pos('.',Trim(Ext))<>1) then Dot:='.' else Dot:='';
 Result:=Result+Dot+Trim(Ext);
end;

function ForcePath(const NewPath,Name:LongString):LongString;
var SlashPos:SizeInt;
begin
 SlashPos:=LastDelimiter(DosDelimiters,Name);
 Result:=AddPathDelim(NewPath)+Trim(Copy(Name,Succ(SlashPos),Length(Name)-SlashPos));
end;

function ExtractFileNameExt(const FileName: LongString):LongString;
var i,j:SizeInt;
begin
 i:=LastDelimiter(DosDelimiters,FileName)+1;
 j:=Length(FileName);
 Result:=Trim(Copy(FileName,i,j-i+1));
end;

function ExtractFileName(const FileName: LongString):LongString;
var i,j:SizeInt;
begin
 i:=LastDelimiter(DosDelimiters,FileName)+1;
 if HasExtension(FileName,j) then dec(j) else j:=Length(FileName);
 Result:=Trim(Copy(FileName,i,j-i+1));
end;

function ExtractBaseName(const FileName: LongString):LongString;
var i,j:SizeInt;
begin
 i:=LastDelimiter(DosDelimiters,FileName)+1;
 if HasExtension(FileName,j) then dec(j) else j:=Length(FileName);
 Result:=Trim(Copy(FileName,i,j-i+1));
end;

function ExtractFileExt(const FileName: LongString): LongString;
var DotPos:SizeInt;
begin
 if HasExtension(FileName,DotPos)
 then Result:=Trim(Copy(FileName,DotPos,Length(FileName)-DotPos+1))
 else Result:='';
end;

function ExtractFilePath(const FileName: LongString): LongString;
begin
 Result:=DropPathDelim(Copy(FileName,1,LastDelimiter(DosDelimiters,FileName)));
end;

function ExtractFileDir(const FileName: LongString): LongString;
begin
 Result:=DropPathDelim(Copy(FileName,1,LastDelimiter(DosDelimiters,FileName)));
end;

function ExtractFileDrive(FileName: LongString): LongString;
var
 I, J: SizeInt;
begin
 FileName:=Trim(FileName);
 if (Length(FileName)>=2) and IsLexeme(FileName[1],lex_Alpha) and (FileName[2]=':')
 then Result:=Copy(FileName,1,2)
 else
 if (Length(FileName)>=2) and
    (FileName[1] in DirDelimiters) and
    (FileName[2] = FileName[1])
 then begin
  J:=0;
  I:=3;
  while (I<Length(FileName)) and (J<2) do begin
   if FileName[I] in DirDelimiters then Inc(J);
   if J<2 then Inc(I);
  end;
  if FileName[I] in DirDelimiters then Dec(I);
  Result:=Copy(FileName, 1, I);
 end else Result:='';
end;

function ExtractFilterExt(const Filter:LongString; Index:Integer):LongString;
var
 T : TText;
begin
 Result:='';
 try
  T:=NewText;
  try
   T.Text:=StringReplace(Filter,'|',EOL,[rfReplaceAll]);
   Result:=UnifyAlias(ExtractFileExt(ExtractWord(1,T[Index*2-1],[';'])));
  finally
   Kill(T);
  end;
 except
  on E:Exception do BugReport(E,nil,'ExtractFilterExt');
 end;
end;

function FExpand(const Path: LongString):LongString;
var MatchFound:TFileNameCaseMatch;
begin
 Result:=ValidatePathDelim(Trim(Path));
 if IsFileNameCaseSensitive
 then Result:=ExpandFileNameCase(Result,MatchFound)
 else Result:=ExpandFileName(Result);
end;

(*
function MakeRelativePath(const Path,Base:LongString):LongString;
begin
 Result:=sysutils.ExtractRelativePath(Trim(Base),Trim(Path));
end;
*)

function MakeRelativePath(const Path,Base:LongString):LongString;
var i,p:SizeInt; TheBas:LongString;
begin
 if IsEmptyStr(Base) then Result:=UnifyFileAlias(Path) else begin
  Result:=UnifyFileAlias(Path);
  TheBas:=AddPathDelim(ExtractFilePath(UnifyFileAlias(Base)));
  p:=0;
  for i:=1 to min(length(Result),length(TheBas)) do begin
   if Result[i]<>TheBas[i] then Break;
   if TheBas[i] in DirDelimiters then p:=i;
  end;
  if p>3 then begin
   Delete(TheBas,1,p);
   Delete(Result,1,p);
   for i:=1 to WordCount(TheBas,DirDelimiters) do Result:='..'+PathDelim+Result;
  end;
  if not IsSameFileName(DefaultPath(Result,ExtractFilePath(Base)),Path)
  then Result:=UnifyFileAlias(Path);
 end;
end;

function HasListedExtension(const Path,PathExt:LongString; Delim:Char=PathSep; Spaces:TCharSet=JustSpaces):Boolean;
begin
 Result:=false;
 if IsEmptyStr(Path) then Exit;
 if IsEmptyStr(PathExt) then Exit;
 if not HasExtension(Path) then Exit;
 Result:=(WordIndex(UpCaseStr(TrimChars(ExtractFileExt(Path),Spaces,Spaces)),UpCaseStr(PathExt),Spaces+[Delim])>0);
end;

{
 ************************************************************
 String allocation functions and other utilites uses by TText
 ************************************************************
 }
function AdjustStrSize(const S:ShortString):Integer;
begin
 Result:=((Length(S)+(1 shl AdjustStrBits)) shr AdjustStrBits) shl AdjustStrBits;
end;

procedure StrSet(var P:PShortString; const S:ShortString);
var Temp:PShortString;
begin
 if S='' then Temp:=nil else
 try
  GetMem(Temp,AdjustStrSize(S));
  if Assigned(Temp) then Temp^:=S;
 except
  on E:Exception do begin
   BugReport(E,nil,'StrSet');
   Temp:=nil;
  end;
 end;
 P:=Temp;
end;

procedure StrReset(var P:PShortString; const S:ShortString);
var Temp:PShortString;
begin
 try
  if P = nil then StrSet(P, S) else begin
   if (S<>'') and (AdjustStrSize(P^)=AdjustStrSize(S))
   then P^:=S
   else begin
    Temp:=P;
    StrSet(P,S);
    if Assigned(Temp) then FreeMem(Temp, AdjustStrSize(Temp^));
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'StrReset');
 end;
end;

procedure StrAssign(var S:ShortString; P:PShortString);
begin
 try
  if Assigned(P) then S:=P^ else S:='';
 except
  on E:Exception do BugReport(E,nil,'StrAssign');
 end;
end;

 {
 *******************************************************
 TText, collection of strings. Thread safety and simple.
 *******************************************************
 }
constructor TText.Create(aCapacity : LongInt = DefaultTTextCapacity;
                         aStep     : LongInt = DefaultTTextStep);
begin
 inherited Create;
 myItems:=nil;
 myCount:=0;
 myStep:=max(1,aStep);
 Capacity:=aCapacity;
end;

destructor TText.Destroy;
begin
 Capacity:=0;
 inherited Destroy;
end;

function TText.GetStep:LongInt;
begin
 Result:=0;
 if Assigned(Self) then begin
  Lock;
  Result:=myStep;
  Unlock;
 end;
end;

procedure TText.SetStep(NewStep:LongInt);
begin
 if Assigned(Self) then begin
  Lock;
  myStep:=max(1,NewStep);
  Unlock;
 end;
end;

function TText.GetCount:LongInt;
begin
 Result:=0;
 if Assigned(Self) then begin
  Lock;
  Result:=myCount;
  Unlock;
 end;
end;

procedure TText.SetCount(NewCount:LongInt);
var i:LongInt;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   NewCount:=max(0,NewCount);
   for i:=NewCount to myCount-1 do StrReset(PShortString(myItems[i]),'');
   for i:=myCount to Capacity-1 do myItems[i]:=nil;
   if NewCount>Capacity then Capacity:=AdjustBufferSize(NewCount,myStep);
   myCount:=min(NewCount,Capacity);
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorReport(E,'SetCount');
 end;
end;

function TText.GetCapacity:LongInt;
begin
 Result:=0;
 if Assigned(Self) then begin
  Lock;
  Result:=AllocSize(myItems) div sizeof(myItems[0]);
  Unlock;
 end;
end;

procedure TText.SetCapacity(NewCapacity:LongInt);
var
 NewCount : LongInt;
 i        : LongInt;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   NewCapacity:=max(NewCapacity,0);
   NewCapacity:=min(NewCapacity,High(NewCapacity) div sizeof(myItems[0]));
   if NewCapacity<>Capacity then begin
    NewCount:=min(myCount,NewCapacity);
    for i:=NewCount to myCount-1 do StrReset(PShortString(myItems[i]),'');
    for i:=myCount to Capacity-1 do myItems[i]:=nil;
    Reallocate(Pointer(myItems),NewCapacity*sizeof(myItems[0]));
    myCount:=min(NewCount,Capacity);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorReport(E,'SetCapacity');
 end;
end;

function TText.GetLn( NumLn:LongInt ): ShortString;
begin
 Result:='';
 if Assigned(Self) then begin
  Lock;
  if (NumLn>=0) and (NumLn<myCount) then StrAssign(Result,myItems[NumLn]);
  Unlock;
 end;
end;

procedure TText.PutLn( NumLn:LongInt; const aLine: ShortString );
begin
 if Assigned(Self) then begin
  Lock;
  if NumLn=myCount then InsLn(NumLn,aLine) else
  if (NumLn>=0) and (NumLn<myCount)
  then StrReset(PShortString(myItems[NumLn]),aLine);
  Unlock;
 end;
end;

procedure TText.DelLn( NumLn:LongInt );
var Tail:LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  if (NumLn>=0) and (NumLn<myCount) then begin
   StrReset(PShortString(myItems[NumLn]),'');
   Tail:=myCount-NumLn-1;
   SafeMove(myItems[NumLn+1], myItems[NumLn], Tail*sizeof(myItems[0]));
   myItems[myCount-1]:=nil;
   dec(myCount);
  end;
  Unlock;
 end;
end;

procedure TText.InsLn( NumLn:LongInt; const aLine: ShortString);
var Tail:LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  if (NumLn>=0) and (NumLn<=myCount) then begin
   Capacity:=max(Capacity,AdjustBufferSize(myCount+1,myStep));
   if Capacity>myCount then begin
    Tail:=myCount-NumLn;
    SafeMove(myItems[NumLn], myItems[NumLn+1], Tail*sizeof(myItems[0]));
    StrSet(PShortString(myItems[NumLn]),aLine);
    inc(myCount);
   end;
  end;
  Unlock;
 end;
end;

procedure TText.AddLn( const aLine: ShortString );
begin
 if Assigned(Self) then begin
  Lock;
  InsLn(myCount,aLine);
  Unlock;
 end;
end;

procedure TText.ForEach(Action:TTextForEachAction; CustomData:Pointer; Backward:Boolean=false);
var
 Index      : LongInt;
 Terminated : Boolean;
begin
 if Assigned(Self) and Assigned(Action) then
 try
  Lock;
  try
   Terminated:=false;
   if Backward then begin
    Index:=Count-1;
    while (Index>=0) and not Terminated do begin
     Action(Index,Line[Index],Terminated,CustomData);
     dec(Index);
    end;
   end else begin
    Index:=0;
    while (Index<Count) and not Terminated do begin
     Action(Index,Line[Index],Terminated,CustomData);
     inc(Index);
    end;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorReport(E,'ForEach');
 end;
end;

procedure AddLineLengthMax(Index:LongInt; const TextLine:ShortString;
                  var Terminate:Boolean; CustomData:Pointer);
begin
 LongInt(CustomData^):=max(LongInt(CustomData^),Length(TextLine));
end;

function TText.MaxLength:LongInt;
begin
 Result:=0;
 if Assigned(Self) then ForEach(AddLineLengthMax,@Result);
end;

procedure AddLineMem(Index:LongInt; const TextLine:ShortString;
                 var Terminate:Boolean; CustomData:Pointer);
begin
 if TextLine<>''  then inc(LongInt(CustomData^),AdjustStrSize(TextLine));
end;

function TText.MemUsed:LongInt;
begin
 Result:=0;
 if Assigned(Self) then begin
  ForEach(AddLineMem,@Result);
  inc(Result,Capacity*sizeof(Pointer));
 end;
end;

procedure ConcatLine(Index:LongInt; const TextLine:ShortString;
                 var Terminate:Boolean; CustomData:Pointer);
begin
 TText(CustomData).Addln(TextLine);
end;

procedure TText.Concat(aText:TText);
begin
 aText.ForEach(ConcatLine,Self);
end;

procedure TText.Copy(aText:TText);
begin
 Count:=0;
 Concat(aText);
end;

type
 TAddLineRec = packed record
  Counter : Integer;
  DataPtr : PChar;
 end;

procedure AddLineEOLN(Index:LongInt; const TextLine:ShortString;
                  var Terminate:Boolean; CustomData:Pointer);
 procedure AddStr(const Str:ShortString);
 begin
  if (Str<>'') then
  with TAddLineRec(CustomData^) do begin
   if Assigned(DataPtr) then SafeMove(Str[1],DataPtr[Counter],Length(Str));
   inc(Counter,Length(Str));
  end;
 end;
begin
 AddStr(TextLine);
 AddStr(EOL);
end;

function TText.GetText:LongString;
var AddLineRec:TAddLineRec;
begin
 Result:='';
 if Assigned(Self) then
 try
  Lock;
  try
   AddLineRec.Counter:=0;
   AddLineRec.DataPtr:=nil;
   ForEach(AddLineEOLN,@AddLineRec);
   if AddLineRec.Counter>0 then begin
    SetLength(Result,AddLineRec.Counter);
    if Length(Result)=AddLineRec.Counter then begin
     AddLineRec.Counter:=0;
     AddLineRec.DataPtr:=Pointer(Result);
     ForEach(AddLineEOLN,@AddLineRec);
    end;
   end;
  finally
   UnLock;
  end;
 except
  on E:Exception do begin
   ErrorReport(E,'GetText');
   Result:='';
  end;
 end;
end;

procedure TText.SetText(const aText:LongString);
var i:SizeInt; c,cp:Char; s:LongString;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   Count:=0;
   s:=''; cp:=#0;
   for i:=1 to Length(aText) do begin
    c:=aText[i];
    case c of
     #0       : Break;
     ASCII_LF : if (cp<>ASCII_CR) then begin AddLn(s); s:=''; end;
     ASCII_CR : if (cp<>ASCII_LF) then begin AddLn(s); s:=''; end;
     else       s:=s+c;
    end;
    cp:=c;
   end;
   if s<>'' then Addln(s);
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorReport(E,'SetText');
 end;
end;

procedure TText.Read(var F:Text);
var IORes:Integer; s:LongString;
begin
 if Assigned(Self) then
 try
  IORes:=IOResult;
  Lock;
  try
   while (IORes=0) and not System.Eof(F) do begin
    System.Readln(F,s);
    IORes:=IOResult;
    if IORes=0 then Addln(s);
   end;
  finally
   Unlock;
   SetInOutRes(IORes);
  end;
 except
  on E:Exception do ErrorReport(E,'Read');
 end;
end;

function TText.ReadFile(const aFileName:ShortString; AppendMode:Boolean=false):Integer;
var F:System.Text; IORes:Integer;
begin
 Result:=0;
 if Assigned(Self) then
 if FileExists(aFileName) then
 try
  IORes:=IOResult;
  System.Assign(F,aFileName);
  System.Reset(F);
  try
   if not AppendMode then Count:=0;
   Read(F);
  finally
   System.Close(F);
   Result:=IOResult;
   SetInOutRes(IORes);
  end;
 except
  on E:Exception do ErrorReport(E,'ReadFile');
 end;
end;

procedure WriteLine(Index:LongInt; const TextLine:ShortString;
                var Terminate:Boolean; CustomData:Pointer);
var IORes:Integer;
begin
 IORes:=IOResult;
 if IORes=0 then writeln(Text(CustomData^),TextLine) else begin
  SetInOutRes(IORes);
  Terminate:=true;
 end;
end;

procedure TText.Write(var F:Text);
begin
 ForEach(WriteLine,@F);
end;

function TText.WriteFile(const aFileName:ShortString; AppendMode:Boolean=false):Integer;
var F:System.Text; IORes:Integer;
begin
 Result:=0;
 if Assigned(Self) then
 if not IsEmptyStr(aFileName) then
 try
  IORes:=IOResult;
  System.Assign(F,aFileName);
  if FileExists(aFileName) and AppendMode then System.Append(F) else System.Rewrite(F);
  try
   Write(F);
  finally
   System.Close(F);
   Result:=IOResult;
   SetInOutRes(IORes);
  end;
 except
  on E:Exception do ErrorReport(E,'WriteFile');
 end;
end;

procedure EchoTextLine(Index:LongInt; const TextLine:ShortString; var Terminate:Boolean; CustomData:Pointer);
begin
 Echo(TextLine);
end;

procedure TText.Echo;
begin
 ForEach(EchoTextLine,nil);
end;

procedure TText.UpCase;
var i:LongInt;
begin
 Lock;
 for i:=0 to Count-1 do Line[i]:=UpCaseStr(Line[i]);
 Unlock;
end;

procedure TText.LoCase;
var i:LongInt;
begin
 Lock;
 for i:=0 to Count-1 do Line[i]:=LoCaseStr(Line[i]);
 Unlock;
end;

procedure TText.WinToDos;
var i:LongInt;
begin
 Lock;
 for i:=0 to Count-1 do Line[i]:=WinToDosStr(Line[i]);
 Unlock;
end;

procedure TText.DosToWin;
var i:LongInt;
begin
 Lock;
 for i:=0 to Count-1 do Line[i]:=DosToWinStr(Line[i]);
 Unlock;
end;

procedure TText.WinToKoi;
var i:LongInt;
begin
 Lock;
 for i:=0 to Count-1 do Line[i]:=WinToKoiStr(Line[i]);
 Unlock;
end;

procedure TText.KoiToWin;
var i:LongInt;
begin
 Lock;
 for i:=0 to Count-1 do Line[i]:=KoiToWinStr(Line[i]);
 Unlock;
end;

function TText.FindLine(aLine:LongString; Mode:Integer=0):Integer;
var i:Integer; iLine:LongString; CaseSens,Inverted,TrimLead,TrimTail,Match:Boolean;
 procedure ApplyTrim(var S:LongString);
 begin
  if TrimLead and TrimTail then S:=Trim(S) else
  if TrimLead then S:=TrimLeft(S) else
  if TrimTail then S:=TrimRight(S);
 end;
begin
 Result:=-1;
 if Assigned(Self) then
 try
  Lock;
  try
   CaseSens:=HasFlags(Mode,tfl_CaseSens);
   Inverted:=HasFlags(Mode,tfl_Inverted);
   TrimLead:=HasFlags(Mode,tfl_TrimLead);
   TrimTail:=HasFlags(Mode,tfl_TrimTail);
   ApplyTrim(aLine);
   if Inverted then begin
    for i:=Count-1 downto 0 do begin
     iLine:=Line[i];
     ApplyTrim(iLine);
     if CaseSens
     then Match:=IsSameStr(iLine,aLine)
     else Match:=IsSameText(iLine,aLine);
     if Match then begin Result:=i; Break; end;
    end;
   end else begin
    for i:=0 to Count-1 do begin
     iLine:=Line[i];
     ApplyTrim(iLine);
     if CaseSens
     then Match:=IsSameStr(iLine,aLine)
     else Match:=IsSameText(iLine,aLine);
     if Match then begin Result:=i; Break; end;
    end;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'FindLine');
 end;
end;

type
 TFindVarRec = packed record
  Index   : LongInt;
  VarName : ShortString;
 end;

procedure FindVarLine(Index:LongInt; const TextLine:ShortString;
                  var Terminate:Boolean; CustomData:Pointer);
var i,VarPos,EquPos,VarLen:Integer;
begin
 VarLen:=Length(TFindVarRec(CustomData^).VarName);
 if VarLen=0 then exit;
 VarPos:=pos(TFindVarRec(CustomData^).VarName,UpCaseStr(TextLine));
 if VarPos=0 then exit;
 for i:=1 to VarPos-1 do if not (TextLine[i] in ScanSpaces) then exit;
 EquPos:=pos('=',TextLine);
 if EquPos<VarPos+VarLen then exit;
 for i:=VarPos+VarLen to EquPos-1 do if not (TextLine[i] in ScanSpaces) then exit;
 TFindVarRec(CustomData^).Index:=Index;
 Terminate:=true;
end;

function    TText.FindVar(const VarName:ShortString):Integer;
var FindVarRec:TFindVarRec;
begin
 Result:=-1;
 if Assigned(Self) and not IsEmptyStr(VarName) then
 try
  FindVarRec.Index:=-1;
  FindVarRec.VarName:=UnifyAlias(VarName);
  ForEach(FindVarLine,@FindVarRec);
  Result:=FindVarRec.Index;
 except
  on E:Exception do ErrorReport(E,'FindVar');
 end;
end;

function    TText.GetVar(const VarName:ShortString):ShortString;
var i:LongInt;
begin
 Result:='';
 if Assigned(Self) and not IsEmptyStr(VarName) then
 try
  Lock;
  try
   i:=FindVar(VarName);
   if i>=0 then Result:=Line[i];
   if Length(Result)>0
   then Result:=Trim(System.Copy(Result,System.Pos('=',Result)+1,255));
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorReport(E,'GetVar');
 end;
end;

procedure   TText.SetVar(const VarName:ShortString; const VarValue:ShortString);
var i:LongInt;
begin
 if Assigned(Self) and not IsEmptyStr(VarName) then
 try
  Lock;
  try
   i:=FindVar(VarName);
   if IsEmptyStr(VarValue) then begin
    if i>=0 then DelLn(i);
   end else begin
    if i<0 then i:=Count;
    Line[i]:=Trim(VarName)+' = '+Trim(VarValue);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorReport(E,'SetVar');
 end;
end;

procedure ConcatText(First,Second:TText); overload;
begin
 First.Concat(Second);
end;

procedure ConcatText(First:TText; const Second:LongString); overload;
var Temp:TText;
begin
 if Assigned(First) and (Length(Second)>0) then
 try
  Temp:=NewText;
  try
   Temp.Text:=Second;
   First.Concat(Temp);
  finally
   Kill(Temp);
  end;
 except
  on E:Exception do BugReport(E,nil,'ConcatText');
 end;
end;

function  NewText(aCapacity : LongInt = DefaultTTextCapacity;
                  aStep     : LongInt = DefaultTTextStep):TText;
begin
 Result:=nil;
 try
  Result:=TText.Create(aCapacity,aStep);
 except
  on E:Exception do BugReport(E,nil,'NewText');
 end;
end;

function  NewTextCopy(aTextToCopy : TText = nil;
                      aCapacity   : LongInt = DefaultTTextCapacity;
                      aStep       : LongInt = DefaultTTextStep):TText;
begin
 Result:=NewText(aCapacity,aStep);
 Result.Concat(aTextToCopy);
end;

function  NewTextRead(const aFileName : LongString = '';
                            aCapacity : LongInt = DefaultTTextCapacity;
                            aStep     : LongInt = DefaultTTextStep):TText;
begin
 Result:=NewText(aCapacity,aStep);
 if Result.ReadFile(aFileName)<>0 then Result.Count:=0;
end;

procedure Kill(var TheObject:TText); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

 {
 ******************************
 Simplified interface for TText
 ******************************
 }

function text_ref(txt:Integer):TText;
var Obj:TObject;
begin
 Obj:=ObjectRegistry[txt];
 if (Obj is TText) then Result:=TText(Obj) else Result:=nil;
end;

function text_new:TText;
begin
 Result:=NewText(0,16);
end;

function text_free(txt:Integer):Boolean;
var obj:TText;
begin
 Result:=false;
 obj:=text_ref(txt);
 if Assigned(obj) then begin
  Result:=true;
  Kill(obj);
 end;
end;

function text_getln(txt:Integer; i:Integer):LongString;
begin
 with text_ref(txt) do Result:=GetLn(i);
end;

function text_putln(txt:Integer; i:Integer; s:LongString):Boolean;
begin
 Result:=false;
 with text_ref(txt) do if Ok then begin Result:=true; PutLn(i,s); end;
end;

function text_insln(txt:Integer; i:Integer; s:LongString):Boolean;
begin
 Result:=false;
 with text_ref(txt) do if Ok then begin Result:=true; InsLn(i,s); end;
end;

function text_addln(txt:Integer; s:LongString):Boolean;
begin
 Result:=false;
 with text_ref(txt) do if Ok then begin Result:=true; AddLn(s); end;
end;

function text_delln(txt:Integer; i:Integer):Boolean;
begin
 Result:=false;
 with text_ref(txt) do if Ok then begin Result:=true; DelLn(i); end;
end;

function text_numln(txt:Integer):Integer;
begin
 with text_ref(txt) do Result:=Count;
end;

function text_tostring(txt:Integer):LongString;
begin
 with text_ref(txt) do Result:=Text;
end;

function text_fromstring(txt:Integer; s:LongString):Integer;
begin
 Result:=txt;
 with text_ref(txt) do if Ok then Text:=s;
end;

 {
 **********************************
 Routines for multilanguage support
 **********************************
 }
function RusEng(const Rus:LongString='';
                const Eng:LongString=''
                ):LongString;
begin
 case Language of
  lng_RUSSIAN : if Length(Rus)>0 then Result:=Rus else
                if Length(Eng)>0 then Result:=Eng else
                Result:='';
  lng_ENGLISH : if Length(Eng)>0 then Result:=Eng else
                if Length(Rus)>0 then Result:=Rus else
                Result:='';
  else          if Length(Eng)>0 then Result:=Eng else
                if Length(Rus)>0 then Result:=Rus else
                Result:='';
 end;
end;

 {
 *********************
 System error messages
 *********************
 }
function SysErrorMessage(ErrorCode: Integer): LongString;
begin
 Result:=SysUtils.SysErrorMessage(ErrorCode);
end;

function URL_Packed(const S:LongString; Mode:Integer; const AllowChars:TCharSet):LongString;
begin
 Result:=URL_Encode(S,Mode,AllowChars);
end;

function URL_Encode(const S:LongString; Mode:Integer; const AllowChars:TCharSet):LongString;
const
 HexChar:PChar='0123456789ABCDEF';
var
 i,n,L:SizeInt; Si:Char;
begin
 Result:='';
 try
  n:=0;
  i:=1;
  L:=Length(S);
  SetLength(Result,L*3+1);
  while i<=L do begin
   Inc(n);
   Si:=S[i];
   case Si of
    ' ' : if Mode and um_StrictSpace <> 0 then begin   // Convert Space to %20 or +
           Result[n]:='%';
           Result[n+1]:=HexChar[Byte(Si) shr 4];
           Result[n+2]:=HexChar[Byte(Si) and $F];
           Inc(n,2);
          end else begin
           Result[n]:='+';
          end;
    '%' : if Mode and um_StrictPercent <> 0 then begin // Convert % to %25 or %%
           Result[n]:='%';
           Result[n+1]:=HexChar[Byte(Si) shr 4];
           Result[n+2]:=HexChar[Byte(Si) and $F];
           Inc(n,2);
          end else begin
           Result[n]:='%';
           Result[n+1]:='%';
           Inc(n);
          end;
    '+' : begin                                        // Convert + to %2B
           Result[n]:='%';
           Result[n+1]:=HexChar[Byte(Si) shr 4];
           Result[n+2]:=HexChar[Byte(Si) and $F];
           Inc(n,2);
          end;
    'A'..'Z','a'..'z','*','@','.','_','-','0'..'9','$','!','''','(',')' : Result[n]:=Si;
    else if Si in AllowChars then Result[n]:=Si else begin
     Result[n]:='%';
     Result[n+1]:=HexChar[Byte(Si) shr 4];
     Result[n+2]:=HexChar[Byte(Si) and $F];
     Inc(n,2);
    end;
   end;
   Inc(i);
  end;
  SetLength(Result,n);
 except
  on E:Exception do begin
   Result:='';
   if Mode and um_Safe <> 0 then BugReport(E,nil,'URL_Encode') else Raise;
  end;
 end;
end;

function URL_Decode(const S:LongString; Mode:Integer):LongString;
const
 HexChar:PChar='0123456789ABCDEF';
var
 i,n,L,cl,ch:SizeInt; Si:Char;
begin
 Result:='';
 try
  n:=0;
  i:=1;
  L:=Length(S);
  SetLength(Result,L);
  while i<=L do begin
   Inc(n);
   Si:=S[i];
   case Si of
    '+': Result[n]:=' ';
    '%': if (i<L) and (S[i+1]='%') then begin {$IFOPT B+} $B- expected! {$ENDIF}
          Result[n]:='%';
          Inc(i);
         end else
         if i>L-2 then begin
          if Mode and um_StrictDecode <> 0 then begin
           n:=0;
           Break;
          end else Result[n]:=Si;
         end else begin
          ch:=Pos(UpCaseTable[S[i+1]],HexChar)-1;
          cl:=Pos(UpCaseTable[S[i+2]],HexChar)-1;
          if (ch>=0) and (cl>=0) then begin
           Result[n]:=Chr((ch shl 4) or cl);
           Inc(i,2);
          end else begin
           if Mode and um_Strict <> 0 then begin
            n:=0;
            Break;
           end else Result[n]:=Si;
          end;
         end;
    else Result[n]:=Si;
   end;
   Inc(i);
  end;
  SetLength(Result,n);
 except
  on E:Exception do begin
   Result:='';
   if Mode and um_Safe <> 0 then BugReport(E,nil,'URL_Decode') else Raise;
  end;
 end;
end;

function HTTP_StatusMessage(StatusCode:Integer):LongString;
begin
 case StatusCode of
  100: Result:='Continue';
  101: Result:='Switching Protocols';
  200: Result:='OK';
  201: Result:='Created';
  202: Result:='Accepted';
  203: Result:='Non-Authoritative Information';
  204: Result:='No Content';
  205: Result:='Reset Content';
  206: Result:='Partial Content';
  300: Result:='Multiple Choices';
  301: Result:='Moved Permanently';
  302: Result:='Moved Temporarily';
  303: Result:='See Other';
  304: Result:='Not Modified';
  305: Result:='Use Proxy';
  400: Result:='Bad Request';
  401: Result:='Unauthorized';
  402: Result:='Payment Required';
  403: Result:='Forbidden';
  404: Result:='Not Found';
  405: Result:='Method Not Allowed';
  406: Result:='Not Acceptable';
  407: Result:='Proxy Authentication Required';
  408: Result:='Request Time-out';
  409: Result:='Conflict';
  410: Result:='Gone';
  411: Result:='Length Required';
  412: Result:='Precondition Failed';
  413: Result:='Request Entity Too Large';
  414: Result:='Request-URI Too Large';
  415: Result:='Unsupported Media Type';
  500: Result:='Internal Server Error';
  501: Result:='Not Implemented';
  502: Result:='Bad Gateway';
  503: Result:='Service Unavailable';
  504: Result:='Gateway Time-out';
  505: Result:='HTTP Version not supported';
  else Result:='';
 end;
end;

function Test_crw_str_sanity:LongString;
var List:TStringList; sa,sb:LongString; pa:PChar; errors:SizeInt; txt:TText;
var IDS:packed record I:Integer; D:Double; S:ShortString; end;
var Buff:array[0..511] of Char; t,iv:Integer;
 function Esc(s:LongString):LongString;
 begin
  Result:=s;
  Result:=StringReplace(Result,ASCII_LF,'\n',[rfReplaceAll]);
  Result:=StringReplace(Result,ASCII_CR,'\r',[rfReplaceAll]);
  Result:=StringReplace(Result,ASCII_NUL,'\x00',[rfReplaceAll]);
 end;
 procedure Test_1i(What:LongString; Code,Expected:SizeInt);
 var Cond:Boolean;
 begin
  Cond:=(Code=Expected); if not Cond then inc(errors);
  List.Add(Format('Test %-60s : %-10d - %-5s, %d error(s)',
          [Esc(What),Code,BoolToStr(Cond,true),errors]));
 end;
 procedure Test_1s(What:LongString; Code,Expected:LongString);
 var Cond:Boolean;
 begin
  Cond:=(Code=Expected); if not Cond then inc(errors);
  List.Add(Format('Test %-60s : %-10s - %-5s, %d error(s)',
          [Esc(What),Esc(Code),BoolToStr(Cond,true),errors]));
 end;
begin
 Result:='';
 try
  List:=TStringList.Create;
  try
   List.Add('Test _crw_str Sanity:');
   IDS.I:=0; IDS.D:=0; IDS.S:='';
   errors:=0;
   // StrLen,StrLLen,StrEnd
   ////////////////////////
   sa:=Abc_Latin_Up; pa:=PChar(sa);
   Test_1i('StrLen(nil)',StrLen(nil),0);
   Test_1i('StrLen()',StrLen(''),0);
   Test_1i('StrLen('+sa+')',StrLen(pa),Length(sa));
   Test_1i('StrLLen(nil)',StrLLen(nil,10),0);
   Test_1i('StrLLen()',StrLLen('',10),0);
   Test_1i('StrLLen('+sa+')',StrLLen(pa,10),10);
   Test_1i('StrEnd('+sa+')',SubtractPointersAsPtrInt(StrEnd(pa),pa),Length(sa));
   // StrCopy,StrECopy,StrLCopy,StrPCopy
   /////////////////////////////////////
   StrLCopy(StrECopy(StrEnd(StrCopy(Buff,'one ')),'two '),'three xxx',5);
   StrPCopy(StrEnd(Buff),' four'); sa:=Buff;
   Test_1s('StrXCopy('+sa+')',sa,'one two three four');
   // StrCat,StrECat,StrLCat,StrPCat
   /////////////////////////////////////
   StrPCat(StrLCat(StrCat(StrCopy(Buff,'one '),'two '),'three',511),' four');
   sa:=Buff;
   Test_1s('StrXCat('+sa+')',sa,'one two three four');
   // StrComp,StrIComp,StrLComp,StrLiComp
   //////////////////////////////////////
   Test_1i('StrComp('''','''')',Sign(StrComp('','')),0);
   Test_1i('StrIComp('''','''')',Sign(StrIComp('','')),0);
   Test_1i('StrLComp('''','''')',Sign(StrLComp('','',1)),0);
   Test_1i('StrLIComp('''','''')',Sign(StrLIComp('','',1)),0);
   Test_1i('StrComp(abcd,ABCD)',Sign(StrComp('abcd','ABCD')),1);
   Test_1i('StrIComp(abcd,ABCD)',Sign(StrIComp('abcd','ABCD')),0);
   Test_1i('StrLComp(abcd,abcD,3)',Sign(StrLComp('abcd','abcD',3)),0);
   Test_1i('StrLIComp(abcd,ABCX,3)',Sign(StrLIComp('abcd','abcX',3)),0);
   // StrScan,StrIScan,StrRScan,StrRIScan
   //////////////////////////////////////
   sa:=StrPCopy(Buff,'ABCDabcd abcdFEGH');
   Test_1s('StrScan(c,'+sa+')',StrScan(Buff,'c'),'cd abcdFEGH');
   Test_1s('StrIScan(c,'+sa+')',StrIScan(Buff,'c'),'CDabcd abcdFEGH');
   Test_1s('StrRScan(C,'+sa+')',StrRScan(Buff,'C'),'CDabcd abcdFEGH');
   Test_1s('StrRIScan(C,'+sa+')',StrRIScan(Buff,'C'),'cdFEGH');
   // StrPos,StrIPos
   //////////////////////////////////////
   sa:=StrPCopy(Buff,'ABCDabcd abcdFEGH');
   Test_1s('StrPos(cd,'+sa+')',StrPos(Buff,'cd'),'cd abcdFEGH');
   Test_1s('StrIPos(cd,'+sa+')',StrIPos(Buff,'cd'),'CDabcd abcdFEGH');
   // StrUpper,StrLower
   ////////////////////
   sa:=StrCopy(Buff,'abcABC');
   Test_1s('StrUpper('+sa+')',StrUpper(Buff),'ABCABC');
   Test_1s('StrLower('+sa+')',StrLower(Buff),'abcabc');
   // StrPass,StrMove
   //////////////////////////////////////
   sa:=StrPCopy(Buff,'    *** abc');
   Test_1s('StrPass('+sa+',[ ])',StrPass(Buff,JustSpaces),'*** abc');
   Test_1s('StrPass('+sa+',[ *])',StrPass(Buff,JustSpaces+['*']),'abc');
   Test_1s('StrMove('+sa+',xyz,3)',StrMove(Buff,'xyz',3),'xyz *** abc');
   // GetTextNumLines
   //////////////////
   sa:='';
   Test_1i('GetTextNumLines('+sa+')',GetTextNumLines(sa),0);
   sa:=EOL;
   Test_1i('GetTextNumLines('+sa+')',GetTextNumLines(sa),1);
   sa:='Line1';
   Test_1i('GetTextNumLines('+sa+')',GetTextNumLines(sa),1);
   sa:='Line1'+EOL+'Line2'+EOL;
   Test_1i('GetTextNumLines('+sa+')',GetTextNumLines(sa),2);
   sa:='Line1'+EOL+'Line2'+EOL+'Line3';
   Test_1i('GetTextNumLines('+sa+')',GetTextNumLines(sa),3);
   sa:=CRLF;
   Test_1i('GetTextNumLines('+sa+')',GetTextNumLines(sa),1);
   sa:='Line1'+CRLF+'Line2'+CRLF;
   Test_1i('GetTextNumLines('+sa+')',GetTextNumLines(sa),2);
   sa:='Line1'+CRLF+'Line2'+CRLF+'Line3';
   Test_1i('GetTextNumLines('+sa+')',GetTextNumLines(sa),3);
   // PosEx,LastPos
   ////////////////
   sa:='abc def abc def';
   Test_1i('PosEx(de,'+sa+',1)',PosEx('de',sa,1),5);
   Test_1i('PosEx(de,'+sa+',6)',PosEx('de',sa,6),13);
   Test_1i('LastPos(de,'+sa+')',LastPos('de',sa),13);
   Test_1i('NthPos(de,'+sa+',2)',NthPos('de',sa,2),13);
   Test_1i('CountPos(de,'+sa+')',CountPos('de',sa),2);
   // PosEol
   /////////
   sa:='Line1'+CRLF+'Line2'+EOL+'Line3'+EOL;
   Test_1i('PosEol('+sa+',1,0)',PosEol(sa,1,0),Length('Line1')+1);
   Test_1i('PosEol('+sa+',1,1)',PosEol(sa,1,1),Length('Line1'+CRLF)+1);
   Test_1i('PosEol('+sa+',1,2)',PosEol(sa,1,2),Length('Line1'+CRLF+'Line2'+EOL)+1);
   Test_1i('PosEol('+sa+',1,3)',PosEol(sa,1,3),Length('Line1'+CRLF+'Line2'+EOL+'Line3'+EOL)+1);
   // UpCase,LoCase
   ////////////////
   Test_1s('UpCase(a)',UpCase('a'),'A');
   Test_1s('UpCase(A)',UpCase('A'),'A');
   Test_1s('LoCase(a)',LoCase('a'),'a');
   Test_1s('LoCase(A)',LoCase('A'),'a');
   Test_1s('UpCaseStr(aA)',UpCaseStr('aA'),'AA');
   Test_1s('LoCaseStr(aA)',LoCaseStr('aA'),'aa');
   // IsSameChar,IsSameStr,IsSameText
   //////////////////////////////////
   Test_1i('IsSameChar(a,b)',Ord(IsSameChar('a','b')),0);
   Test_1i('IsSameChar(a,a)',Ord(IsSameChar('a','a')),1);
   Test_1i('IsSameChar(a,A)',Ord(IsSameChar('a','A')),1);
   Test_1i('IsSameStr(ab,cd)',Ord(IsSameStr('ab','cd')),0);
   Test_1i('IsSameStr(ab,ab)',Ord(IsSameStr('ab','ab')),1);
   Test_1i('IsSameStr(ab,aB)',Ord(IsSameStr('ab','aB')),0);
   Test_1i('IsSameText(ab,cd)',Ord(IsSameText('ab','cd')),0);
   Test_1i('IsSameText(ab,ab)',Ord(IsSameText('ab','ab')),1);
   Test_1i('IsSameText(ab,aB)',Ord(IsSameText('ab','aB')),1);
   // TailStr,LeftStr,RightStr
   ////////////////////////////
   Test_1s('TailStr(123456789,5)',TailStr('123456789',5),'56789');
   Test_1s('LeftStr(123456789,5)',LeftStr('123456789',5),'12345');
   Test_1s('RightStr(123456789,3)',RightStr('123456789',3),'789');
   // CharStr,Pad
   //////////////
   Test_1s('CharStr(11,*)',CharStr(11,'*'),'***********');
   Test_1s('Pad(abc,11,*)',Pad('abc',11,'*'),'abc********');
   Test_1s('LeftPad(abc,11,*)',LeftPad('abc',11,'*'),'********abc');
   Test_1s('RightPad(abc,11,*)',RightPad('abc',11,'*'),'abc********');
   Test_1s('CenterPad(abc,11,*)',CenterPad('abc',11,'*'),'****abc****');
   Test_1s('CenterStr(abc,11,*)',CenterStr('abc',11,'*'),'****abc****');
   // Trim
   ///////
   Test_1s('TrimLeftChars(***abc***,*)',TrimLeftChars('***abc***',['*']),'abc***');
   Test_1s('TrimRightChars(***abc***,*)',TrimRightChars('***abc***',['*']),'***abc');
   Test_1s('TrimChars(***abc***,*)',TrimChars('***abc***',['*'],['*']),'abc');
   // UnifyAlias,UnifyFileAlias,UnifySection
   /////////////////////////////////////////
   sa:=' /Demo Test/ '; sb:=UpCaseStr(Trim(sa));
   if IsFileNameCaseSensitive then sb:=Trim(sa);
   Test_1s('UnifyAlias('+sa+')',UnifyAlias(sa),sb);
   Test_1s('UnifyFileAlias('+sa+')',UnifyFileAlias(sa),sb);
   Test_1s('UnifySection('+sa+')',UnifySection(sa),'[/DEMO TEST/]');
   // StrFetch
   ///////////
   sa:='abcd';
   Test_1s('StrFetch('+sa+',0)',StrFetch(sa,0),#0);
   Test_1s('StrFetch('+sa+',1)',StrFetch(sa,1),'a');
   Test_1s('StrFetch('+sa+',2)',StrFetch(sa,2),'b');
   Test_1s('StrFetch('+sa+',3)',StrFetch(sa,3),'c');
   Test_1s('StrFetch('+sa+',4)',StrFetch(sa,4),'d');
   Test_1s('StrFetch('+sa+',5)',StrFetch(sa,5),#0);
   sa:='';
   Test_1s('StrFetch('+sa+',1)',StrFetch(sa,1),#0);
   // AnsiDeQuotedStr
   //////////////////
   sa:='"one two" three four';
   Test_1s('AnsiDeQuotedStr('+sa+')',AnsiDeQuotedStr(sa,QuoteMark),'one two');
   Test_1s('AnsiSkipQuotedStr('+sa+')',AnsiSkipQuotedStr(sa,QuoteMark),' three four');
   Test_1s('AnsiDeQuotedStr("one two)',AnsiDeQuotedStr('"one two',QuoteMark),'one two');
   Test_1s('RemoveBrackets([System])',RemoveBrackets('[System]'),'System');
   // ExtractFirstParam,SkipFirstParam
   ///////////////////////////////////
   sa:='one two three four';
   Test_1s('ExtractFirstParam('+sa+')',ExtractFirstParam(sa),'one');
   Test_1s('SkipFirstParam('+sa+')',SkipFirstParam(sa),'two three four');
   sa:='"one two" three four';
   Test_1s('ExtractFirstParam('+sa+')',ExtractFirstParam(sa),'one two');
   Test_1s('SkipFirstParam('+sa+')',SkipFirstParam(sa),'three four');
   sa:='parameter';
   Test_1s('AnsiQuotedIfNeed('+sa+')',AnsiQuotedIfNeed(sa),sa);
   sa:='parameter + blank';
   Test_1s('AnsiQuotedIfNeed('+sa+')',AnsiQuotedIfNeed(sa),AnsiQuotedStr(sa,QuoteMark));
   // IsOption,HasOption,GetOption
   ///////////////////////////////
   Test_1i('IsOption(dns)',Ord(IsOption('dns')),0);
   Test_1i('IsOption(-dns)',Ord(IsOption('-dns')),1);
   Test_1i('IsOption(-dns=localhost)',Ord(IsOption('-dns=localhost')),1);
   Test_1i('IsOption(-dns=localhost,-dns)',Ord(IsOption('-dns=localhost','-dns')),1);
   Test_1i('HasOptionValue(-dns=localhost)',Ord(HasOptionValue('-dns=localhost')),1);
   Test_1s('GetOptionValue(-dns=localhost)',GetOptionValue('-dns=localhost'),'localhost');
   // IsLexeme
   ///////////
   Test_1i('IsLexeme(abc,lex_Name)',Ord(IsLexeme('abc',lex_Name)),1);
   Test_1i('IsLexeme(a-c,lex_Name)',Ord(IsLexeme('a-c',lex_Name)),0);
   // ValidateEOLN
   ///////////////
   sa:='a'+ASCII_CR+'b'+ASCII_LF+'c'+CRLF+'d';
   Test_1s('ValidateEOL('+sa+',1)',ValidateEOL(sa,1),'a'+EOL+'b'+EOL+'c'+EOL+'d'+EOL);
   Test_1s('ValidateCRLF('+sa+')',ValidateCRLF(sa),'a'+CRLF+'b'+CRLF+'c'+CRLF+'d');
   Test_1s('ValidateEOL('+sa+')',ValidateEOL(sa),'a'+EOL+'b'+EOL+'c'+EOL+'d');
   // WordCount,ExtractWord,SkipWords
   //////////////////////////////////
   sa:=' one two three four ';
   Test_1i('WordCount('+sa+')',WordCount(sa,JustSpaces),4);
   Test_1s('ExtractWord(0,'+sa+')',ExtractWord(0,sa,JustSpaces),'');
   Test_1s('ExtractWord(1,'+sa+')',ExtractWord(1,sa,JustSpaces),'one');
   Test_1s('ExtractWord(2,'+sa+')',ExtractWord(2,sa,JustSpaces),'two');
   Test_1s('ExtractWord(3,'+sa+')',ExtractWord(3,sa,JustSpaces),'three');
   Test_1s('ExtractWord(4,'+sa+')',ExtractWord(4,sa,JustSpaces),'four');
   Test_1s('SkipWords(0,'+sa+')',SkipWords(0,sa,JustSpaces),' one two three four ');
   Test_1s('SkipWords(1,'+sa+')',SkipWords(1,sa,JustSpaces),'two three four ');
   Test_1i('WordIndex(two,'+sa+')',WordIndex('two',sa,JustSpaces),2);
   Test_1i('WordIndex(xxx,'+sa+')',WordIndex('xxx',sa,JustSpaces),0);
   Test_1i('WordIndex(TWO'+sa+')',WordIndex('TWO',sa,JustSpaces),2);
   // BinB,BinW,BinL,OctB,OctW,OctL,HexB,HexW,HexL
   ///////////////////////////////////////////////
   Test_1s('BinB($42)',BinB($42),'01000010');
   Test_1s('BinW($1842)',BinW($1842),'0001100001000010');
   Test_1s('BinL($18420000)',BinL($18420000),'00011000010000100000000000000000');
   Test_1s('OctB($42)',OctB($42),'102');
   Test_1s('OctW($1842)',OctW($1842),'014102');
   Test_1s('OctL($18420000)',OctL($18420000),'03020400000');
   Test_1s('HexB($42)',HexB($42),'42');
   Test_1s('HexW($1842)',HexW($1842),'1842');
   Test_1s('HexL($18420000)',HexL($18420000),'18420000');
   // Long2Str,d2s,f2s
   ///////////////////
   Test_1s('Long2str(123)',Long2Str(123),'123');
   Test_1s('d2s(1234567)',Long2Str(1234567),'1234567');
   Test_1s('Real2str(pi,1,3)',Real2Str(pi,1,3),'3.142');
   Test_1s('f2s(pi)',f2s(pi),'3.14159265358979');
   // atoi,atof
   ////////////
   if atoi('123',iv) then Test_1i('atoi(123)',iv,123) else Test_1i('atoi(123)',0,1);
   // ScanVar
   //////////
   sa:=' Size = 100 '+EOL+'Data = 3.14'+EOL+' Name = Alex K. ';
   if ScanVar(svConfig,PChar(sa),'size%i;data%f;name%a',IDS)<>nil then begin
    Test_1i('ScanVar(Size)',IDS.I,100);
    Test_1i('ScanVar(Data)',Ord(Abs(IDS.D-3.14)<1e-10),1);
    Test_1i('ScanVar(Name)',Ord(IsSameText(IDS.S,'Alex')),1);
    List.Add(Format('Size=%d,Data=%.4g,Name=%s',[IDS.I,IDS.D,IDS.S]));
   end else Test_1i('ScanVar()',0,1);
   // CookieScan
   /////////////
   sa:=' pi = 3.14 '+EOL+' id = John; fn=/demo/test ';
   Test_1s('CookieScan('+sa+')',CookieScan(sa,'pi',ord(';')),'3.14');
   Test_1s('CookieScan('+sa+')',CookieScan(sa,'id',ord(';')),'John');
   Test_1s('CookieScan('+sa+')',CookieScan(sa,'fn',ord(';')),'/demo/test');
   // IsEmptyStr,HasChars
   //////////////////////
   sa:='';    Test_1i('IsEmptyStr('+sa+')',Ord(IsEmptyStr(sa)),1);
   sa:='   '; Test_1i('IsEmptyStr('+sa+')',Ord(IsEmptyStr(sa)),1);
   sa:=' b '; Test_1i('IsEmptyStr('+sa+')',Ord(IsEmptyStr(sa)),0);
   sa:='abc'; Test_1i('IsEmptyStr('+sa+')',Ord(IsEmptyStr(sa)),0);
   sa:='';    Test_1i('HasChars('+sa+',b)',Ord(HasChars(sa,['b'])),0);
   sa:='   '; Test_1i('HasChars('+sa+',b)',Ord(HasChars(sa,['b'])),0);
   sa:=' b '; Test_1i('HasChars('+sa+',b)',Ord(HasChars(sa,['b'])),1);
   sa:='abc'; Test_1i('HasChars('+sa+',b)',Ord(HasChars(sa,['b'])),1);
   // LastDelimiter,HasExtension
   /////////////////////////////
   sa:='';    Test_1i('LastDelimiter('+sa+')',LastDelimiter(['.'],sa),0);
   sa:='.ab'; Test_1i('LastDelimiter('+sa+')',LastDelimiter(['.'],sa),1);
   sa:='a.b'; Test_1i('LastDelimiter('+sa+')',LastDelimiter(['.'],sa),2);
   sa:='ab.'; Test_1i('LastDelimiter('+sa+')',LastDelimiter(['.'],sa),3);
   sa:='';       Test_1i('HasExtension('+sa+')',Ord(HasExtension(sa)),0);
   sa:='/a/.';   Test_1i('HasExtension('+sa+')',Ord(HasExtension(sa)),0);
   sa:='/a/..';  Test_1i('HasExtension('+sa+')',Ord(HasExtension(sa)),0);
   sa:='/a/b_c'; Test_1i('HasExtension('+sa+')',Ord(HasExtension(sa)),0);
   sa:='/./b_c'; Test_1i('HasExtension('+sa+')',Ord(HasExtension(sa)),0);
   sa:='/a/b.c'; Test_1i('HasExtension('+sa+')',Ord(HasExtension(sa)),1);
   sa:='/ab/.c'; Test_1i('HasExtension('+sa+')',Ord(HasExtension(sa)),1);
   // ValidatePathDelim
   ////////////////////
   sb:=PathDelim+'a'+PathDelim+'b'+PathDelim+'c';
   sa:='/a/b/c'; Test_1s('ValidatePathDelim('+sa+')',ValidatePathDelim(sa),sb);
   sa:='\a\b\c'; Test_1s('ValidatePathDelim('+sa+')',ValidatePathDelim(sa),sb);
   sa:='/a\b/c'; Test_1s('ValidatePathDelim('+sa+')',ValidatePathDelim(sa),sb);
   // AddBackSlash,DropBackSlash
   /////////////////////////////
   sb:=ValidatePathDelim('/a/b/c/');
   sa:='/a/b/c';  Test_1s('AddBackSlash('+sa+')',ValidatePathDelim(AddBackSlash(sa)),sb);
   sa:='/a/b/c/'; Test_1s('AddBackSlash('+sa+')',ValidatePathDelim(AddBackSlash(sa)),sb);
   sb:=ValidatePathDelim('/a/b/c');
   sa:='/a/b/c';  Test_1s('DropBackSlash('+sa+')',ValidatePathDelim(DropBackSlash(sa)),sb);
   sa:='/a/b/c/'; Test_1s('DropBackSlash('+sa+')',ValidatePathDelim(DropBackSlash(sa)),sb);
   // IsWildCard,IsRelativePath
   ////////////////////////////
   sa:='a/b.c';    Test_1i('IsWildCard('+sa+')',Ord(IsWildCard(sa)),0);
   sa:='a/*.c';    Test_1i('IsWildCard('+sa+')',Ord(IsWildCard(sa)),1);
   sa:='a/?.c';    Test_1i('IsWildCard('+sa+')',Ord(IsWildCard(sa)),1);
   sa:='';         Test_1i('IsRelativePath('+sa+')',Ord(IsRelativePath(sa)),0);
   sa:='a/b.c';    Test_1i('IsRelativePath('+sa+')',Ord(IsRelativePath(sa)),1);
   sa:='../a/b.c'; Test_1i('IsRelativePath('+sa+')',Ord(IsRelativePath(sa)),1);
   sa:='./a/b.c';  Test_1i('IsRelativePath('+sa+')',Ord(IsRelativePath(sa)),1);
   sa:='/a/b.c';   Test_1i('IsRelativePath('+sa+')',Ord(IsRelativePath(sa)),0);
   sa:='c:/a/b.c'; Test_1i('IsRelativePath('+sa+')',Ord(IsRelativePath(sa)),0);
   // DefaultExtension,ForceExtension,DefaultPath,ForcePath
   ////////////////////////////////////////////////////////
   sb:='demo.cfg';
   sa:='demo.bat'; Test_1s('DefaultExtension('+sa+',cfg)', DefaultExtension(sa,'cfg'),sa);
   sa:='demo.bat'; Test_1s('DefaultExtension('+sa+',.cfg)',DefaultExtension(sa,'.cfg'),sa);
   sa:='demo';     Test_1s('DefaultExtension('+sa+',cfg)', DefaultExtension(sa,'cfg'),sb);
   sa:='demo';     Test_1s('DefaultExtension('+sa+',.cfg)',DefaultExtension(sa,'.cfg'),sb);
   sa:='demo.bat'; Test_1s('ForceExtension('+sa+',cfg)', ForceExtension(sa,'cfg'),sb);
   sa:='demo.bat'; Test_1s('ForceExtension('+sa+',.cfg)',ForceExtension(sa,'.cfg'),sb);
   sa:='demo';     Test_1s('ForceExtension('+sa+',cfg)', ForceExtension(sa,'cfg'),sb);
   sa:='demo';     Test_1s('ForceExtension('+sa+',.cfg)',ForceExtension(sa,'.cfg'),sb);
   sb:='/new/demo';
   sa:='/old/demo'; Test_1s('DefaultPath('+sa+',/new)', DefaultPath(sa,'/new'),sa);
   sa:='/old/demo'; Test_1s('DefaultPath('+sa+',/new/)',DefaultPath(sa,'/new/'),sa);
   sa:='demo';      Test_1s('DefaultPath('+sa+',/new)', DefaultPath(sa,'/new'),sb);
   sa:='demo';      Test_1s('DefaultPath('+sa+',/new/)',DefaultPath(sa,'/new/'),sb);
   sa:='/old/demo'; Test_1s('ForcePath('+sa+',/new)', ForcePath('/new',sa),sb);
   sa:='/old/demo'; Test_1s('ForcePath('+sa+',/new/)',ForcePath('/new/',sa),sb);
   sa:='demo';      Test_1s('ForcePath('+sa+',/new)', ForcePath('/new',sa),sb);
   sa:='demo';      Test_1s('ForcePath('+sa+',/new/)',ForcePath('/new/',sa),sb);
   // ExtractFilePath,ExtractFileDir
   /////////////////////////////////
   sa:='/opt/diesel/CrossDesigner';
   Test_1s('ExtractFileDir('+sa+')',ExtractFileDir(sa),'/opt/diesel');
   Test_1s('ExtractFilePath('+sa+')',ExtractFilePath(sa),'/opt/diesel');
   Test_1s('ExtractBaseName('+sa+')',ExtractBaseName(sa),'CrossDesigner');
   Test_1s('ExtractBaseName('+sa+'.exe'+')',ExtractBaseName(sa+'.exe'),'CrossDesigner');
   Test_1s('ExtractFileName('+sa+')',ExtractFileName(sa),'CrossDesigner');
   Test_1s('ExtractFileName('+sa+'.exe'+')',ExtractFileName(sa+'.exe'),'CrossDesigner');
   Test_1s('ExtractFileNameExt('+sa+')',ExtractFileNameExt(sa),'CrossDesigner');
   Test_1s('ExtractFileNameExt('+sa+'.exe'+')',ExtractFileNameExt(sa+'.exe'),'CrossDesigner.exe');
   Test_1s('ExtractFileExt('+sa+')',ExtractFileExt(sa),'');
   Test_1s('ExtractFileExt('+sa+'.exe'+')',ExtractFileExt(sa+'.exe'),'.exe');
   Test_1s('ExtractFileDrive('+sa+')',ExtractFileDrive(sa),'');
   Test_1s('ExtractFileDrive('+'c:'+sa+')',ExtractFileDrive('c:'+sa),'c:');
   // MakeRelativePath
   ///////////////////
   sa:='/opt/diesel/CrossDesigner'; sb:='/opt/dim/dns';
   Test_1s('MakeRelativePath('+sa+','+sb+')',MakeRelativePath(sa,sb),'../diesel/CrossDesigner');
   sa:='diesel/CrossDesigner'; sb:='/opt/dim/dns';
   Test_1s('MakeRelativePath('+sa+','+sb+')',MakeRelativePath(sa,sb),UnifyFileAlias(sa));
   // FExpand,UnifyFileAlias
   /////////////////////////
   sa:=' /opt/dim/../diesel/./CrossDesigner '; sb:='/opt/diesel/CrossDesigner';
   Test_1s('FExpand('+sa+')',FExpand(sa),sb);
   Test_1s('UnifyFileAlias('+sa+')',UnifyFileAlias(sa),sb);
   //////////////////
   // TText.Get/SetText
   ////////////////////
   txt:=NewText;
   try
    txt.Text:='Line1'+CRLF+'Line2'+EOL+'Line3';
    sa:=txt.Text;
    Test_1s('TText.Text('+sa+')',sa,'Line1'+EOL+'Line2'+EOL+'Line3'+EOL);
   finally
    Kill(txt);
   end;
   // text_xxx
   ///////////
   t:=text_new.ref;
   sa:='Line0'+EOL+'Line1'+EOL+'Line2';
   List.Add(Format('Text reference %d',[t]));
   text_fromstring(t,sa);
   Test_1s('Text('+sa+')',text_tostring(t),sa+EOL);
   text_addln(t,'Line3');
   Test_1s('Text_AddLn(Line3)',text_tostring(t),sa+EOL+'Line3'+EOL);
   Test_1s('text_getln(t,0)',text_getln(t,0),'Line0');
   Test_1s('text_getln(t,1)',text_getln(t,1),'Line1');
   Test_1s('text_getln(t,2)',text_getln(t,2),'Line2');
   Test_1s('text_getln(t,3)',text_getln(t,3),'Line3');
   Test_1s('text_getln(t,4)',text_getln(t,4),'');
   Test_1s('text_getln(t,-1)',text_getln(t,-1),'');
   Test_1s('text_getln(0,0)',text_getln(0,0),'');
   Test_1i('text_delln(t,1)',Ord(text_delln(t,1)),1);
   Test_1s('text_getln(t,2)',text_getln(t,2),'Line3');
   Test_1i('text_insln(t,1)',Ord(text_insln(t,1,'Line1')),1);
   Test_1s('text_getln(t,2)',text_getln(t,2),'Line2');
   Test_1i('text_putln(t,2)',Ord(text_putln(t,2,'Line2+2')),1);
   Test_1s('text_getln(t,2)',text_getln(t,2),'Line2+2');
   text_free(t);
   // URL_Encode/Decode
   ////////////////////
   sa:='Demo Text'+CRLF+'Text Demo'+CRLF;
   sb:='Demo+Text%0D%0AText+Demo%0D%0A';
   Test_1s('URL_Encode('+sa+')',URL_Encode(sa,0),sb);
   Test_1s('URL_Decode('+sb+')',URL_Decode(sb),sa);
   sb:='Demo%20Text%0D%0AText%20Demo%0D%0A';
   Test_1s('URL_Encode('+sa+')',URL_Encode(sa,um_Strict),sb);
   Test_1s('URL_Decode('+sb+')',URL_Decode(sb),sa);
   //////////////////
   List.Add(Format('Summary errors=%d',[errors]));
   //////////////////
   Result:=List.Text;
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,nil,'Test_crw_str_sanity');
 end;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_str;
begin
 if (DefaultFormatSettings.DecimalSeparator=',')
 then DefaultFormatSettings.DecimalSeparator:='.';
 SetCaseTable_Default;
 SetupCharTable(WinToDosTable, Abc_RusWin, Abc_RusDos);
 SetupCharTable(DosToWinTable, Abc_RusDos, Abc_RusWin);
 SetupCharTable(WinToKoiTable, Abc_RusWin, Abc_RusKoi);
 SetupCharTable(KoiToWinTable, Abc_RusKoi, Abc_RusWin);
 InitCharToNumber;
 if IsFileNameCaseSensitive then begin
  UnifyFileAliasDefMode:=UnifyFileAliasDefMode and not ua_Case;
  UnifyAliasDefMode:=UnifyAliasDefMode and not ua_Case;
 end;
end;

procedure Free_crw_str;
begin
end;

initialization

 Init_crw_str;

finalization

 Free_crw_str;

end.

//////////////
// END OF FILE
//////////////

