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

unit _crw_str; // String functions.

{$I _crw_sysdef}

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

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

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

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

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

 { StrPCopy copies the Pascal style string Source into Dest and returns Dest. }
function  StrPCopy(Dest: PChar; const Source: ShortString): 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: ShortString): 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: LongInt): 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: LongInt): 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: LongInt): 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): ShortString;

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

 { Number of lines in text = Number of CRLF delimers plus 1 in next Count chars }
function  GetTextNumLines(Text:PChar; Count:LongInt=MaxLongInt; UnixStyle:boolean=false): LongInt;

 { Return 0-based position of substring (Sub) in string (Str) starting from 0-based Offset or return -1 }
function PosEx(Sub:PChar; SubLen:Integer; Str:PChar; StrLen:Integer; Offset:Integer):Integer; 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:Integer):Integer; overload;

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

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

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

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

 {
 *******************************
 Alphabets for string conversion
 *******************************
 }
const
 Abc_Hex_Table  = '0123456789ABCDEF';                  { to convert numerical to string  }
 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 uses Win codepage 1251 }
function IsSameChar(C1,C2:Char):Boolean;

 { Compare strings without case sensivity uses Win codepage 1251 }
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;

{$IFDEF SKIP_DRAFT}
 {
 ***********************************
 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:String):TCharSet;

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

 { Copy right pos..length chars }
function  RightStr(const S:ShortString; pos:integer):ShortString;

 { Copy left 1..count chars }
function  LeftStr(const S:ShortString; count:integer):ShortString;

 { Return a string of length len filled with ch }
function  CharStr(Len:Byte; Ch:Char=' '):ShortString;

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

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

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

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

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

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

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

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

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

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

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

 {
 Example:
  UnifySection('Section')   = '[Section]'
  UnifySection('[Section')  = '[Section]'
  UnifySection('Section]')  = '[Section]'
  UnifySection('[Section]') = '[Section]'
 }
function UnifySection(const aSectionName:ShortString):ShortString;

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

 {
 StrFetch(s,i) is safe analog of s[i]. Return #0 if index (i) out of range.
 }
function StrFetch(const s:LongString; i:Integer):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:ShortString; const Brackets:ShortString='[]'):ShortString;

 {
 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)
const    om_Default     = 0;         // Option mode uses by default.
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;

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

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

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

 { Return string Str with substrings Find replaced by Replace }
function ReplaceString(Str:ShortString; const Find,Replace:ShortString):ShortString;

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

 {
 Replace LF to CRLF, uses for Unix-like text delimiters.
 Also add or remove tail CRLF if TailCRLF equals +1 or -1.
 }
function ValidateCRLF(const Data:LongString; TailCRLF:Integer=0):LongString;

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

 { This set uses as spases for word parsing }
const
 ScanSpaces : TCharSet = [' ',Tab,CR,LF,',',';','='];

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

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

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

 { Return zero or order number of word Name in string Str }
function  WordIndex(const Name,Str:ShortString; const Delims:TCharSet):Byte;

 { Extract word and convert to integer }
function  ExtractInt(N:Byte; const S:ShortString; const WordDelims:TCharSet; var Value:LongInt):boolean;

 { Extract word and convert to double }
function  ExtractReal(N:Byte; const S:ShortString; const WordDelims:TCharSet; var Value:Double):boolean;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

 {
 Форматное чтение переменных с префиксом для идентификации.
 Формат состоит из слов,разделенных символом CR или ; типа
 prefix1%format1+CR+
 prefix2%format2+CR+
 ....
 prefixN%formatN
 Префикс-строка для поиска в тексте (может отсутствовать)
 Форматы должны быть одной из указанных строк:
  %s - чтение ShortString(Data) после префикса до символа CR или конца строки,
       но не более 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:word; Str:PChar; const Format:ShortString; 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 }

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

 { 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'+CRLF+'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:Integer; 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:ShortString):boolean;

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

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

 {
 Trim DirName and add a trailing backslash to a directory name, if need.
 Example: AddBackSlash('c:\bp\') = 'c:\bp\'
          AddBackSlash('c:\bp ')  = 'c:\bp\'
 }
function  AddBackSlash(const DirName:ShortString):ShortString;
function  AddPathDelim(const DirName:ShortString):ShortString;

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

 {
 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:ShortString):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:ShortString):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:ShortString; var DotPos:Integer):Boolean; overload;
function  HasExtension(const Name:ShortString):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:ShortString):ShortString;

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

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

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

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

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

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

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

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

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

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

 {
 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:ShortString; Delim:Char=PathSep; Spaces:TCharSet=JustSpaces):Boolean;

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

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    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 : ShortString = '';
                            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);

 {
 **********************************
 Routines for multilanguage support
 **********************************
 }
const
 Language : (lng_RUSSIAN, lng_ENGLISH) = {$IFDEF RUSSIAN} lng_RUSSIAN; {$ELSE} lng_ENGLISH; {$ENDIF}

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

 {
 **************
 Windows system
 **************
 }

 {
 Gets windows error message, codes from windows.GetLastError.
 }
function SysErrorMessage(ErrorCode: Integer): ShortString;

 {
 ************
 HTTP and CGI
 ************
 }
const
 UrlAllowChars = [#33..#255]-['%','+',' ',Tab,CR,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;

{$ENDIF SKIP_DRAFT}

implementation

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

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

function StrLLen(Str: PChar; MaxLen: LongInt): LongInt;
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:LongInt;
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:LongInt;
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: LongInt): PChar;
var Len:LongInt;
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: ShortString): PChar;
begin
 Result:=StrLCopy(Dest,@Source[1],length(Source));
end;

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

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

function StrLCat(Dest, Source: PChar; MaxLen: LongInt): 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: LongInt): Integer;
var i:LongInt;
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: LongInt): Integer;
var i:LongInt;
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:LongInt;
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:LongInt;
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:LongInt;
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:LongInt;
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): ShortString;
begin
 Result[0]:=#0;
 if Assigned(Str) then
 while (Str[0]<>#0) and (Result[0]<high(char)) do begin
  Result[ord(Succ(Result[0]))]:=Str[0];
  inc(Result[0]);
  inc(Str);
 end;
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: LongInt): PChar;
begin
 Result:=Dest;
 SafeMove(Source[0],Dest[0],Count);
end;

function  GetTextNumLines(Text:PChar; Count:LongInt=MaxLongInt; UnixStyle:boolean=false): LongInt;
var Index:LongInt;
begin
 Result:=0;
 if Assigned(Text) then begin
  for Index:=0 to Count-1 do
  case Text[Index] of
   #0 : break;
   CR : if UnixStyle then Inc(Result) else if Text[Index+1]=LF then Inc(Result);
  end;
 end;
end;

function PosEx(Sub:PChar; SubLen:Integer; Str:PChar; StrLen:Integer; Offset:Integer):Integer; overload;
var i,j,n,Count:Integer;
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:Integer):Integer; overload;
begin
 Result:=PosEx(PChar(Sub),Length(Sub),PChar(Str),Length(Str),StartPos-1)+1;
end;

function LastPos(const Sub,Str:LongString):Integer;
var i,p:Integer;
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):Integer;
var i,n:Integer;
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:Integer):Integer;
var i,p:Integer;
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:Integer=1; SkipLines:Integer=0):Integer;
begin
 if (Buf<>'') then Result:=PosEol(PChar(Buf),Length(Buf),Start,SkipLines) else Result:=0;
end;

function PosEol(Buf:PChar; Count:Integer; Start:Integer=1; SkipLines:Integer=0):Integer;
const EolChars=[ASCII_CR,ASCII_LF]; // Windows/Unix/MAC uses CRLF/LF/CR EOL`s.
var i:Integer; 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;

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

procedure SetupCharTable(var T: TCharTable; const s,d:LongString);
var c:Char; i:Integer;
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_Eng_Up, Abc_Eng_Lo);
 SetupCharTable(UpCaseTable, Abc_Eng_Lo, Abc_Eng_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:Integer;
begin
 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:Integer;
begin
 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 IsSameText(const S1,S2:LongString):Boolean;
var i:Integer;
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;

 {
 **************************
 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:Integer;
begin
 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:Integer;
begin
 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:integer;
begin
 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:integer;
begin
 SetLength(Result,Length(S));
 for i:=0 to Length(Result)-1 do PChar(Result)[i]:=KoiToWinTable[PChar(S)[i]];
end;

{$IFDEF SKIP_DRAFT}
 {
 ***********************************
 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);
 end;
end;

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

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

function RightStr(const S:ShortString; pos:integer):ShortString;
begin
 Result:=copy(S,pos,length(S)-pos+1);
end;

function LeftStr(const S:ShortString; count:integer):ShortString;
begin
 Result:=copy(S,1,count);
end;

function CharStr(Len:Byte; Ch:Char=' '):ShortString;
begin
 Result[0]:=chr(Len);
 SafeFillChar(Result[1], Len, Ch);
end;

function Pad(const S:ShortString; Len:Byte; Ch:Char=' '):ShortString;
var SLen:Byte absolute S[0];
begin
 if SLen >= Len then Result := S else begin
  Result[0]:=chr(Len);
  SafeMove(S[1], Result[1], SLen);
  if SLen < high(byte) then SafeFillChar(Result[Succ(SLen)], Len-SLen, Ch);
 end;
end;

function LeftPad(const S:ShortString; Len:Byte; Ch:Char=' '):ShortString;
var SLen:Byte absolute S[0];
begin
 if SLen >= Len then Result := S else if SLen < high(byte) then begin
  Result[0]:=chr(Len);
  SafeMove(S[1], Result[Succ(Word(Len))-SLen], SLen);
  SafeFillChar(Result[1], Len-SLen, Ch);
 end;
end;

function CenterStr(const S:ShortString; Width:Byte; Ch:Char=' '):ShortString;
var SLen:Byte absolute S[0];
begin
 if SLen >= Width then Result := S else if SLen < high(byte) then begin
  Result[0]:=chr(Width);
  SafeFillChar(Result[1], Width, Ch);
  SafeMove(S[1], Result[Succ((Width-SLen) shr 1)], SLen);
 end;
end;

function TrimLeadChars(const S:ShortString; const TrimChars:TCharSet):ShortString;
var i,j:Integer;
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:Integer;
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:ShortString; const TrimChars:TCharSet):ShortString;
var i,j:Integer;
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:Integer;
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:ShortString; const LeadTrim,TrailTrim:TCharSet):ShortString;
var i,j:Integer;
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: ShortString): ShortString;
var i,j:Integer;
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: ShortString): ShortString;
var i,j:Integer;
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: ShortString): ShortString;
var i,j: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);
 Result:=Copy(S, i, j-i+1);
end;

function UnifyAlias(const Name:ShortString):ShortString;
var i,j:Integer;
begin
 i:=1;
 j:=Length(Name);
 while (i<=j) and (Name[i] <= ' ') do Inc(i);
 while (i<=j) and (Name[j] <= ' ') do Dec(j);
 Result:=Copy(Name, i, j-i+1);
 for i:=1 to Length(Result) do Result[i]:=UpcaseTable[Result[i]];
end;

function UnifyFileAlias(const FileName:ShortString):ShortString;
begin
 if not IsEmptyStr(FileName)
 then Result:=UnifyAlias(FExpand(FileName))
 else Result:='';
end;

function UnifySection(const aSectionName:ShortString):ShortString;
begin
 Result:=UnifyAlias(aSectionName);
 if pos('[',Result)=0 then Result:='['+Result;
 if pos(']',Result)=0 then Result:=Result+']';
end;

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

function StrFetch(const s:LongString; i:Integer):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:ShortString; const Brackets:ShortString):ShortString;
var i,j:Integer;
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:Integer;
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:Integer;
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:Integer;
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 IsLexeme(arg:PChar; leng:Integer; typ:Integer):Boolean; overload;
var i,vi,code:Integer; vf:Extended; st:String;
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:String; typ:Integer):Boolean; overload;
begin
 Result:=IsLexeme(PChar(arg),Length(arg),typ);
end;

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

function ReplaceString(Str:ShortString; const Find,Replace:ShortString):ShortString;
begin
 if (Find='') or (pos(Find,Str)<1) then Result:=Str  else begin
  Result:='';
  while length(Str)>0 do begin
   if pos(Find,Str)=1 then begin
    Result:=Result+Replace;
    delete(Str,1,length(Find));
   end else begin
    Result:=Result+Str[1];
    delete(Str,1,1);
   end;
  end;
 end;
end;

function ReplaceAlignStr(const Str:ShortString; Invert:Boolean):ShortString;
begin
 Result:=Str;
 if Invert then begin
  Result:=ReplaceString(Result, '^C', ^C );
  Result:=ReplaceString(Result, '^c', ^C );
  Result:=ReplaceString(Result, '^L', ^L );
  Result:=ReplaceString(Result, '^l', ^L );
  Result:=ReplaceString(Result, '^R', ^R );
  Result:=ReplaceString(Result, '^r', ^R );
  Result:=ReplaceString(Result, '^N', CR );
  Result:=ReplaceString(Result, '^n', CR );
  Result:=ReplaceString(Result, '^B', LF );
  Result:=ReplaceString(Result, '^b', LF );
 end else begin
  Result:=ReplaceString(Result, ^C, '^C' );
  Result:=ReplaceString(Result, ^L, '^L' );
  Result:=ReplaceString(Result, ^R, '^R' );
  Result:=ReplaceString(Result, CR, '^N' );
  Result:=ReplaceString(Result, LF, '^B' );
 end;
end;

function ValidateCRLF(const Data:LongString; TailCRLF:Integer):LongString;
begin
 Result:=Data;
 if Length(Result)>0 then begin
  Result:=StringReplace(Result,CRLF,ASCII_LF,[rfReplaceAll]);
  Result:=StringReplace(Result,ASCII_LF,CRLF,[rfReplaceAll]);
  if TailCRLF<>0 then
  if Length(Result)>1 then
  if Copy(Result,Length(Result)-1,2)=CRLF then begin
   if TailCRLF<0 then Result:=Copy(Result,1,Length(Result)-2);
  end else begin
   if TailCRLF>0 then Result:=Result+CRLF;
  end;
 end;
end;

 {
 *******************
 String word parsing
 *******************
 }
function WordCount(const S:ShortString; const WordDelims:TCharSet):Byte;
var I:Word; SLen:Byte absolute S[0];
begin
 Result := 0;
 I := 1;
 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:Byte; const S:ShortString; const WordDelims:TCharSet):ShortString;
var I:Word; Count, Len:Byte; SLen:Byte absolute S[0];
begin
 Count := 0;
 I := 1;
 Len := 0;
 Result[0] := #0;
 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, add the I'th character to Tmp}
   if Count = N then begin
    Inc(Len);
    Result[0] := Char(Len);
    Result[Len] := S[I];
   end;
   Inc(I);
  end;
 end;
end;

{
function SkipWords(n:Integer; const s:ShortString; const ScanSpaces:TCharSet):ShortString;
 function SkipLeft(const s:ShortString):ShortString;
 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:ShortString):ShortString;
 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:ShortString; const ScanSpaces:TCharSet):ShortString;
var i,len:Integer;
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:ShortString; const Delims:TCharSet):Byte;
var i:integer;
begin
 Result:=0;
 for i:=1 to WordCount(Str,Delims) do
 if ExtractWord(i,Str,Delims)=Name then begin
  Result:=i;
  break;
 end;
end;

function ExtractInt(N:Byte; const S:ShortString; const WordDelims:TCharSet; var Value:LongInt):boolean;
begin
 Result:=Str2Long(ExtractWord(N,S,WordDelims),Value);
end;

function ExtractReal(N:Byte; const S:ShortString; 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):ShortString;
const
 nbit = 1;
 mask = (1 shl nbit)-1;
 leng = (sizeof(x)*8+nbit-1) div nbit;
var
 i : integer;
begin
 Result[0]:=chr(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):ShortString;
const
 nbit = 1;
 mask = (1 shl nbit)-1;
 leng = (sizeof(x)*8+nbit-1) div nbit;
var
 i : integer;
begin
 Result[0]:=chr(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):ShortString;
const
 nbit = 1;
 mask = (1 shl nbit)-1;
 leng = (sizeof(x)*8+nbit-1) div nbit;
var
 i : integer;
begin
 Result[0]:=chr(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):ShortString;
const
 nbit = 3;
 mask = (1 shl nbit)-1;
 leng = (sizeof(x)*8+nbit-1) div nbit;
var
 i : integer;
begin
 Result[0]:=chr(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):ShortString;
const
 nbit = 3;
 mask = (1 shl nbit)-1;
 leng = (sizeof(x)*8+nbit-1) div nbit;
var
 i : integer;
begin
 Result[0]:=chr(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):ShortString;
const
 nbit = 3;
 mask = (1 shl nbit)-1;
 leng = (sizeof(x)*8+nbit-1) div nbit;
var
 i : integer;
begin
 Result[0]:=chr(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):ShortString;
const
 nbit = 4;
 mask = (1 shl nbit)-1;
 leng = (sizeof(x)*8+nbit-1) div nbit;
var
 i : integer;
begin
 Result[0]:=chr(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):ShortString;
const
 nbit = 4;
 mask = (1 shl nbit)-1;
 leng = (sizeof(x)*8+nbit-1) div nbit;
var
 i : integer;
begin
 Result[0]:=chr(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):ShortString;
const
 nbit = 4;
 mask = (1 shl nbit)-1;
 leng = (sizeof(x)*8+nbit-1) div nbit;
var
 i : integer;
begin
 Result[0]:=chr(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):ShortString;
begin
 Str(L,Result);
end;

function Real2Str(R:Double; Width:Integer=0; Places:Integer=0):ShortString;
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):ShortString;
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):ShortString;
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;

(*
function FormatG(X:Double; w:integer; d:integer):ShortString;
begin
 Result:=Format('%'+IntToStr(w)+'.'+IntToStr(d+1)+'G', [X]);
end;
*)

function FormatG(X:Double; w:integer; d:integer):ShortString;
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;

 {
 ****************************
 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; var 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; var 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:ShortString; var 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:ShortString; var 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:ShortString; var 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:ShortString; var 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:ShortString; 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:ShortString; Def:Integer):Integer;
var code:Integer;
begin
 Val(Trim(S), Result, code);
 if code <> 0 then Result := Def;
end;

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

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

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

function StrBin2Long(const S:ShortString; var 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:ShortString; var 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:ShortString; var 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:word; Str:PChar; const Format:ShortString; var Data):PChar;
var
 w,p,words  : word;
 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,CR] 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 w:=1 to words do begin
  {
  Init cycle vars and extract word of format
  }
  Prefix :='';
  ValStr :='';
  FormatWord:=ExtractWord(w,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-[CR]);
     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-[CR]);
     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-[CR]);
     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-[CR]);
     if not ReadExpected([#1..#255]-ScanSpaces-[CR]) 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-[CR]);                  {? pass space chars}
     if not ReadExpected([#1..#255]-[CR]) then exit;
     ShortString(DataPtr^):=ValStr;
     DataPtr:=IncPtr(DataPtr,sizeof(ShortString));
    end;
   'C': { pass spaces and read char }
    begin
     Str:=StrPass(Str,ScanSpaces-[CR]); {? pass space chars}
     if Str[0]=#0 then exit;
     if Str[0]=CR 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:Integer; const Name:LongString; Mode:Integer=csm_Default):LongString;
var lenline,lenname:Integer; line:PChar; c,no,Delim:Char; s,n,v:LongString;
 procedure ProcessLine;
 var p:Integer; 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);
 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:ShortString):boolean;
var i:integer;
begin
 Result:=false;
 for i:=1 to Length(S) do if S[i]>' ' then exit;
 Result:=true;
end;

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

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

function AddBackSlash(const DirName:ShortString):ShortString;
begin
 Result:=Trim(DirName);
 if not (Result[Length(Result)] in DosDelimiters)
 then Result:=Result+'\';
end;

function AddPathDelim(const DirName:ShortString):ShortString;
begin
 Result:=Trim(DirName);
 if not (Result[Length(Result)] in DosDelimiters)
 then Result:=Result+PathDelim;
end;

function DropBackSlash(const DirName:ShortString):ShortString;
var RLen:byte absolute Result[0];
begin
 Result:=Trim(DirName);
 if (RLen>1) and (Result[RLen] in DirDelimiters) and not (Result[RLen-1] in DosDelimiters)
 then Dec(RLen);
end;

function DropPathDelim(const DirName:ShortString):ShortString;
var RLen:byte absolute Result[0];
begin
 Result:=Trim(DirName);
 if (RLen>1) and (Result[RLen] in DirDelimiters) and not (Result[RLen-1] in DosDelimiters)
 then Dec(RLen);
end;

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

function IsRelativePath(const S:ShortString):boolean;
var i:integer;
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:ShortString; var DotPos:Integer):Boolean;
var DosDel:Integer; 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);
   {Result:=true;}
  end;
 end;
end;

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

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

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

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

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

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

function ExtractFileName(const FileName: ShortString):ShortString;
var i,j:Integer;
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: ShortString):ShortString;
var i,j:Integer;
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: ShortString): ShortString;
var DotPos:Integer;
begin
 if HasExtension(FileName, DotPos)
 then Result := Trim(Copy(FileName, DotPos, Length(FileName)-DotPos+1))
 else Result := '';
end;

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

function ExtractFileDrive(FileName: ShortString): ShortString;
var
 I, J: Integer;
begin
 FileName:=Trim(FileName);
 if (Length(FileName)>=2) 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):ShortString;
var
 T : TText;
begin
 Result:='';
 try
  T:=NewText;
  try
   T.Text:=StringReplace(Filter,'|',CRLF,[rfReplaceAll]);
   Result:=UnifyAlias(ExtractFileExt(ExtractWord(1,T[Index*2-1],[';'])));
  finally
   Kill(T);
  end;
 except
  on E:Exception do BugReport(E);
 end;
end;

function FExpand(const Path: ShortString):ShortString;
begin
 Result:=ExpandFileName(Trim(Path));
end;

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

function MakeRelativePath(const Path,Base:ShortString):ShortString;
var i,p:integer; TheBas:ShortString;
begin
 if IsEmptyStr(Base) then Result:=UnifyFileAlias(Path) else begin
  Result:=UnifyFileAlias(Path);
  TheBas:=AddBackSlash(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:='..\'+Result;
  end;
  if UnifyFileAlias((DefaultPath(Result,ExtractFilePath(Base))))<>
     UnifyFileAlias(Path) then Result:=UnifyFileAlias(Path);
 end;
end;

function HasListedExtension(const Path,PathExt:ShortString; 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);
   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);
 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);
 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);
 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);
 end;
end;

function TText.GetLn( NumLn:LongInt ): ShortString;
begin
 Result:='';
 if Assigned(Self) then begin
  Lock;
  if LongWord(NumLn)<LongWord(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 LongWord(NumLn)<LongWord(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 LongWord(NumLn)<LongWord(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 LongWord(NumLn)<=LongWord(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);
 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 AddLineCRLF(Index:LongInt; const TextLine:ShortString;
                  var Terminate:boolean; CustomData:Pointer);
 procedure AddStr(const Str:ShortString);
 begin
  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(CRLF);
end;

function TText.GetText:LongString;
var AddLineRec:TAddLineRec;
begin
 Result:='';
 if Assigned(Self) then
 try
  Lock;
  try
   AddLineRec.Counter:=0;
   AddLineRec.DataPtr:=nil;
   ForEach(AddLineCRLF,@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(AddLineCRLF,@AddLineRec);
    end;
   end;
  finally
   UnLock;
  end;
 except
  on E:Exception do begin
   Result:='';
   ErrorReport(E);
  end;
 end;
end;

procedure TText.SetText(const aText:LongString);
var i:integer; c:char; s:ShortString;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   Count:=0;
   s:='';
   for i:=1 to Length(aText) do begin
    c:=aText[i];
    case c of
     #0 : break;
     LF : ;
     CR : begin AddLn(s); s:=''; end;
     else if s[0]<high(s[0]) then begin inc(s[0]); s[ord(s[0])]:=c; end;
    end;
   end;
   if s<>'' then Addln(s);
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorReport(E);
 end;
end;

procedure TText.Read(var F:Text);
var IORes:Integer; s:ShortString;
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);
 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);
 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);
 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;

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);
 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);
 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);
 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);
 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);
 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 : ShortString = '';
                            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);
 end;
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): ShortString;
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:Integer; 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 Echo(E.Message) else Raise;
  end;
 end;
end;

function URL_Decode(const S:LongString; Mode:Integer):LongString;
const
 HexChar:PChar='0123456789ABCDEF';
var
 i,n,L,cl,ch:Integer; 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 Echo(E.Message) else Raise;
  end;
 end;
end;

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

{$ENDIF SKIP_DRAFT}

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);
 {$IFDEF SKIP_DRAFT}
 InitCharToNumber;
 {$ENDIF SKIP_DRAFT}
end;

procedure Free_crw_str;
begin
end;

initialization

 Init_crw_str;

finalization

 Free_crw_str;

end.

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

