 {
 ****************************************************************************
 CRW32 project
 Copyright (C) by Kuryakin Alexey, Sarov, Russia, 2001, <kouriakine@mail.ru>
 String manipulation procedures.
 Modifications:
 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
 ****************************************************************************
 }

unit _str;

{$I _sysdef}

interface

uses
 sysutils, windows, math, _alloc, _fifo, _fpu, _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       = CR+LF;      { 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 { Multiplatform programming constants, see https://wiki.lazarus.freepascal.org/Multiplatform_Programming_Guide }
 LineEnding         = CRLF;               { Current platform line break: Windows(CRLF), Linux(LF), MacOS(CR) }
 sLineBreak         = LineEnding;         { Current platform line break: Windows(CRLF), Linux(LF), MacOS(CR) }
 DirectorySeparator = '\';                { Current platform directory separator: Windows(\), Unix(/) }
 PathDelim          = DirectorySeparator; { Current platform directory separator: Windows(\), Unix(/) }
 PathSeparator      = ';';                { Current platform PATH separator: Windows(;), Unix(:) }
 PathSep            = PathSeparator;      { Current platform PATH separator: Windows(;), Unix(:) }

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: Integer): 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:String; StartPos:Integer):Integer; overload;

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

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

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

 { Return position (1-based) of CR or LF or zero if one not found. }
function PosEol(Buf:String; 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:ShortString);

 { Setup case conversion table LoCaseTable, UpCaseTable ... }
procedure CaseTable_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:ShortString):ShortString;

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

 { 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:ShortString):ShortString;
function  DosToWinStr(const S:ShortString):ShortString;
function  WinToDosLongStr(const S:LongString):LongString;
function  DosToWinLongStr(const S:LongString):LongString;
function  WinToKoi(c:Char):Char;
function  KoiToWin(c:Char):Char;
function  WinToKoiStr(const S:ShortString):ShortString;
function  KoiToWinStr(const S:ShortString):ShortString;
function  WinToKoiLongStr(const S:LongString):LongString;
function  KoiToWinLongStr(const S:LongString):LongString;

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

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

 { Create set of chars presents in S }
function  Str2CharSet(const S: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(const F:Text);
  function    ReadFile(const aFileName:ShortString; AppendMode:Boolean=false):Integer;
  procedure   Write(const 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;
function GetWindowsErrorMessage(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;

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: Integer): 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:String; StartPos:Integer):Integer; overload;
begin
 Result:=PosEx(PChar(Sub),Length(Sub),PChar(Str),Length(Str),StartPos-1)+1;
end;

function LastPos(const Sub,Str:String):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:String):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:String; 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:String; 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:ShortString);
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 CaseTable_NoCase;
begin
 SetupCharTable(LoCaseTable,'','');
 SetupCharTable(UpCaseTable,'','');
end;

procedure SetCaseTable_Default;
begin
 SetCaseTable_RusWin;
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:ShortString):ShortString;
var i:integer;
begin
 Result[0]:=S[0];
 for i:=1 to ord(S[0]) do Result[i]:=LoCaseTable[S[i]];
end;

function UpCaseStr(const S:ShortString):ShortString;
var i:integer;
begin
 Result[0]:=S[0];
 for i:=1 to ord(S[0]) do Result[i]:=UpCaseTable[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:=1 to Length(S1) do
 if UpCaseTable[S1[i]]<>UpCaseTable[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:ShortString):ShortString;
var i:integer;
begin
 Result[0]:=S[0];
 for i:=1 to ord(S[0]) do Result[i]:=WinToDosTable[S[i]];
end;

function  DosToWinStr(const S:ShortString):ShortString;
var i:integer;
begin
 Result[0]:=S[0];
 for i:=1 to ord(S[0]) do Result[i]:=DosToWinTable[S[i]];
end;

function  WinToDosLongStr(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  DosToWinLongStr(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:ShortString):ShortString;
var i:integer;
begin
 Result[0]:=S[0];
 for i:=1 to ord(S[0]) do Result[i]:=WinToKoiTable[S[i]];
end;

function  KoiToWinStr(const S:ShortString):ShortString;
var i:integer;
begin
 Result[0]:=S[0];
 for i:=1 to ord(S[0]) do Result[i]:=KoiToWinTable[S[i]];
end;

function  WinToKoiLongStr(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  KoiToWinLongStr(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;

 {
 ***********************************
 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:=(MultiByteToWideChar(CP_UTF8,MB_ERR_INVALID_CHARS,arg,leng,nil,0)>0);
    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; overload;
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;
var
 Buffer : packed array[0..MAX_PATH-1] of Char;
 FPath  : packed array[0..high(byte)] of Char;
 Temp   : PChar;
 i      : Longint;
begin
 if IsEmptyStr(Path) then StrPCopy(FPath,'.') else StrPCopy(FPath,Trim(Path));
 for i:=1 to StrLen(FPath) do if FPath[i]='/' then FPath[i]:='\';
 Temp:=nil;
 SafeFillChar(Buffer,sizeof(Buffer),0);
 SetString(Result,Buffer,Windows.GetFullPathName(FPath, sizeof(Buffer), Buffer, Temp));
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(const 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(const 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;

 {
 **********************
 Windows error messages
 **********************
 }
function SysErrorMessage(ErrorCode: Integer): ShortString;
var
  Len    : Integer;
  Buffer : array[0..255] of Char;
begin
 Len := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY,
                      nil, ErrorCode, 0, Buffer, SizeOf(Buffer), nil);
 while (Len > 0) and (Buffer[Len - 1] in [#0..#32, '.']) do Dec(Len);
 SetString(Result, Buffer, Len);
end;

function GetWindowsErrorMessage(ErrorCode:Integer):ShortString;
begin
 Result := '';
 case ErrorCode of
  ERROR_SUCCESS                    : Result := 'The operation completed successfully.';
  ERROR_INVALID_FUNCTION           : Result := 'Incorrect function.';
  ERROR_FILE_NOT_FOUND             : Result := 'The system cannot find the file specified.';
  ERROR_PATH_NOT_FOUND             : Result := 'The system cannot find the path specified.';
  ERROR_TOO_MANY_OPEN_FILES        : Result := 'The system cannot open the file.';
  ERROR_ACCESS_DENIED              : Result := 'Access is denied.';
  ERROR_INVALID_HANDLE             : Result := 'The handle is invalid.';
  ERROR_ARENA_TRASHED              : Result := 'The storage control blocks were destroyed.';
  ERROR_NOT_ENOUGH_MEMORY          : Result := 'Not enough storage is available to process this command.';
  ERROR_INVALID_BLOCK              : Result := 'The storage control block address is invalid.';
  ERROR_BAD_ENVIRONMENT            : Result := 'The environment is incorrect.';
  ERROR_BAD_FORMAT                 : Result := 'An attempt was made to load a program with an incorrect format.';
  ERROR_INVALID_ACCESS             : Result := 'The access code is invalid.';
  ERROR_INVALID_DATA               : Result := 'The data is invalid.';
  ERROR_OUTOFMEMORY                : Result := 'Not enough storage is available to complete this operation.';
  ERROR_INVALID_DRIVE              : Result := 'The system cannot find the drive specified.';
  ERROR_CURRENT_DIRECTORY          : Result := 'The directory cannot be removed.';
  ERROR_NOT_SAME_DEVICE            : Result := 'The system cannot move the file to a different disk drive.';
  ERROR_NO_MORE_FILES              : Result := 'There are no more files.';
  ERROR_WRITE_PROTECT              : Result := 'The media is write protected.';
  ERROR_BAD_UNIT                   : Result := 'The system cannot find the device specified.';
  ERROR_NOT_READY                  : Result := 'The device is not ready.';
  ERROR_BAD_COMMAND                : Result := 'The device does not recognize the command.';
  ERROR_CRC                        : Result := 'Data error (cyclic redundancy check).';
  ERROR_BAD_LENGTH                 : Result := 'The program issued a command but the command length is incorrect.';
  ERROR_SEEK                       : Result := 'The drive cannot locate a specific area or track on the disk.';
  ERROR_NOT_DOS_DISK               : Result := 'The specified disk or diskette cannot be accessed.';
  ERROR_SECTOR_NOT_FOUND           : Result := 'The drive cannot find the sector requested.';
  ERROR_OUT_OF_PAPER               : Result := 'The printer is out of paper.';
  ERROR_WRITE_FAULT                : Result := 'The system cannot write to the specified device.';
  ERROR_READ_FAULT                 : Result := 'The system cannot read from the specified device.';
  ERROR_GEN_FAILURE                : Result := 'A device attached to the system is not functioning.';
  ERROR_SHARING_VIOLATION          : Result := 'The process cannot access the file because it is being used by another process.';
  ERROR_LOCK_VIOLATION             : Result := 'The process cannot access the file because another process has locked a portion of the file.';
  ERROR_WRONG_DISK                 : Result := 'The wrong diskette is in the drive. Insert %2 (Volume Serial Number: %3) into drive %1.';
  ERROR_SHARING_BUFFER_EXCEEDED    : Result := 'Too many files opened for sharing.';
  ERROR_HANDLE_EOF                 : Result := 'Reached end of file.';
  ERROR_HANDLE_DISK_FULL           : Result := 'The disk is full.';
  ERROR_NOT_SUPPORTED              : Result := 'The network request is not supported.';
  ERROR_REM_NOT_LIST               : Result := 'The remote computer is not available.';
  ERROR_DUP_NAME                   : Result := 'A duplicate name exists on the network.';
  ERROR_BAD_NETPATH                : Result := 'The network path was not found.';
  ERROR_NETWORK_BUSY               : Result := 'The network is busy.';
  ERROR_DEV_NOT_EXIST              : Result := 'The specified network resource or device is no longer available.';
  ERROR_TOO_MANY_CMDS              : Result := 'The network BIOS command limit has been reached.';
  ERROR_ADAP_HDW_ERR               : Result := 'A network adapter hardware error occurred.';
  ERROR_BAD_NET_RESP               : Result := 'The specified server cannot perform the requested  operation.';
  ERROR_UNEXP_NET_ERR              : Result := 'An unexpected network error occurred.';
  ERROR_BAD_REM_ADAP               : Result := 'The remote adapter is not compatible.';
  ERROR_PRINTQ_FULL                : Result := 'The printer queue is full.';
  ERROR_NO_SPOOL_SPACE             : Result := 'Space to store the file waiting to be printed is not available on the server.';
  ERROR_PRINT_CANCELLED            : Result := 'Your file waiting to be printed was deleted.';
  ERROR_NETNAME_DELETED            : Result := 'The specified network name is no longer available.';
  ERROR_NETWORK_ACCESS_DENIED      : Result := 'Network access is denied.';
  ERROR_BAD_DEV_TYPE               : Result := 'The network resource type is not correct.';
  ERROR_BAD_NET_NAME               : Result := 'The network name cannot be found.';
  ERROR_TOO_MANY_NAMES             : Result := 'The name limit for the local computer network adapter card was exceeded.';
  ERROR_TOO_MANY_SESS              : Result := 'The network BIOS session limit was exceeded.';
  ERROR_SHARING_PAUSED             : Result := 'The remote server has been paused or is in the process of being started.';
  ERROR_REQ_NOT_ACCEP              : Result := 'No more connections can be made to this remote computer at this time  because there are already as many connections as the computer can accept.';
  ERROR_REDIR_PAUSED               : Result := 'The specified printer or disk device has been paused.';
  ERROR_FILE_EXISTS                : Result := 'The file exists.';
  ERROR_CANNOT_MAKE                : Result := 'The directory or file cannot be created.';
  ERROR_FAIL_I24                   : Result := 'Fail on INT 24';
  ERROR_OUT_OF_STRUCTURES          : Result := 'Storage to process this request is not available.';
  ERROR_ALREADY_ASSIGNED           : Result := 'The local device name is already in use.';
  ERROR_INVALID_PASSWORD           : Result := 'The specified network password is not correct.';
  ERROR_INVALID_PARAMETER          : Result := 'The parameter is incorrect.';
  ERROR_NET_WRITE_FAULT            : Result := 'A write fault occurred on the network.';
  ERROR_NO_PROC_SLOTS              : Result := 'The system cannot start another process at this time.';
  ERROR_TOO_MANY_SEMAPHORES        : Result := 'Cannot create another system semaphore.';
  ERROR_EXCL_SEM_ALREADY_OWNED     : Result := 'The exclusive semaphore is owned by another process.';
  ERROR_SEM_IS_SET                 : Result := 'The semaphore is set and cannot be closed.';
  ERROR_TOO_MANY_SEM_REQUESTS      : Result := 'The semaphore cannot be set again.';
  ERROR_INVALID_AT_INTERRUPT_TIME  : Result := 'Cannot request exclusive semaphores at interrupt time.';
  ERROR_SEM_OWNER_DIED             : Result := 'The previous ownership of this semaphore has ended.';
  ERROR_SEM_USER_LIMIT             : Result := 'Insert the diskette for drive %1.';
  ERROR_DISK_CHANGE                : Result := 'Program stopped because alternate diskette was not inserted.';
  ERROR_DRIVE_LOCKED               : Result := 'The disk is in use or locked by another process.';
  ERROR_BROKEN_PIPE                : Result := 'The pipe has been ended.';
  ERROR_OPEN_FAILED                : Result := 'The system cannot open the device or file specified.';
  ERROR_BUFFER_OVERFLOW            : Result := 'The file name is too long.';
  ERROR_DISK_FULL                  : Result := 'There is not enough space on the disk.';
  ERROR_NO_MORE_SEARCH_HANDLES     : Result := 'No more internal file identifiers available.';
  ERROR_INVALID_TARGET_HANDLE      : Result := 'The target internal file identifier is incorrect.';
  ERROR_INVALID_CATEGORY           : Result := 'The IOCTL call made by the application program is not correct.';
  ERROR_INVALID_VERIFY_SWITCH      : Result := 'The verify-on-write switch parameter value is not correct.';
  ERROR_BAD_DRIVER_LEVEL           : Result := 'The system does not support the command requested.';
  ERROR_CALL_NOT_IMPLEMENTED       : Result := 'This function is only valid in Windows NT mode.';
  ERROR_SEM_TIMEOUT                : Result := 'The semaphore timeout period has expired.';
  ERROR_INSUFFICIENT_BUFFER        : Result := 'The data area passed to a system call is too small.';
  ERROR_INVALID_NAME               : Result := 'The filename, directory name, or volume label syntax is incorrect.';
  ERROR_INVALID_LEVEL              : Result := 'The system call level is not correct.';
  ERROR_NO_VOLUME_LABEL            : Result := 'The disk has no volume label.';
  ERROR_MOD_NOT_FOUND              : Result := 'The specified module could not be found.';
  ERROR_PROC_NOT_FOUND             : Result := 'The specified procedure could not be found.';
  ERROR_WAIT_NO_CHILDREN           : Result := 'There are no child processes to wait for.';
  ERROR_CHILD_NOT_COMPLETE         : Result := 'The %1 application cannot be run in Windows NT mode.';
  ERROR_DIRECT_ACCESS_HANDLE       : Result := 'Attempt to use a file handle to an open disk partition for an operation other than raw disk I/O.';
  ERROR_NEGATIVE_SEEK              : Result := 'An attempt was made to move the file pointer before the beginning of the file.';
  ERROR_SEEK_ON_DEVICE             : Result := 'The file pointer cannot be set on the specified device or file.';
  ERROR_IS_JOIN_TARGET             : Result := 'A JOIN or SUBST command cannot be used for a drive that contains previously joined drives.';
  ERROR_IS_JOINED                  : Result := 'An attempt was made to use a JOIN or SUBST command on a drive that has already been joined.';
  ERROR_IS_SUBSTED                 : Result := 'An attempt was made to use a JOIN or SUBST command on a drive that has already been substituted.';
  ERROR_NOT_JOINED                 : Result := 'The system tried to delete the JOIN of a drive that is not joined.';
  ERROR_NOT_SUBSTED                : Result := 'The system tried to delete the substitution of a drive that is not substituted.';
  ERROR_JOIN_TO_JOIN               : Result := 'The system tried to join a drive to a directory on a joined drive.';
  ERROR_SUBST_TO_SUBST             : Result := 'The system tried to substitute a drive to a directory on a substituted drive.';
  ERROR_JOIN_TO_SUBST              : Result := 'The system tried to join a drive to a directory on a substituted drive.';
  ERROR_SUBST_TO_JOIN              : Result := 'The system tried to SUBST a drive to a directory on a joined drive.';
  ERROR_BUSY_DRIVE                 : Result := 'The system cannot perform a JOIN or SUBST at this time.';
  ERROR_SAME_DRIVE                 : Result := 'The system cannot join or substitute a drive to or for a directory on the same drive.';
  ERROR_DIR_NOT_ROOT               : Result := 'The directory is not a subdirectory of the root directory.';
  ERROR_DIR_NOT_EMPTY              : Result := 'The directory is not empty.';
  ERROR_IS_SUBST_PATH              : Result := 'The path specified is being used in a substitute.';
  ERROR_IS_JOIN_PATH               : Result := 'Not enough resources are available to process this command.';
  ERROR_PATH_BUSY                  : Result := 'The path specified cannot be used at this time.';
  ERROR_IS_SUBST_TARGET            : Result := 'An attempt was made to join or substitute a drive for which a directory on the drive is the target of a previous substitute.';
  ERROR_SYSTEM_TRACE               : Result := 'System trace information was not specified in your CONFIG.SYS file, or tracing is disallowed.';
  ERROR_INVALID_EVENT_COUNT        : Result := 'The number of specified semaphore events for DosMuxSemWait is not correct.';
  ERROR_TOO_MANY_MUXWAITERS        : Result := 'DosMuxSemWait did not execute; too many semaphores are already set.';
  ERROR_INVALID_LIST_FORMAT        : Result := 'The DosMuxSemWait list is not correct.';
  ERROR_LABEL_TOO_LONG             : Result := 'The volume label you entered exceeds the label character limit of the target file system.';
  ERROR_TOO_MANY_TCBS              : Result := 'Cannot create another thread.';
  ERROR_SIGNAL_REFUSED             : Result := 'The recipient process has refused the signal.';
  ERROR_DISCARDED                  : Result := 'The segment is already discarded and cannot be locked.';
  ERROR_NOT_LOCKED                 : Result := 'The segment is already unlocked.';
  ERROR_BAD_THREADID_ADDR          : Result := 'The address for the thread ID is not correct.';
  ERROR_BAD_ARGUMENTS              : Result := 'The argument string passed to DosExecPgm is not correct.';
  ERROR_BAD_PATHNAME               : Result := 'The specified path is invalid.';
  ERROR_SIGNAL_PENDING             : Result := 'A signal is already pending.';
  ERROR_MAX_THRDS_REACHED          : Result := 'No more threads can be created in the system.';
  ERROR_LOCK_FAILED                : Result := 'Unable to lock a region of a file.';
  ERROR_BUSY                       : Result := 'The requested resource is in use.';
  ERROR_CANCEL_VIOLATION           : Result := 'A lock request was not outstanding for the supplied cancel region.';
  ERROR_ATOMIC_LOCKS_NOT_SUPPORTED : Result := 'The file system does not support atomic changes to the lock type.';
  ERROR_INVALID_SEGMENT_NUMBER     : Result := 'The system detected a segment number that was not correct.';
  ERROR_INVALID_ORDINAL            : Result := 'The operating system cannot run %1.';
  ERROR_ALREADY_EXISTS             : Result := 'Cannot create a file when that file already exists.';
  ERROR_INVALID_FLAG_NUMBER        : Result := 'The flag passed is not correct.';
  ERROR_SEM_NOT_FOUND              : Result := 'The specified system semaphore name was not found.';
  ERROR_INVALID_STARTING_CODESEG   : Result := 'The operating system cannot run %1.';
  ERROR_INVALID_STACKSEG           : Result := 'The operating system cannot run %1.';
  ERROR_INVALID_MODULETYPE         : Result := 'The operating system cannot run %1.';
  ERROR_INVALID_EXE_SIGNATURE      : Result := 'Cannot run %1 in Windows NT mode.';
  ERROR_EXE_MARKED_INVALID         : Result := 'The operating system cannot run %1.';
  ERROR_BAD_EXE_FORMAT             : Result := '%1 is not a valid Windows NT application.';
  ERROR_ITERATED_DATA_EXCEEDS_64k  : Result := 'The operating system cannot run %1.';
  ERROR_INVALID_MINALLOCSIZE       : Result := 'The operating system cannot run %1.';
  ERROR_DYNLINK_FROM_INVALID_RING  : Result := 'The operating system cannot run this application program.';
  ERROR_IOPL_NOT_ENABLED           : Result := 'The operating system is not presently configured to run this application.';
  ERROR_INVALID_SEGDPL             : Result := 'The operating system cannot run %1.';
  ERROR_AUTODATASEG_EXCEEDS_64k    : Result := 'The operating system cannot run this application program.';
  ERROR_RING2SEG_MUST_BE_MOVABLE   : Result := 'The code segment cannot be greater than or equal to 64KB.';
  ERROR_RELOC_CHAIN_XEEDS_SEGLIM   : Result := 'The operating system cannot run %1.';
  ERROR_INFLOOP_IN_RELOC_CHAIN     : Result := 'The operating system cannot run %1.';
  ERROR_ENVVAR_NOT_FOUND           : Result := 'The system could not find the environment option that was entered.';
  ERROR_NO_SIGNAL_SENT             : Result := 'No process in the command subtree has a signal handler.';
  ERROR_FILENAME_EXCED_RANGE       : Result := 'The filename or extension is too long.';
  ERROR_RING2_STACK_IN_USE         : Result := 'The ring 2 stack is in use.';
  ERROR_META_EXPANSION_TOO_LONG    : Result := 'The global filename characters, * or ?, are entered incorrectly or too many global filename characters are specified.';
  ERROR_INVALID_SIGNAL_NUMBER      : Result := 'The signal being posted is not correct.';
  ERROR_THREAD_1_INACTIVE          : Result := 'The signal handler cannot be set.';
  ERROR_LOCKED                     : Result := 'The segment is locked and cannot be reallocated.';
  ERROR_TOO_MANY_MODULES           : Result := 'Too many dynamic link modules are attached to this program or dynamic link module.';
  ERROR_NESTING_NOT_ALLOWED        : Result := 'Can''t nest calls to LoadModule.';
  ERROR_EXE_MACHINE_TYPE_MISMATCH  : Result := 'The image file %1 is valid, but is for a machine type other than the current machine.';
  ERROR_BAD_PIPE                   : Result := 'The pipe state is invalid.';
  ERROR_PIPE_BUSY                  : Result := 'All pipe instances are busy.';
  ERROR_NO_DATA                    : Result := 'The pipe is being closed.';
  ERROR_PIPE_NOT_CONNECTED         : Result := 'No process is on the other end of the pipe.';
  ERROR_MORE_DATA                  : Result := 'More data is available.';
  ERROR_VC_DISCONNECTED            : Result := 'The session was cancelled.';
  ERROR_INVALID_EA_NAME            : Result := 'The specified extended attribute name was invalid.';
  ERROR_EA_LIST_INCONSISTENT       : Result := 'The extended attributes are inconsistent.';
  ERROR_NO_MORE_ITEMS              : Result := 'No more data is available.';
  ERROR_CANNOT_COPY                : Result := 'The Copy API cannot be used.';
  ERROR_DIRECTORY                  : Result := 'The directory name is invalid.';
  ERROR_EAS_DIDNT_FIT              : Result := 'The extended attributes did not fit in the buffer.';
  ERROR_EA_FILE_CORRUPT            : Result := 'The extended attribute file on the mounted file system is corrupt.';
  ERROR_EA_TABLE_FULL              : Result := 'The extended attribute table file is full.';
  ERROR_INVALID_EA_HANDLE          : Result := 'The specified extended attribute handle is invalid.';
  ERROR_EAS_NOT_SUPPORTED          : Result := 'The mounted file system does not support extended attributes.';
  ERROR_NOT_OWNER                  : Result := 'Attempt to release mutex not owned by caller.';
  ERROR_TOO_MANY_POSTS             : Result := 'Too many posts were made to a semaphore.';
  ERROR_PARTIAL_COPY               : Result := 'Only part of a Read/WriteProcessMemory request was completed.';
  ERROR_MR_MID_NOT_FOUND           : Result := 'The system cannot find message for message number $%1 in message file for %2.';
  ERROR_INVALID_ADDRESS            : Result := 'Attempt to access invalid address.';
  ERROR_ARITHMETIC_OVERFLOW        : Result := 'Arithmetic result exceeded 32 bits.';
  ERROR_PIPE_CONNECTED             : Result := 'There is a process on other end of the pipe.';
  ERROR_PIPE_LISTENING             : Result := 'Waiting for a process to open the other end of the pipe.';
  ERROR_EA_ACCESS_DENIED           : Result := 'Access to the extended attribute was denied.';
  ERROR_OPERATION_ABORTED          : Result := 'The I/O operation has been aborted because of either a thread exit or an application request.';
  ERROR_IO_INCOMPLETE              : Result := 'Overlapped I/O event is not in a signalled state.';
  ERROR_IO_PENDING                 : Result := 'Overlapped I/O operation is in progress.';
  ERROR_NOACCESS                   : Result := 'Invalid access to memory location.';
  ERROR_SWAPERROR                  : Result := 'Error performing inpage operation.';
  ERROR_STACK_OVERFLOW             : Result := 'Recursion too deep, stack overflowed.';
  ERROR_INVALID_MESSAGE            : Result := 'The window cannot act on the sent message.';
  ERROR_CAN_NOT_COMPLETE           : Result := 'Cannot complete this function.';
  ERROR_INVALID_FLAGS              : Result := 'Invalid flags.';
  ERROR_UNRECOGNIZED_VOLUME        : Result := 'The volume does not contain a recognized file system.';
  ERROR_FILE_INVALID               : Result := 'The volume for a file has been externally altered such that the opened file is no longer valid.';
  ERROR_FULLSCREEN_MODE            : Result := 'The requested operation cannot be performed in full-screen mode.';
  ERROR_NO_TOKEN                   : Result := 'An attempt was made to reference a token that does not exist.';
  ERROR_BADDB                      : Result := 'The configuration registry database is corrupt.';
  ERROR_BADKEY                     : Result := 'The configuration registry key is invalid.';
  ERROR_CANTOPEN                   : Result := 'The configuration registry key could not be opened.';
  ERROR_CANTREAD                   : Result := 'The configuration registry key could not be read.';
  ERROR_CANTWRITE                  : Result := 'The configuration registry key could not be written.';
  ERROR_REGISTRY_RECOVERED         : Result := 'One of the files in the Registry database had to be recovered by use of a log or alternate copy.  The recovery was successful.';
  ERROR_REGISTRY_CORRUPT           : Result := 'The Registry is corrupt.';
  ERROR_REGISTRY_IO_FAILED         : Result := 'An I/O operation initiated by the Registry failed unrecoverably.';
  ERROR_NOT_REGISTRY_FILE          : Result := 'The system has attempted to load or restore a file into the Registry, but the specified file is not in a Registry file format.';
  ERROR_KEY_DELETED                : Result := 'Illegal operation attempted on a Registry key which has been marked for deletion.';
  ERROR_NO_LOG_SPACE               : Result := 'System could not allocate the required space in a Registry log.';
  ERROR_KEY_HAS_CHILDREN           : Result := 'Cannot create a symbolic link in a Registry key that already has subkeys or values.';
  ERROR_CHILD_MUST_BE_VOLATILE     : Result := 'Cannot create a stable subkey under a volatile parent key.';
  ERROR_NOTIFY_ENUM_DIR            : Result := 'A notify change request is being completed and the information is not being returned in the caller''s buffer.';
  ERROR_DEPENDENT_SERVICES_RUNNING : Result := 'A stop control has been sent to a service which other running services are dependent on.';
  ERROR_INVALID_SERVICE_CONTROL    : Result := 'The requested control is not valid for this service.';
  ERROR_SERVICE_REQUEST_TIMEOUT    : Result := 'The service did not respond to the start or control request in a timely fashion.';
  ERROR_SERVICE_NO_THREAD          : Result := 'A thread could not be created for the service.';
  ERROR_SERVICE_DATABASE_LOCKED    : Result := 'The service database is locked.';
  ERROR_SERVICE_ALREADY_RUNNING    : Result := 'An instance of the service is already running.';
  ERROR_INVALID_SERVICE_ACCOUNT    : Result := 'The account name is invalid or does not exist.';
  ERROR_SERVICE_DISABLED           : Result := 'The specified service is disabled and cannot be started.';
  ERROR_CIRCULAR_DEPENDENCY        : Result := 'Circular service dependency was specified.';
  ERROR_SERVICE_DOES_NOT_EXIST     : Result := 'The specified service does not exist as an installed service.';
  ERROR_SERVICE_CANNOT_ACCEPT_CTRL : Result := 'The service cannot accept control messages at this time.';
  ERROR_SERVICE_NOT_ACTIVE         : Result := 'The service has not been started.';
  ERROR_FAILED_SERVICE_CONTROLLER_ : Result := 'The service process could not connect to the service controller.';
  ERROR_EXCEPTION_IN_SERVICE       : Result := 'An exception occurred in the service when handling the control request.';
  ERROR_DATABASE_DOES_NOT_EXIST    : Result := 'The database specified does not exist.';
  ERROR_SERVICE_SPECIFIC_ERROR     : Result := 'The service has returned a service-specific error code.';
  ERROR_PROCESS_ABORTED            : Result := 'The process terminated unexpectedly.';
  ERROR_SERVICE_DEPENDENCY_FAIL    : Result := 'The dependency service or group failed to start.';
  ERROR_SERVICE_LOGON_FAILED       : Result := 'The service did not start due to a logon failure.';
  ERROR_SERVICE_START_HANG         : Result := 'After starting, the service hung in a start-pending state.';
  ERROR_INVALID_SERVICE_LOCK       : Result := 'The specified service database lock is invalid.';
  ERROR_SERVICE_MARKED_FOR_DELETE  : Result := 'The specified service has been marked for deletion.';
  ERROR_SERVICE_EXISTS             : Result := 'The specified service already exists.';
  ERROR_ALREADY_RUNNING_LKG        : Result := 'The system is currently running with the last-known-good configuration.';
  ERROR_SERVICE_DEPENDENCY_DELETED : Result := 'The dependency service does not exist or has been marked for deletion.';
  ERROR_BOOT_ALREADY_ACCEPTED      : Result := 'The current boot has already been accepted for use as the last-known-good control set.';
  ERROR_SERVICE_NEVER_STARTED      : Result := 'No attempts to start the service have been made since the last boot.';
  ERROR_DUPLICATE_SERVICE_NAME     : Result := 'The name is already in use as either a service name or a service display name.';
  ERROR_DIFFERENT_SERVICE_ACCOUNT  : Result := 'The account specified for this service is different from the account specified for other services running in the same process.';
  ERROR_END_OF_MEDIA               : Result := 'The physical end of the tape has been reached.';
  ERROR_FILEMARK_DETECTED          : Result := 'A tape access reached a filemark.';
  ERROR_BEGINNING_OF_MEDIA         : Result := 'Beginning of tape or partition was encountered.';
  ERROR_SETMARK_DETECTED           : Result := 'A tape access reached the end of a set of files.';
  ERROR_NO_DATA_DETECTED           : Result := 'No more data is on the tape.';
  ERROR_PARTITION_FAILURE          : Result := 'Tape could not be partitioned.';
  ERROR_INVALID_BLOCK_LENGTH       : Result := 'When accessing a new tape of a multivolume partition, the current blocksize is incorrect.';
  ERROR_DEVICE_NOT_PARTITIONED     : Result := 'Tape partition information could not be found when loading a tape.';
  ERROR_UNABLE_TO_LOCK_MEDIA       : Result := 'Unable to lock the media eject mechanism.';
  ERROR_UNABLE_TO_UNLOAD_MEDIA     : Result := 'Unable to unload the media.';
  ERROR_MEDIA_CHANGED              : Result := 'Media in drive may have changed.';
  ERROR_BUS_RESET                  : Result := 'The I/O bus was reset.';
  ERROR_NO_MEDIA_IN_DRIVE          : Result := 'No media in drive.';
  ERROR_NO_UNICODE_TRANSLATION     : Result := 'No mapping for the Unicode character exists in the target multi-byte code page.';
  ERROR_DLL_INIT_FAILED            : Result := 'A dynamic link library (DLL) initialization routine failed.';
  ERROR_SHUTDOWN_IN_PROGRESS       : Result := 'A system shutdown is in progress.';
  ERROR_NO_SHUTDOWN_IN_PROGRESS    : Result := 'Unable to abort the system shutdown because no shutdown was in progress.';
  ERROR_IO_DEVICE                  : Result := 'The request could not be performed because of an I/O device error.';
  ERROR_SERIAL_NO_DEVICE           : Result := 'No serial device was successfully initialized.  The serial driver will unload.';
  ERROR_IRQ_BUSY                   : Result := 'Unable to open a device that was sharing an interrupt request (IRQ) with other devices.';
  ERROR_MORE_WRITES                : Result := 'A serial I/O operation was completed by another write to the serial port. (The IOCTL_SERIAL_XOFF_COUNTER reached zero.)';
  ERROR_COUNTER_TIMEOUT            : Result := 'A serial I/O operation completed because the time-out period expired. (The IOCTL_SERIAL_XOFF_COUNTER did not reach zero.)';
  ERROR_FLOPPY_ID_MARK_NOT_FOUND   : Result := 'No ID address mark was found on the floppy disk.';
  ERROR_FLOPPY_WRONG_CYLINDER      : Result := 'Mismatch between the floppy disk sector ID field and the floppy disk controller track address.';
  ERROR_FLOPPY_UNKNOWN_ERROR       : Result := 'The floppy disk controller reported an error that is not recognized by the floppy disk driver.';
  ERROR_FLOPPY_BAD_REGISTERS       : Result := 'The floppy disk controller returned inconsistent results in its registers.';
  ERROR_DISK_RECALIBRATE_FAILED    : Result := 'While accessing the hard disk, a recalibrate operation failed, even after retries.';
  ERROR_DISK_OPERATION_FAILED      : Result := 'While accessing the hard disk, a disk operation failed even after retries.';
  ERROR_DISK_RESET_FAILED          : Result := 'While accessing the hard disk, a disk controller reset was needed, but even that failed.';
  ERROR_EOM_OVERFLOW               : Result := 'Physical end of tape encountered.';
  ERROR_NOT_ENOUGH_SERVER_MEMORY   : Result := 'Not enough server storage is available to process this command.';
  ERROR_POSSIBLE_DEADLOCK          : Result := 'A potential deadlock condition has been detected.';
  ERROR_MAPPED_ALIGNMENT           : Result := 'The base address or the file offset specified does not have the proper alignment.';
  ERROR_SET_POWER_STATE_VETOED     : Result := 'An attempt to change the system power state was vetoed by another application or driver.';
  ERROR_SET_POWER_STATE_FAILED     : Result := 'The system BIOS failed an attempt to change the system power state.';
  ERROR_TOO_MANY_LINKS             : Result := 'An attempt was made to create more links on a file than the file system supports.';
  ERROR_OLD_WIN_VERSION            : Result := 'The specified program requires a newer version of Windows.';
  ERROR_APP_WRONG_OS               : Result := 'The specified program is not a Windows or MS-DOS program.';
  ERROR_SINGLE_INSTANCE_APP        : Result := 'Cannot start more than one instance of the specified program.';
  ERROR_RMODE_APP                  : Result := 'The specified program was written for an older version of Windows.';
  ERROR_INVALID_DLL                : Result := 'One of the library files needed to run this application is damaged.';
  ERROR_NO_ASSOCIATION             : Result := 'No application is associated with the specified file for this operation.';
  ERROR_DDE_FAIL                   : Result := 'An error occurred in sending the command to the application.';
  ERROR_DLL_NOT_FOUND              : Result := 'One of the library files needed to run this application cannot be found.';
  ERROR_BAD_USERNAME               : Result := 'The specified username is invalid.';
  ERROR_NOT_CONNECTED              : Result := 'This network connection does not exist.';
  ERROR_OPEN_FILES                 : Result := 'This network connection has files open or requests pending.';
  ERROR_ACTIVE_CONNECTIONS         : Result := 'Active connections still exist.';
  ERROR_DEVICE_IN_USE              : Result := 'The device is in use by an active process and cannot be disconnected.';
  ERROR_BAD_DEVICE                 : Result := 'The specified device name is invalid.';
  ERROR_CONNECTION_UNAVAIL         : Result := 'The device is not currently connected but it is a remembered connection.';
  ERROR_DEVICE_ALREADY_REMEMBERED  : Result := 'An attempt was made to remember a device that had previously been remembered.';
  ERROR_NO_NET_OR_BAD_PATH         : Result := 'No network provider accepted the given network path.';
  ERROR_BAD_PROVIDER               : Result := 'The specified network provider name is invalid.';
  ERROR_CANNOT_OPEN_PROFILE        : Result := 'Unable to open the network connection profile.';
  ERROR_BAD_PROFILE                : Result := 'The network connection profile is corrupt.';
  ERROR_NOT_CONTAINER              : Result := 'Cannot enumerate a non-container.';
  ERROR_EXTENDED_ERROR             : Result := 'An extended error has occurred.';
  ERROR_INVALID_GROUPNAME          : Result := 'The format of the specified group name is invalid.';
  ERROR_INVALID_COMPUTERNAME       : Result := 'The format of the specified computer name is invalid.';
  ERROR_INVALID_EVENTNAME          : Result := 'The format of the specified event name is invalid.';
  ERROR_INVALID_DOMAINNAME         : Result := 'The format of the specified domain name is invalid.';
  ERROR_INVALID_SERVICENAME        : Result := 'The format of the specified service name is invalid.';
  ERROR_INVALID_NETNAME            : Result := 'The format of the specified network name is invalid.';
  ERROR_INVALID_SHARENAME          : Result := 'The format of the specified share name is invalid.';
  ERROR_INVALID_PASSWORDNAME       : Result := 'The format of the specified password is invalid.';
  ERROR_INVALID_MESSAGENAME        : Result := 'The format of the specified message name is invalid.';
  ERROR_INVALID_MESSAGEDEST        : Result := 'The format of the specified message destination is invalid.';
  ERROR_SESSION_CREDENTIAL_CONFLICT : Result := 'The credentials supplied conflict with an existing set of credentials.';
  ERROR_REMOTE_SESSION_LIMIT_EXCEEDED : Result:= 'An attempt was made to establish a session to a network server, but there are already too many sessions established to that server.';
  ERROR_DUP_DOMAINNAME             : Result := 'The workgroup or domain name is already in use by another computer on the network.';
  ERROR_NO_NETWORK                 : Result := 'The network is not present or not started.';
  ERROR_CANCELLED                  : Result := 'The operation was cancelled by the user.';
  ERROR_USER_MAPPED_FILE           : Result := 'The requested operation cannot be performed on a file with a user mapped section open.';
  ERROR_CONNECTION_REFUSED         : Result := 'The remote system refused the network connection.';
  ERROR_GRACEFUL_DISCONNECT        : Result := 'The network connection was gracefully closed.';
  ERROR_ADDRESS_ALREADY_ASSOCIATED : Result := 'The network transport endpoint already has an address associated with it.';
  ERROR_ADDRESS_NOT_ASSOCIATED     : Result := 'An address has not yet been associated with the network endpoint.';
  ERROR_CONNECTION_INVALID         : Result := 'An operation was attempted on a non-existent network connection.';
  ERROR_CONNECTION_ACTIVE          : Result := 'An invalid operation was attempted on an active network connection.';
  ERROR_NETWORK_UNREACHABLE        : Result := 'The remote network is not reachable by the transport.';
  ERROR_HOST_UNREACHABLE           : Result := 'The remote system is not reachable by the transport.';
  ERROR_PROTOCOL_UNREACHABLE       : Result := 'The remote system does not support the transport protocol.';
  ERROR_PORT_UNREACHABLE           : Result := 'No service is operating at the destination network endpoint on the remote system.';
  ERROR_REQUEST_ABORTED            : Result := 'The request was aborted.';
  ERROR_CONNECTION_ABORTED         : Result := 'The network connection was aborted by the local system.';
  ERROR_RETRY                      : Result := 'The operation could not be completed.  A retry should be performed.';
  ERROR_CONNECTION_COUNT_LIMIT     : Result := 'A connection to the server could not be made because the limit on the number of concurrent connections for this account has been reached.';
  ERROR_LOGIN_TIME_RESTRICTION     : Result := 'Attempting to login during an unauthorized time of day for this account.';
  ERROR_LOGIN_WKSTA_RESTRICTION    : Result := 'The account is not authorized to login from this station.';
  ERROR_INCORRECT_ADDRESS          : Result := 'The network address could not be used for the operation requested.';
  ERROR_ALREADY_REGISTERED         : Result := 'The service is already registered.';
  ERROR_SERVICE_NOT_FOUND          : Result := 'The specified service does not exist.';
  ERROR_NOT_AUTHENTICATED          : Result := 'The operation being requested was not performed because the user has not been authenticated.';
  ERROR_NOT_LOGGED_ON              : Result := 'The operation being requested was not performed because the user has not logged on to the network. The specified service does not exist.';
  ERROR_CONTINUE                   : Result := 'Return that wants caller to continue with work in progress.';
  ERROR_ALREADY_INITIALIZED        : Result := 'An attempt was made to perform an initialization operation when initialization has already been completed.';
  ERROR_NO_MORE_DEVICES            : Result := 'No more local devices.';
  ERROR_NOT_ALL_ASSIGNED           : Result := 'Not all privileges referenced are assigned to the caller.';
  ERROR_SOME_NOT_MAPPED            : Result := 'Some mapping between account names and security IDs was not done.';
  ERROR_NO_QUOTAS_FOR_ACCOUNT      : Result := 'No system quota limits are specifically set for this account.';
  ERROR_LOCAL_USER_SESSION_KEY     : Result := 'No encryption key is available.  A well-known encryption key was returned.';
  ERROR_NULL_LM_PASSWORD           : Result := 'The NT password is too complex to be converted to a LAN Manager password.  The LAN Manager password returned is a NULL string.';
  ERROR_UNKNOWN_REVISION           : Result := 'The revision level is unknown.';
  ERROR_REVISION_MISMATCH          : Result := 'Indicates two revision levels are incompatible.';
  ERROR_INVALID_OWNER              : Result := 'This security ID may not be assigned as the owner of this object.';
  ERROR_INVALID_PRIMARY_GROUP      : Result := 'This security ID may not be assigned as the primary group of an object.';
  ERROR_NO_IMPERSONATION_TOKEN     : Result := 'An attempt has been made to operate on an impersonation token by a thread that is not currently impersonating a client.';
  ERROR_CANT_DISABLE_MANDATORY     : Result := 'The group may not be disabled.';
  ERROR_NO_LOGON_SERVERS           : Result := 'There are currently no logon servers available to service the logon request.';
  ERROR_NO_SUCH_LOGON_SESSION      : Result := 'A specified logon session does not exist.  It may already have been terminated.';
  ERROR_NO_SUCH_PRIVILEGE          : Result := 'A specified privilege does not exist.';
  ERROR_PRIVILEGE_NOT_HELD         : Result := 'A required privilege is not held by the client.';
  ERROR_INVALID_ACCOUNT_NAME       : Result := 'The name provided is not a properly formed account name.';
  ERROR_USER_EXISTS                : Result := 'The specified user already exists.';
  ERROR_NO_SUCH_USER               : Result := 'The specified user does not exist.';
  ERROR_GROUP_EXISTS               : Result := 'The specified group already exists.';
  ERROR_NO_SUCH_GROUP              : Result := 'The specified group does not exist.';
  ERROR_MEMBER_IN_GROUP            : Result := 'Either the specified user account is already a member of the specified group, or the specified group cannot be deleted because it contains a member.';
  ERROR_MEMBER_NOT_IN_GROUP        : Result := 'The specified user account is not a member of the specified group account.';
  ERROR_LAST_ADMIN                 : Result := 'The last remaining administration account cannot be disabled or deleted.';
  ERROR_WRONG_PASSWORD             : Result := 'Unable to update the password.  The value provided as the current password is incorrect.';
  ERROR_ILL_FORMED_PASSWORD        : Result := 'Unable to update the password.  The value provided for the new password contains values that are not allowed in passwords.';
  ERROR_PASSWORD_RESTRICTION       : Result := 'Unable to update the password because a password update rule has been violated.';
  ERROR_LOGON_FAILURE              : Result := 'Logon failure: unknown user name or bad password.';
  ERROR_ACCOUNT_RESTRICTION        : Result := 'Logon failure: user account restriction.';
  ERROR_INVALID_LOGON_HOURS        : Result := 'Logon failure: account logon time restriction violation.';
  ERROR_INVALID_WORKSTATION        : Result := 'Logon failure: user not allowed to log on to this computer.';
  ERROR_PASSWORD_EXPIRED           : Result := 'Logon failure: the specified account password has expired.';
  ERROR_ACCOUNT_DISABLED           : Result := 'Logon failure: account currently disabled.';
  ERROR_NONE_MAPPED                : Result := 'No mapping between account names and security IDs was done.';
  ERROR_TOO_MANY_LUIDS_REQUESTED   : Result := 'Too many local user identifiers (LUIDs) were requested at one time.';
  ERROR_LUIDS_EXHAUSTED            : Result := 'No more local user identifiers (LUIDs) are available.';
  ERROR_INVALID_SUB_AUTHORITY      : Result := 'The subauthority part of a security ID is invalid for this particular use.';
  ERROR_INVALID_ACL                : Result := 'The access control list (ACL) structure is invalid.';
  ERROR_INVALID_SID                : Result := 'The security ID structure is invalid.';
  ERROR_INVALID_SECURITY_DESCR     : Result := 'The security descriptor structure is invalid.';
  ERROR_BAD_INHERITANCE_ACL        : Result := 'The inherited access control list (ACL) or access control entry (ACE) could not be built.';
  ERROR_SERVER_DISABLED            : Result := 'The server is currently disabled.';
  ERROR_SERVER_NOT_DISABLED        : Result := 'The server is currently enabled.';
  ERROR_INVALID_ID_AUTHORITY       : Result := 'The value provided was an invalid value for an identifier authority.';
  ERROR_ALLOTTED_SPACE_EXCEEDED    : Result := 'No more memory is available for security information updates.';
  ERROR_INVALID_GROUP_ATTRIBUTES   : Result := 'The specified attributes are invalid, or incompatible with the attributes for the group as a whole.';
  ERROR_BAD_IMPERSONATION_LEVEL    : Result := 'Either a required impersonation level was not provided, or the provided impersonation level is invalid.';
  ERROR_CANT_OPEN_ANONYMOUS        : Result := 'Cannot open an anonymous level security token.';
  ERROR_BAD_VALIDATION_CLASS       : Result := 'The validation information class requested was invalid.';
  ERROR_BAD_TOKEN_TYPE             : Result := 'The type of the token is inappropriate for its attempted use.';
  ERROR_NO_SECURITY_ON_OBJECT      : Result := 'Unable to perform a security operation on an object which has no associated security.';
  ERROR_CANT_ACCESS_DOMAIN_INFO    : Result := 'Indicates a Windows NT Server could not be contacted or that objects within the domain are protected such that necessary information could not be retrieved.';
  ERROR_INVALID_SERVER_STATE       : Result := 'The security account manager (SAM) or local security authority (LSA) server was in the wrong state to perform the security operation.';
  ERROR_INVALID_DOMAIN_STATE       : Result := 'The domain was in the wrong state to perform the security operation.';
  ERROR_INVALID_DOMAIN_ROLE        : Result := 'This operation is only allowed for the Primary Domain Controller of the domain.';
  ERROR_NO_SUCH_DOMAIN             : Result := 'The specified domain did not exist.';
  ERROR_DOMAIN_EXISTS              : Result := 'The specified domain already exists.';
  ERROR_DOMAIN_LIMIT_EXCEEDED      : Result := 'An attempt was made to exceed the limit on the number of domains per server.';
  ERROR_INTERNAL_DB_CORRUPTION     : Result := 'Unable to complete the requested operation because of either a catastrophic media failure or a data structure corruption on the disk.';
  ERROR_INTERNAL_ERROR             : Result := 'The security account database contains an internal inconsistency.';
  ERROR_GENERIC_NOT_MAPPED         : Result := 'Generic access types were contained in an access mask which should already be mapped to non-generic types.';
  ERROR_BAD_DESCRIPTOR_FORMAT      : Result := 'A security descriptor is not in the right format (absolute or self-relative).';
  ERROR_NOT_LOGON_PROCESS          : Result := 'The requested action is restricted for use by logon processes only.  The calling process has not registered as a logon process.';
  ERROR_LOGON_SESSION_EXISTS       : Result := 'Cannot start a new logon session with an ID that is already in use.';
  ERROR_NO_SUCH_PACKAGE            : Result := 'A specified authentication package is unknown.';
  ERROR_BAD_LOGON_SESSION_STATE    : Result := 'The logon session is not in a state that is consistent with the requested operation.';
  ERROR_LOGON_SESSION_COLLISION    : Result := 'The logon session ID is already in use.';
  ERROR_INVALID_LOGON_TYPE         : Result := 'A logon request contained an invalid logon type value.';
  ERROR_CANNOT_IMPERSONATE         : Result := 'Unable to impersonate via a named pipe until data has been read from that pipe.';
  ERROR_RXACT_INVALID_STATE        : Result := 'The transaction state of a Registry subtree is incompatible with the requested operation.';
  ERROR_RXACT_COMMIT_FAILURE       : Result := 'An internal security database corruption has been encountered.';
  ERROR_SPECIAL_ACCOUNT            : Result := 'Cannot perform this operation on built-in accounts.';
  ERROR_SPECIAL_GROUP              : Result := 'Cannot perform this operation on this built-in special group.';
  ERROR_SPECIAL_USER               : Result := 'Cannot perform this operation on this built-in special user.';
  ERROR_MEMBERS_PRIMARY_GROUP      : Result := 'The user cannot be removed from a group because the group is currently the user''s primary group.';
  ERROR_TOKEN_ALREADY_IN_USE       : Result := 'The token is already in use as a primary token.';
  ERROR_NO_SUCH_ALIAS              : Result := 'The specified local group does not exist.';
  ERROR_MEMBER_NOT_IN_ALIAS        : Result := 'The specified account name is not a member of the local group.';
  ERROR_MEMBER_IN_ALIAS            : Result := 'The specified account name is already a member of the local group.';
  ERROR_ALIAS_EXISTS               : Result := 'The specified local group already exists.';
  ERROR_LOGON_NOT_GRANTED          : Result := 'Logon failure: the user has not been granted the requested logon type at this computer.';
  ERROR_TOO_MANY_SECRETS           : Result := 'The maximum number of secrets that may be stored in a single system has been exceeded.';
  ERROR_SECRET_TOO_LONG            : Result := 'The length of a secret exceeds the maximum length allowed.';
  ERROR_INTERNAL_DB_ERROR          : Result := 'The local security authority database contains an internal inconsistency.';
  ERROR_TOO_MANY_CONTEXT_IDS       : Result := 'During a logon attempt, the user''s security context accumulated too many security IDs.';
  ERROR_LOGON_TYPE_NOT_GRANTED     : Result := 'Logon failure: the user has not been granted the requested logon type at this computer.';
  ERROR_NT_CROSS_ENCRYPTION_REQUIRED:Result := 'A cross-encrypted password is necessary to change a user password.';
  ERROR_NO_SUCH_MEMBER             : Result := 'A new member could not be added to a local group because the member does not exist.';
  ERROR_INVALID_MEMBER             : Result := 'A new member could not be added to a local group because the member has the wrong account type.';
  ERROR_TOO_MANY_SIDS              : Result := 'Too many security IDs have been specified.';
  ERROR_LM_CROSS_ENCRYPTION_REQUIRED:Result := 'A cross-encrypted password is necessary to change this user password.';
  ERROR_NO_INHERITANCE             : Result := 'Indicates an TACL contains no inheritable components';
  ERROR_FILE_CORRUPT               : Result := 'The file or directory is corrupt and non-readable.';
  ERROR_DISK_CORRUPT               : Result := 'The disk structure is corrupt and non-readable.';
  ERROR_NO_USER_SESSION_KEY        : Result := 'There is no user session key for the specified logon session.';
  ERROR_LICENSE_QUOTA_EXCEEDED     : Result := 'The service being accessed is licensed for a particular number of connections.';
  ERROR_INVALID_WINDOW_HANDLE      : Result := 'Invalid window handle.';
  ERROR_INVALID_MENU_HANDLE        : Result := 'Invalid menu handle.';
  ERROR_INVALID_CURSOR_HANDLE      : Result := 'Invalid cursor handle.';
  ERROR_INVALID_ACCEL_HANDLE       : Result := 'Invalid accelerator table handle.';
  ERROR_INVALID_HOOK_HANDLE        : Result := 'Invalid hook handle.';
  ERROR_INVALID_DWP_HANDLE         : Result := 'Invalid handle to a multiple-window position structure.';
  ERROR_TLW_WITH_WSCHILD           : Result := 'Cannot create a top-level child window.';
  ERROR_CANNOT_FIND_WND_CLASS      : Result := 'Cannot find window class.';
  ERROR_WINDOW_OF_OTHER_THREAD     : Result := 'Invalid window, belongs to other thread.';
  ERROR_HOTKEY_ALREADY_REGISTERED  : Result := 'Hot key is already registered.';
  ERROR_CLASS_ALREADY_EXISTS       : Result := 'Class already exists.';
  ERROR_CLASS_DOES_NOT_EXIST       : Result := 'Class does not exist.';
  ERROR_CLASS_HAS_WINDOWS          : Result := 'Class still has open windows.';
  ERROR_INVALID_INDEX              : Result := 'Invalid index.';
  ERROR_INVALID_ICON_HANDLE        : Result := 'Invalid icon handle.';
  ERROR_PRIVATE_DIALOG_INDEX       : Result := 'Using private DIALOG window words.';
  ERROR_LISTBOX_ID_NOT_FOUND       : Result := 'The listbox identifier was not found.';
  ERROR_NO_WILDCARD_CHARACTERS     : Result := 'No wildcards were found.';
  ERROR_CLIPBOARD_NOT_OPEN         : Result := 'Thread does not have a clipboard open.';
  ERROR_HOTKEY_NOT_REGISTERED      : Result := 'Hot key is not registered.';
  ERROR_WINDOW_NOT_DIALOG          : Result := 'The window is not a valid dialog window.';
  ERROR_CONTROL_ID_NOT_FOUND       : Result := 'Control ID not found.';
  ERROR_INVALID_COMBOBOX_MESSAGE   : Result := 'Invalid message for a combo box because it does not have an edit control.';
  ERROR_WINDOW_NOT_COMBOBOX        : Result := 'The window is not a combo box.';
  ERROR_INVALID_EDIT_HEIGHT        : Result := 'Height must be less than 256.';
  ERROR_DC_NOT_FOUND               : Result := 'Invalid device context (DC) handle.';
  ERROR_INVALID_HOOK_FILTER        : Result := 'Invalid hook procedure type.';
  ERROR_INVALID_FILTER_PROC        : Result := 'Invalid hook procedure.';
  ERROR_HOOK_NEEDS_HMOD            : Result := 'Cannot set non-local hook without a module handle.';
  ERROR_GLOBAL_ONLY_HOOK           : Result := 'This hook procedure can only be set globally.';
  ERROR_JOURNAL_HOOK_SET           : Result := 'The journal hook procedure is already installed.';
  ERROR_HOOK_NOT_INSTALLED         : Result := 'The hook procedure is not installed.';
  ERROR_INVALID_LB_MESSAGE         : Result := 'Invalid message for single-selection listbox.';
  ERROR_SETCOUNT_ON_BAD_LB         : Result := 'LB_SETCOUNT sent to non-lazy listbox.';
  ERROR_LB_WITHOUT_TABSTOPS        : Result := 'This list box does not support tab stops.';
  ERROR_DESTROY_OBJECT_OF_OTHER_THREAD : Result:='Cannot destroy object created by another thread.';
  ERROR_CHILD_WINDOW_MENU          : Result := 'Child windows cannot have menus.';
  ERROR_NO_SYSTEM_MENU             : Result := 'The window does not have a system menu.';
  ERROR_INVALID_MSGBOX_STYLE       : Result := 'Invalid message box style.';
  ERROR_INVALID_SPI_VALUE          : Result := 'Invalid system-wide (SPI_*) parameter.';
  ERROR_SCREEN_ALREADY_LOCKED      : Result := 'Screen already locked.';
  ERROR_HWNDS_HAVE_DIFF_PARENT     : Result := 'All handles to windows in a multiple-window position structure must have the same parent.';
  ERROR_NOT_CHILD_WINDOW           : Result := 'The window is not a child window.';
  ERROR_INVALID_GW_COMMAND         : Result := 'Invalid GW_* command.';
  ERROR_INVALID_THREAD_ID          : Result := 'Invalid thread identifier.';
  ERROR_NON_MDICHILD_WINDOW        : Result := 'Cannot process a message from a window that is not a multiple document interface (MDI) window.';
  ERROR_POPUP_ALREADY_ACTIVE       : Result := 'Popup menu already active.';
  ERROR_NO_SCROLLBARS              : Result := 'The window does not have scroll bars.';
  ERROR_INVALID_SCROLLBAR_RANGE    : Result := 'Scroll bar range cannot be greater than $7FFF.';
  ERROR_INVALID_SHOWWIN_COMMAND    : Result := 'Cannot show or remove the window in the way specified.';
  ERROR_NO_SYSTEM_RESOURCES        : Result := 'Insufficient system resources exist to complete the requested service.';
  ERROR_NONPAGED_SYSTEM_RESOURCES  : Result := 'Insufficient system resources exist to complete the requested service.';
  ERROR_PAGED_SYSTEM_RESOURCES     : Result := 'Insufficient system resources exist to complete the requested service.';
  ERROR_WORKING_SET_QUOTA          : Result := 'Insufficient quota to complete the requested service.';
  ERROR_PAGEFILE_QUOTA             : Result := 'Insufficient quota to complete the requested service.';
  ERROR_COMMITMENT_LIMIT           : Result := 'The paging file is too small for this operation to complete.';
  ERROR_MENU_ITEM_NOT_FOUND        : Result := 'A menu item was not found.';
  ERROR_INVALID_KEYBOARD_HANDLE    : Result := 'Invalid keyboard layout handle.';
  ERROR_HOOK_TYPE_NOT_ALLOWED      : Result := 'Hook type not allowed.';
  ERROR_REQUIRES_INTERACTIVE_WINDOWSTATION : Result := 'This operation requires an interactive windowstation.';
  ERROR_TIMEOUT                    : Result := 'This operation returned because the timeout period expired.';
  ERROR_EVENTLOG_FILE_CORRUPT      : Result := 'The event log file is corrupt.';
  ERROR_EVENTLOG_CANT_START        : Result := 'No event log file could be opened, so the event logging service did not start.';
  ERROR_LOG_FILE_FULL              : Result := 'The event log file is full.';
  ERROR_EVENTLOG_FILE_CHANGED      : Result := 'The event log file has changed between reads.';
 end;
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;

initialization

 SysUtils.DecimalSeparator:='.';
 SetCaseTable_Default;
 SetupCharTable(WinToDosTable, Abc_RusWin, Abc_RusDos);
 SetupCharTable(DosToWinTable, Abc_RusDos, Abc_RusWin);
 SetupCharTable(WinToKoiTable, Abc_RusWin, Abc_RusKoi);
 SetupCharTable(KoiToWinTable, Abc_RusKoi, Abc_RusWin);
 InitCharToNumber;

finalization

end.

