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

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

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

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20010804 - Creation (uses CRW16) & test                                    //
// 20011029 - TText & test (Ok)                                               //
// 20011031 - UnifyAlias,UnifyFileAlias                                       //
// 20011031 - TText derived from TLatch                                       //
// 20011222 - UnifySection                                                    //
// 20030323 - Struggle for safety (add some try/except checks)...             //
// 20050109 - RemoveBrackets                                                  //
// 20050224 - IsSameText                                                      //
// 20060302 - StrIScan,StrRIScan,StrIPos,IsSameChar.                          //
// 20060908 - ScanVar: 4 bugs fixed                                           //
// 20070522 - URL_Encode(..,AllowChars)                                       //
// 20070717 - add URL_Packed; edit URL_XXcode                                 //
// 20070720 - edit URL_XXcode (speed optimized)                               //
// 20090105 - HasChars                                                        //
// 20120520 - ValidateCRLF                                                    //
// 20160428 - SkipWords                                                       //
// 20170302 - iValDef, iVal, rValDef, rVal                                    //
// 20171006 - IsSectionName                                                   //
// 20181118 - CookieScan                                                      //
// 20190913 - ExtractBaseName                                                 //
// 20191029 - NBSP                                                            //
// 20200721 - LineEnding,sLineBreak,DirectorySeparator,PathDelim,             //
//            PathSeparator,PathSep                                           //
// 20200828 - PosEx,LastPos,CountPos,NthPos                                   //
// 20200924 - StrFetch,AnsiDeQuotedStr,AnsiSkipQuotedStr                      //
// 20211015 - JustSpaces,HasListedExtension,ExtractFirstParam,SkipFirstParam, //
//            IsOption                                                        //
// 20211018 - GetOptionValue,HasOptionValue,QuoteMark,TrimLeftChars,          //
//            TrimRightChars                                                  //
// 20220117 - IsLexeme,lex_Name,etc                                           //
// 20220620 - IsLexeme uses lex_regexp_test,lex_FsmName..Lex_DimName          //
// 20221203 - PosEol                                                          //
// 20221217 - lex_SqlName,lex_FbdName                                         //
// 20221219 - lex_Section,lex_AtCall,lex_AtCmnd                               //
// 20230511 - Modified for FPC (A.K.)                                         //
// 20230531 - StringToSetOfChars,SetOfCharsToString                           //
// 20230909 - ExtractNameValuePair                                            //
// 20230916 - SortTextLines                                                   //
// 20230925 - TrimDef                                                         //
// 20231011 - ForEachStringLine                                               //
// 20231111 - IntToStrBase,StrToIntBase                                       //
// 20240128 - AdaptExeFileName                                                //
// 20240201 - AdaptFileName                                                   //
// 20240210 - StartsWithTwinTildeDir, ReplaceTwinTildeDir                     //
// 20240522 - EnsureEndingEol                                                 //
// 20240531 - Improved IsSameText UTF8 compatibility                          //
// 20240604 - ConcatText modified (uses ForEachStringLine)                    //
// 20240625 - PhraseCount,ExtractPhrase,PhaseListToTextLines                  //
// 20240626 - ForEachQuotedPhrase,SkipPhrases                                 //
// 20240702 - Modified PhraseCount,...,PhaseListToTextLines                   //
// 20240803 - ReadIniFileXXXX                                                 //
// 20240815 - UsesFixFormatG                                                  //
// 20240824 - TText now based on TStringList inside and uses LongString(s).   //
// 20241009 - AdaptDllFileName                                                //
// 20241025 - AdaptLnkFileName                                                //
// 20241105 - QArg                                                            //
// 20241107 - ExtractDllBaseName,ua_GetReal,ua_RealPath                       //
// 20241111 - EnsureHeapString                                                //
// 20241120 - DropNLeadStr,DropNTailStr,StartsText,EndsText                   //
// 20241211 - IsNonEmptyStr                                                   //
// 20241213 - ua_FileDefLow                                                   //
// 20250221 - StrCopyBuff                                                     //
// 20250222 - FillCharBuff                                                    //
// 20250226 - lex_LQuote,lex_RQuote,lex_Quotes,lex_Quoted,StrLScan            //
// 20250611 - CookieScanAlter                                                 //
// 20250726 - lex_AddUser,lex_DomUser,lex_UsrHost                             //
// 20250729 - lex_Ip4Addr,lex_Ip6Addr,lex_MacAddr, SafeExecRegExpr            //
// 20250807 - lex_DotName,lex_UriAddr                                         //
// 20250813 - lex_PctChar,lex_PctCode,lex_PctData,lex_PctNeed                 //
// 20250816 - ContainsStr,StartsStr,EndsStr,ContainsText                      //
// 20250820 - AboveAscii,PosixBlank,FpcRunErrorCodeToString                   //
// 20250822 - AnsiAllSet                                                      //
// 20250827 - SafeReplaceRegExpr                                              //
// 20251122 - Format(…,Fast)                                                  //
// 20251216 - NeedToTrimStr                                                   //
// 20251223 - IsTextAscii                                                     //
// 20250115 - StrFirstChar,StrLastChar                                        //
// 20260212 - Tab2Space,Tab2SpaceAdjusted                                     //
// 20260313 - ReplaceChars                                                    //
// 20260610 - CookieUpdate                                                    //
// 20260704 - StrRemoveTailAfterSep                                           //
////////////////////////////////////////////////////////////////////////////////

unit _crw_str; // String functions.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

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

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math, regexpr, sysconst,
 _crw_alloc, _crw_fifo, _crw_fpu, _crw_ef, _crw_utf8;

 /////////////////////////////////////////////////////////////////////////////////
 // ASCII Table
 /////////////////////////////////////////////////////////////////////////////////
 // Dec Hex    Dec Hex    Dec Hex  Dec Hex  Dec Hex  Dec Hex   Dec Hex   Dec Hex
 //   0 00 NUL  16 10 DLE  32 20    48 30 0  64 40 @  80 50 P   96 60 `  112 70 p
 //   1 01 SOH  17 11 DC1  33 21 !  49 31 1  65 41 A  81 51 Q   97 61 a  113 71 q
 //   2 02 STX  18 12 DC2  34 22 "  50 32 2  66 42 B  82 52 R   98 62 b  114 72 r
 //   3 03 ETX  19 13 DC3  35 23 #  51 33 3  67 43 C  83 53 S   99 63 c  115 73 s
 //   4 04 EOT  20 14 DC4  36 24 $  52 34 4  68 44 D  84 54 T  100 64 d  116 74 t
 //   5 05 ENQ  21 15 NAK  37 25 %  53 35 5  69 45 E  85 55 U  101 65 e  117 75 u
 //   6 06 ACK  22 16 SYN  38 26 &  54 36 6  70 46 F  86 56 V  102 66 f  118 76 v
 //   7 07 BEL  23 17 ETB  39 27 '  55 37 7  71 47 G  87 57 W  103 67 g  119 77 w
 //   8 08 BS   24 18 CAN  40 28 (  56 38 8  72 48 H  88 58 X  104 68 h  120 78 x
 //   9 09 HT   25 19 EM   41 29 )  57 39 9  73 49 I  89 59 Y  105 69 i  121 79 y
 //  10 0A LF   26 1A SUB  42 2A *  58 3A :  74 4A J  90 5A Z  106 6A j  122 7A z
 //  11 0B VT   27 1B ESC  43 2B +  59 3B ;  75 4B K  91 5B [  107 6B k  123 7B {
 //  12 0C FF   28 1C FS   44 2C ,  60 3C <  76 4C L  92 5C \  108 6C l  124 7C |
 //  13 0D CR   29 1D GS   45 2D -  61 3D =  77 4D M  93 5D ]  109 6D m  125 7D }
 //  14 0E SO   30 1E RS   46 2E .  62 3E >  78 4E N  94 5E ^  110 6E n  126 7E ~
 //  15 0F SI   31 1F US   47 2F /  63 3F ?  79 4F O  95 5F _  111 6F o  127 7F DEL
 //////////////////////////////////////////////////////////////////////////////////

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

const
 AnsiAllSet = [#0..#255];          // Set of all ANSI chars
 AboveAscii = [#128..#255];        // Chars with code above ASCII
 JustCntrls = [#0..#31];           // ASCII control chars except DEL
 JustSpaces = [#0..' '];           // Uses by Trim, IsEmptyStr etc.
 JustBlanks = [ASCII_HT,' '];      // Space chars uses as blank
 JustQuotes = [QuoteMark,Apostrophe]; // Quotation chars
 EolnDelims = [ASCII_CR,ASCII_LF]; // EndOfLine delimiters

 ///////////////////////////////////////////////////////////////////////////////
 // POSIX character classes
 // https://github.com/micromatch/posix-character-classes
 ///////////////////////////////////////////////////////////////////////////////
 // [:alpha:]   [A-Za-z]         upper- and lowercase letters
 // [:ascii:]   [\x00-\x7F]      ASCII chars
 // [:blank:]   [ \t]            space and TAB chars only
 // [:cntrl:]   [\x00-\x1F\x7F]  Control chars
 // [:digit:]   [0-9]            digits
 // [:graph:]   [^ [:cntrl:]]    graphic chars (all chars which have graphic representation)
 // [:lower:]   [a-z]            lowercase letters
 // [:print:]   [[:graph:] ]     graphic chars and space
 // [:punct:]   [-!"#$%&'()*+,./:;<=>?@[]^_`{|}~]   all punctuation chars (all graphic chars except letters and digits)
 // [:space:]   [ \t\n\r\f\v]    all blank (whitespace) chars, including spaces, tabs, new lines, carriage returns, form feeds, and vertical tabs
 // [:upper:]   [A-Z]            uppercase letters
 // [:word:]    [A-Za-z0-9_]     word chars
 // [:xdigit:]  [0-9A-Fa-f]      hexadecimal digits
 // [:alnum:]   [A-Za-z0-9]      ASCII letters and digits
 ///////////////////////////////////////////////////////////////////////////////
const
 PosixBlank  = [' ',#9];                               // [:blank:]
 PosixAscii  = [#0..#127];                             // [:ascii:]
 PosixDigit  = ['0'..'9'];                             // [:digit:]
 PosixUpper  = ['A'..'Z'];                             // [:upper:]
 PosixLower  = ['a'..'z'];                             // [:lower:]
 PosixAlpha  = PosixUpper+PosixLower;                  // [:alpha:]
 PosixAlnum  = PosixAlpha+PosixDigit;                  // [:alnum:]
 PosixWord   = PosixAlnum+['_'];                       // [:word:]
 PosixCntrl  = [#0..#31,#127];                         // [:cntrl:]
 PosixXdigit = ['0'..'9','A'..'F','a'..'f'];           // [:xdigit:]
 PosixSpace  = [#9..#13,' '];                          // [:space:]
 PosixGraph  = [#$21..#$7E];                           // [:graph:]
 PosixPrint  = [#$20..#$7E];                           // [:print:]
 PosixPunct  = ['!'..'/',':'..'@','['..'`', '{'..'~']; // [:punct:] !"#$%&'()*+,-./:;<=>?@[\]^_`{|}~

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

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

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

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

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

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

 { Convert string codepage. }
function ConvertCP(const s:LongString; cpFrom,cpTo,cpSet:Word;
                   silent:Boolean=false):LongString;

 { Windows: Convert Default CodePage to Ansi. }
function DefToAnsiCp(const s:LongString):LongString;

 { Windows: Convert Ansi to Default CodePage. }
function AnsiToDefCp(const s:LongString):LongString;

 { Windows: Convert Default CodePage to OEM. }
function DefToOemCp(const s:LongString):LongString;

 { Windows: Convert OEM to Default CodePage. }
function OemToDefCp(const s:LongString):LongString;

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

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

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

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

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

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

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

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

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

 { Copy string (S) to buffer (Buff). Truncate if string too long. }
function StrCopyBuff(out Buff:TParsingBuffer; const S:LongString):PChar; overload;
function StrCopyBuff(out Buff:TMaxPathBuffer; const S:LongString):PChar; overload;

 { Fill buffer (Buff) with chars (C). }
function FillCharBuff(out Buff:TParsingBuffer; C:Char=#0):PChar; overload;
function FillCharBuff(out Buff:TMaxPathBuffer; C:Char=#0):PChar; overload;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

const                                 // ForEachQuotedPhrase Mode flags:
 feqpm_BreakOnEOL = $00000001;        // Break iterations on EOL found
 feqpm_SkipEmpty  = $00000002;        // Skip empty phrases
 feqpm_Default    = feqpm_BreakOnEOL; // Default Mode

 {
 Quoted Phrase iterator - to be called for all simple words or quoted strings.
 }
type                                               // Quoted Phrase callback
 TQuotedPhraseIterator=function(Index:SizeInt;     // Phrase 1-based index
                                Phrase:LongString; // Phrase to be processed
                                Tail:PChar;        // Tail after this phrase
                                Quote:Char;        // Quote char or #0 if none
                                Custom:Pointer     // User custom data
                                ):Boolean;         // TRUE=Continue, FALSE=Break

 {
 Handle list of phrases delimited by Delims. Each phrase is a simple word
 (which can`t contain delimiter chars) or quoted string (which can contain
 delimiter chars). For each phrase found the Iterator should be called.
 User defined data (Custom) can be used to implement iterations.
 Iterator have to return TRUE to proceed iterations or FALSE to terminate.
 Return number of phrases processed (number of succeed Iterator calls).
 }
function ForEachQuotedPhrase(const SourceText:LongString; // Text to handle
                  Iterator:TQuotedPhraseIterator;         // Per phrase iterator
                  Custom:Pointer;                         // Custom user data
                  Delims:TCharSet=JustSpaces;             // Uses delimiters
                  Quotes:LongString=QuoteMark+Apostrophe; // Uses quotes
                  Mode:Integer=feqpm_Default              // Parsing mode
                             ):SizeInt;                   // Return number

 // Tester function for ForEachQuotedPhrase.
function Test_ForEachQuotedPhrase:LongString;

const               // Code page codes
 CP_866   = 866;    // OEM  ru
 CP_1251  = 1251;   // ANSI ru

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

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

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

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

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

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

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

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

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

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

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

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

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

 { Check if aText containts non-empty ASCII-7 text }
function IsTextAscii(const aText:LongString):Boolean; overload;
function IsTextAscii(const aText:ShortString):Boolean; overload;
function IsTextAscii(const aText:PChar; aLen:SizeInt):Boolean; overload;

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

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

 {
 ***********************************
 General purpose string manipulation
 ***********************************
 }
const // Fix format %g as %.15g.
 UsesFixFormatG : Boolean = true;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

 { Fast check is string S need to to make Trim }
function NeedToTrimStr(const S:LongString):Boolean;

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

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

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

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

 { Drop N lead chars from S string. }
function DropNLeadStr(const S:LongString; N:Integer):LongString;

 { Drop N tail chars from S string. }
function DropNTailStr(const S:LongString; N:Integer):LongString;

 { Check AText string constins ASubText (case sensitive). }
function ContainsStr(const AText,ASubText:LongString): Boolean;

 { Check whether one string starts with another. }
function StartsStr(const ASubText,AText:LongString):Boolean;

 { Check whether one text ends with another. }
function EndsStr(const ASubText,AText:LongString):Boolean;

 { Check AText text constins ASubText (ignore case). }
function ContainsText(const AText,ASubText:LongString): Boolean;

 { Check whether one text starts with another. }
function StartsText(const aSubText,aText:LongString):Boolean;

 { Check whether one text ends with another. }
function EndsText(const aSubText,aText:LongString):Boolean;

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

 { Ensure ending EOL exists. }
function EnsureEndingEol(const S:LongString):LongString;

 {
 Ensure result string is located in Heap.
 Usually dynamic strings located in Heap,
 but constant strings is not.
 }
function EnsureHeapString(const S:LongString):LongString;

 {
 Remove tail of string Line after separator(s) Sep.
 If KeepSep flag on then keep Sep in Result string.
 }
function StrRemoveTailAfterSep(const Line:LongString; Sep:TCharSet; KeepSep:Boolean=False):LongString;

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

function ua_FileDefLow:Integer; // ua_FileLow if not FileNameCaseSensitive

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

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

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

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

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

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

{
StrFirstChar(s) is safe analog of s[1]. Return #0 if string is empty.
}
function StrFirstChar(const s:LongString):AnsiChar; inline; overload;
function StrFirstChar(const s:WideString):WideChar; inline; overload;

{
StrLastChar(s) is safe analog of s[length(s)]. Return #0 if string is empty.
}
function StrLastChar(const s:LongString):AnsiChar; inline; overload;
function StrLastChar(const s:WideString):WideChar; inline; overload;

 {
 Replace Tabs to spaces.
 Each Tab replaces to Numb spaces.
 }
function Tab2Space(const S:LongString; Numb:Byte):LongString;

 {
 Replace Tabs to spaces.
 Each Tab replaces to spaces with column adjustment to Numb.
 Mode bit0 - assume S is ANSI string (by default assume UTF8).
 }
function Tab2SpaceAdjusted(const S:LongString; Numb:Byte; Mode:Integer=0):LongString;

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

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

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

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

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

 {
 Execute regular expression: safe version of ExecRegExpr.
 }
function SafeExecRegExpr(const ARegExpr,AInputStr:LongString):Boolean;

 // Returns AInputStr with r.e. occurencies replaced by AReplaceStr
 // If AUseSubstitution is true, then AReplaceStr will be used
 // as template for Substitution methods.
 // For example:
 // ReplaceRegExpr ('({-i}block|var)\s*\(\s*([^ ]*)\s*\)\s*',
 // 'BLOCK( test1)', 'def "$1" value "$2"', True)
 // will return:  def 'BLOCK' value 'test1'
 // ReplaceRegExpr ('({-i}block|var)\s*\(\s*([^ ]*)\s*\)\s*',
 // 'BLOCK( test1)', 'def "$1" value "$2"')
 // will return:  def "$1" value "$2"
function SafeReplaceRegExpr(const ARegExpr,AInputStr,AReplaceStr:LongString;
                            AUseSubstitution:Boolean=False):LongString;

procedure Kill(var TheObject:TRegExpr); overload;

 {
 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)
 lex_LQuote  = 29;  // ---- Left  Quoted      ^[\'\"]                               Text starts from QuoteMark or Apostrophe
 lex_RQuote  = 30;  // ---- Right Quoted      [\'\"]$                               Text ending with QuoteMark or Apostrophe
 lex_Quotes  = 31;  // - Text has Quotes      ".*".* or '.*'.*                      Text starts from quote, has pair quote
 lex_Quoted  = 32;  // - Strictly Quoted      ".*" or '.*'                          The strictly quoted text ".*" or '.*'
 lex_DomName = 33;  // RFC-952: Domain style names contain alnum and '-' and starts/stops with alnum.
 lex_DnsHost = 34;  // RFC-1123: DNS names contains domain names separated with '.' characters.
 lex_AddUser = 35;  // /etc/adduser.conf NAME_REGEX="^[a-z][-a-z0-9_]*\$?$"
 lex_DomUser = 36;  // Domain username: ^[a-zA-Z][-a-zA-Z0-9_]*$
 lex_UsrHost = 37;  // Domain UserName@DnsHost like alex@mail.ru
 lex_Ip4Addr = 38;  // IP version 4 address (RFC-791)  like 192.168.0.1
 lex_Ip6Addr = 39;  // IP version 6 address (RFC-8200) like ::1 or fe80::b1b:182a:d0b2:55d4%13
 lex_MacAddr = 40;  // IEEE-802 MAC-48: 6 groups of 2 xdigits, separated by [-:], like: 2a:72:b3:c9:53:44
 lex_DotName = 41;  // Words separated with dots like high.voltage.danger
 lex_UriAddr = 42;  // URI according to RFC-3986,Appendix-B: shceme://authority/path?query#fragment
 lex_PctChar = 43;  // String contains % (percent) char(s) (i.e. maybe pct-encoded)
 lex_PctCode = 44;  // String contains valid pct-encoded %xx codes & may be decoded with pct-decode
 lex_PctData = 45;  // String looks like valid pct-encoded data include %xx, exclude reserved chars
 lex_PctNeed = 46;  // String need to be pct-encode, i.e contains RFC3986 reserved chars

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

 {
 *********************************************
 Phrase parsing
 Phrase is non-empty string
 1) simple word (like abc), or
 2) quoted string (like "abc def ghi").
 For example, string
  Friends "John Mikle Bob"
 will be parsed to 2 phrases:
  1) Friends
  2) John Mikle Bob
 *********************************************
 }
const // Use ForEachQuotedPhrase, otherwise use ExtractFirstParam (slower).
 UsesPhraseIterator : Boolean = true;

 { Calculate number of phrases. }
function PhraseCount(const S:LongString; const Delims:TCharSet;
                     Quotes:LongString=QuoteMark+Apostrophe):Integer;

 { Extract phrase with given index number, starting from 1. }
function ExtractPhrase(N:Integer; const S:LongString; const Delims:TCharSet;
                       Quotes:LongString=QuoteMark+Apostrophe):LongString;

 { Return tail after N phrases, and Delims skipped. }
function SkipPhrases(N:Integer; const S:LongString; const Delims:TCharSet;
                     Quotes:LongString=QuoteMark+Apostrophe):LongString;


 { Convert list of phrases to text lines separated by EOL. }
function PhraseListToTextLines(const S:LongString; const Delims:TCharSet;
                               Quotes:LongString=QuoteMark+Apostrophe):LongString;

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

 { Convert Value to string with Base in [2,8,10,16]. Then left pad with 0 to Width.  }
function IntToStrBase(Value:LongInt; Base:Integer=10; Width:Integer=0):LongString;

 { Convert string S to integer with Base in [2,8,10,16] or return Def value on error. }
function StrToIntBase(S:LongString; Base:Integer=10; Def:Integer=0):LongInt;

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

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

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

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

const
 f2sWidthDefault  = 0;
 f2sDigitsDefault = 14;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

 {
 CookieScan with alternatives defined by comma or semicolon separated Items.
 Trying to perform CookieScan for each comma or semicolon separated Items
 until got non-empty result and return it. Otherwise return empty string.
 Example: CookieScanAlter(Buff,'User ID;UserName;UID',Ord(';'));
 }
function CookieScanAlter(const Buff,Items:LongString; Mode:Integer=csm_Default):LongString;

 {
 Update Cookies from buffer (Buff) with new values from Items.
 }
function CookieUpdate(const Buff,Items:LongString; Mode:Integer=csm_Default):LongString;

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

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

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

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

{
Return counter  of chars in C charset if string S.
}
function CountChars(const S:LongString; const C:TCharSet):SizeInt; overload;
function CountChars(const S:LongString; const C:LongString):SizeInt; overload;

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

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

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

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

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

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

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

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

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

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

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

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

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

 {
 Extract base name of *.dll or *.so library.
 Windows: FileName = path\BASE.dll
 Unix:    FileName = path/libBASE.so
 }
function ExtractDllBaseName(const FileName:LongString):LongString;

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

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

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

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

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

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

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

const                           // AdaptFileName Mode flags:
 afnm_Trim  = 1;                // Use Trim
 afnm_Delim = 2;                // Fix directory delimiters (\,/).
 afnm_Drive = 4;                // Fix drive (c:) on Unix
 afnm_Lower = 8;                // Lower case on Unix
 afnm_Utf8  = 16;               // Use UTF8  on Unix
 afnm_NoDup = 32;               // Drop duplicates like //
 afnm_LibSo = 64;               // Add lib prefix on Unix
 afnm_DefNC = 1+2+4  +16+32+64; // Default but not use LoCase
 afnm_Def   = 1+2+4+8+16+32+64; // Default

 {
 Adapt File Name for current OS rules.
 Windows: Result = drive:\path\filename.ext
 Unix:    Result = /path/filename.ext
 }
function AdaptFileName(const FileName:LongString; Mode:Integer=afnm_Def):LongString;

 {
 Adapt Executable File Name for current OS rules.
 Windows: Result = filename.exe | filename.bat | filename.cmd
 Unix:    Result = filename     | filename.sh  | filename.sh
 }
function AdaptExeFileName(const FileName:LongString; Mode:Integer=afnm_Def):LongString;

 {
 Adapt Dynamic Link Library File Name for current OS rules.
 Windows: Result = name.dll
 Unix:    Result = libname.so
 }
function AdaptDllFileName(const FileName:LongString; Mode:Integer=afnm_Def):LongString;

 {
 Adapt desktop file link.
 Windows: Result = name.lnk
 Unix:    Result = name.desktop
 }
function AdaptLnkFileName(const FileName:LongString; Mode:Integer=afnm_Def):LongString;

 {
 Check file name (S) starts with Tilde dir ~\ or ~/ substring.
 }
function StartsWithTildeDir(const S:LongString):Boolean;

 {
 Replace Tilde Dir ~\ to given Directory (Dir).
 }
function ReplaceTildeDir(const S,Dir:LongString):LongString;

{
Check file name (S) starts with Twin Tilde dir ~~\ or ~~/ substring.
}
function StartsWithTwinTildeDir(const S:LongString):Boolean;

 {
 Replace Twin Tilde Dir ~~\ to given Directory (Dir).
 }
function ReplaceTwinTildeDir(const S,Dir:LongString):LongString;

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

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

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

type
 TText = class(TLatch)
 private
  myStep    : LongInt;
  myLines   : TStringList;
  function    GetStep:LongInt;
  procedure   SetStep(NewStep:LongInt);
  function    GetCount:LongInt;
  procedure   SetCount(NewCount:LongInt);
  function    GetCapacity:LongInt;
  procedure   SetCapacity(NewCapacity:LongInt);
  procedure   EnsureCapacity(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 ): LongString;
  procedure   PutLn( NumLn:LongInt; const aLine:LongString );
  procedure   DelLn( NumLn:LongInt );
  procedure   InsLn( NumLn:LongInt; const aLine:LongString);
  procedure   AddLn( const aLine:LongString );
  procedure   ForEach(Action:TTextForEachAction; CustomData:Pointer; Backward:Boolean=false);
  function    MaxLength:LongInt;
  function    MemUsed:LongInt;
  procedure   Concat(aText:TText);
  procedure   Copy(aText:TText);
  procedure   Read(var F:Text);
  function    ReadFile(const aFileName:LongString; AppendMode:Boolean=false):Integer;
  procedure   Write(var F:Text);
  function    WriteFile(const aFileName:LongString; AppendMode:Boolean=false):Integer;
  procedure   Echo;
  procedure   UpCase;
  procedure   LoCase;
  procedure   WinToDos;
  procedure   DosToWin;
  procedure   WinToKoi;
  procedure   KoiToWin;
  function    FindLine(aLine:LongString; Mode:Integer=0):Integer;
  function    FindVar(const VarName:LongString):Integer;
  function    GetVar(const VarName:LongString):LongString;
  procedure   SetVar(const VarName:LongString; const VarValue:LongString);
  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] : LongString  read GetLn       write PutLn; default;
 end;

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

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

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

function  AdjustStrSize(const S:LongString):Integer;

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

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

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

 {
 Gets system error message by error code.
 ErrorCode is OS-dependent GetLastError code.
 }
function SysErrorMessage(ErrorCode: Integer): LongString; inline;

 {
 FreePascalCompiler Runime Error Code to String converter.
 ErrorCode is OS-independent runtime error code from IoResult etc.
 }
function FpcRunErrorCodeToString(ErrorCode:Integer):LongString;

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

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

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

implementation

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

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

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

function ConvertCP(const s:LongString; cpFrom,cpTo,cpSet:Word;
                   silent:Boolean=false):LongString;
begin
 Result:=_crw_utf8.ConvertCP(s,cpFrom,cpTo,cpSet,silent);
end;

function DefToAnsiCp(const s:LongString):LongString;
begin
 Result:=s;
 {$IFDEF WINDOWS}
 if (DefaultSystemCodePage<>GetACP)
 then Result:=ConvertCP(s,DefaultSystemCodePage,GetACP,CP_NONE);
 {$ENDIF WINDOWS}
end;

function AnsiToDefCp(const s:LongString):LongString;
begin
 Result:=s;
 {$IFDEF WINDOWS}
 if (DefaultSystemCodePage<>GetACP)
 then Result:=ConvertCP(s,GetACP,DefaultSystemCodePage,CP_NONE);
 {$ENDIF WINDOWS}
end;

function DefToOemCp(const s:LongString):LongString;
begin
 Result:=s;
 {$IFDEF WINDOWS}
 if (DefaultSystemCodePage<>GetOEMCP)
 then Result:=ConvertCP(s,DefaultSystemCodePage,GetOEMCP,CP_NONE);
 {$ENDIF WINDOWS}
end;

function OemToDefCp(const s:LongString):LongString;
begin
 Result:=s;
 {$IFDEF WINDOWS}
 if (DefaultSystemCodePage<>GetOEMCP)
 then Result:=ConvertCP(s,GetOEMCP,DefaultSystemCodePage,CP_NONE);
 {$ENDIF WINDOWS}
end;

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

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

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

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

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

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

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

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

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

function StrCopyBuff(out Buff:TParsingBuffer; const S:LongString):PChar;
begin
 Result:=StrPLCopy(Buff,S,SizeOf(Buff)-1);
end;

function StrCopyBuff(out Buff:TMaxPathBuffer; const S:LongString):PChar;
begin
 Result:=StrPLCopy(Buff,S,SizeOf(Buff)-1);
end;

function FillCharBuff(out Buff:TParsingBuffer; C:Char=#0):PChar;
begin
 SafeFillChar(Buff,SizeOf(Buff),C);
 Result:=@Buff;
end;

function FillCharBuff(out Buff:TMaxPathBuffer; C:Char=#0):PChar;
begin
 SafeFillChar(Buff,SizeOf(Buff),C);
 Result:=@Buff;
end;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

function StrPas(Str:PWideChar):LongString;
var W:WideString;
begin
 if Assigned(Str) then W:=Str else W:='';
 Result:=WideToStr(W); W:='';
end;

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

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

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

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

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

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

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

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

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

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

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

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

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

 // Modified local version of AnsiExtractQuotedStr:
 // ExtractQuotedStr returns a copy of the string Src
 // with quote characters deleted to the left and right
 // and double occurances of Quote replaced by a single Quote
function ExtractQuotedStr(var Src:PChar; Quote:Char; Len:SizeInt):LongString;
var P,Q,R,B:PChar;
begin
 Result:='';
 P:=Src; if (P=nil) then Exit;          // Init/check source pointer (P)
 if (P[0]<>Quote) then begin            // If first char is not Quote,
  Result:=P; Exit;                      // then return Src
 end;                                   //
 Q:=P+StrLLen(P,Len);                   // Find source end position (Q)
 if (Q<=P) then Exit;                   // Check source end position (Q)
 Inc(P);                                // Skip first Quote char
 SetLength(Result,(Q-P)+1);             // Allocate buffer for Result
 B:=PChar(@Result[1]);                  // Begin buffer of Result (B)
 R:=B;                                  // Result char pointer (R)
 while (P<Q) do begin                   // While buffer not ended
  R[0]:=P[0]; Inc(R);                   // Copy char to result
  if (P[0]=Quote) then begin            // If this char is Quote
   Inc(P);                              // then check next char:
   if (P[0]<>Quote) then begin          // If next char is not Quote
    Dec(R);                             // then drop char from Result
    Break;                              // and Break because that is
   end;                                 // ending Quote found
  end;                                  // End Quote handling
  Inc(P);                               // Goto next char
 end;                                   // End while
 Src:=P;                                // Tail after quoted phrase
 SetLength(Result,(R-B));               // Correct Result length
end;                                    // Done

function ForEachQuotedPhrase(const SourceText:LongString;
                       Iterator:TQuotedPhraseIterator;
                       Custom:Pointer;
                       Delims:TCharSet=JustSpaces;
                       Quotes:LongString=QuoteMark+Apostrophe;
                       Mode:Integer=feqpm_Default
                             ):SizeInt;
var PCur,PBeg,PEnd,PFix:PChar; Phrase:LongString; Quote:Char;
var Cond:Boolean; Index,SourceLength,pEol:SizeInt;
begin
 Result:=0;
 if (Quotes<>'') then
 if (SourceText<>'') then
 try
  Index:=1;
  Phrase:=''; Quote:=#0;
  Include(Delims,Chr(0));
  SourceLength:=Length(SourceText); // Check breaking EOL if need:
  pEol:=IfThen(HasFlags(Mode,feqpm_BreakOnEOL),PosEol(SourceText),0);
  if (pEol>0) then SourceLength:=Max(0,Min(SourceLength,pEol-1));
  PBeg:=PChar(SourceText);
  PCur:=PChar(SourceText);
  PEnd:=PBeg+SourceLength;
  while (PCur<PEnd) do begin
   // String NUL terminator found?
   if (PCur[0]=ASCII_NUL) then Break;
   // Skip all leading char delimiters
   if (PCur[0] in Delims) then begin
    Inc(PCur);
    Continue;
   end;
   // First non-delimiter char is quote?
   if (Pos(PCur[0],Quotes)>0) then begin
    Quote:=PCur[0]; PFix:=PCur;
    Phrase:=ExtractQuotedStr(PCur,Quote,PEnd-PCur);
    if (PCur<=PFix) then Break; // Something wrong!
    if (Phrase='') and HasFlags(Mode,feqpm_SkipEmpty) then begin
     Phrase:=''; Quote:=#0; Continue; // Skip empty phrases
    end;
    if Assigned(Iterator)
    then Cond:=Iterator(Index,Phrase,PCur,Quote,Custom)
    else Cond:=true;
    Phrase:=''; Quote:=#0;
    if not Cond then Break;
    Result:=Index;
    Inc(Index);
   end else begin
    PFix:=PCur; // First char is not quote. Use word scan.
    while (PCur<PEnd) and not (PCur[0] in Delims) do Inc(PCur);
    if (PCur<=PFix) then Break; // Something wrong!
    Phrase:=StringBuffer(PFix,PCur-PFix);
    if Assigned(Iterator)
    then Cond:=Iterator(Index,Phrase,PCur,Quote,Custom)
    else Cond:=true;
    Phrase:=''; Quote:=#0;
    if not Cond then Break;
    Result:=Index;
    Inc(Index);
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'ForEachQuotedPhrase');
 end;
end;

function qpTestIterator(Index:SizeInt; Phrase:LongString; Tail:PChar;
                         Quote:Char; Custom:Pointer):Boolean;
var Line:LongString;
begin
 Result:=true;
 if Assigned(Custom) then begin
  if (Quote<=' ') then Quote:=' ';
  Line:=Format('   %d: %s %s',[Index,Quote,Phrase]);
  TStrings(Custom).Add(Line);
 end;
end;

function Test_ForEachQuotedPhrase:LongString;
var List:TStringList;
 procedure Test(S:LongString);
 var n:Integer; bs:LongString;
 begin
  bs:=s;
  bs:=StringReplace(bs,ASCII_CR,'\r',[rfReplaceAll]);
  bs:=StringReplace(bs,ASCII_LF,'\n',[rfReplaceAll]);
  List.Add(Format(' Test String[%d]: %s',[Length(s),bs]));
  n:=ForEachQuotedPhrase(S,qpTestIterator,List);
  List.Add(' Return '+IntToStr(n));
 end;
begin
 Result:='';
 try
  List:=TStringList.Create;
  try
   List.Add('Test ForEachQuotedPhrase:');
   Test('');
   Test(EOL);
   Test('  ');
   Test('""');
   Test(' """" ');
   Test(' "" "" ');
   Test('  1 2 3');
   Test('  1'+CRLF+' 2 3');
   Test('  one two three');
   Test('  "one two three');
   Test('  "one two" three');
   Test('  "one two"" three');
   Test('  "one two"" three"');
   Test('  "one two" "three" ');
   Test('  one "two three"');
   Test(' ""  one two three ""');
   Test('   o"n"e two t"h"ree ');
   Test('  one two'+EOL+' three');
   Test('  "one two'+EOL+' three"');
   Result:=List.Text;
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,nil,'Test_ForEachQuotedPhrase');
 end;
end;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


function IsSameText(const S1,S2:LongString):Boolean;
var i:SizeInt; label AnsiCompare;
begin
 Result:=False;
 if (Length(S1)<>Length(S2)) then Exit;
 if (S1=S2) then Exit(True); // Fast check
 // On UTF8 system compare as ASCII or UTF8
 if (DefaultSystemCodePage=CP_UTF8) then begin
  // Use fast ANSI string compare for ASCII
  if IsTextAscii(S1) then goto AnsiCompare;
  if IsTextAscii(S2) then goto AnsiCompare;
  // Compare as UTF8, when it is possible …
  if utf8_valid(S1) and utf8_valid(S2) then begin
   Result:=utf8_sametext(S1,S2);
   Exit;
  end;
 end;
 AnsiCompare:
 for i:=0 to Length(S1)-1 do
 if UpCaseTable[PChar(S1)[i]]<>UpCaseTable[PChar(S2)[i]] then Exit;
 Result:=true;
end;

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

function IsTextAscii(const aText:PChar; aLen:SizeInt):Boolean; overload;
const BMask=$80; LMask=$80808080; QMask=$8080808080808080;
const SLW=SizeOf(LongWord); SQW=SizeOf(QWord);
var P,PE,PN:PChar;
begin
 Result:=False;
 if (aLen<=0) then Exit;
 if (aText=nil) then Exit;
 P:=aText; PE:=aText+aLen;
 // Handle 8-bytes blocks
 if IsCPU64 then // 64 bit
 if (PE-P)>=SQW then begin
  PN:=P+(((PE-P) div SQW)*SQW);
  while (P<PN) do begin
   if ((QWord(Pointer(P)^) and QMask)<>0) then Exit;
   Inc(P,SQW);
  end;
 end;
 // Handle 4-byte blocks
 if (PE-P)>=SLW then begin
  PN:=P+(((PE-P) div SLW)*SLW);
  while (P<PN) do begin
   if ((LongWord(Pointer(P)^) and LMask)<>0) then Exit;
   Inc(P,SLW);
  end;
 end;
 // Handle bytes
 while (P<PE) do begin
  if ((Byte(Pointer(P)^) and BMask)<>0) then Exit;
  Inc(P);
 end;
 Result:=True;
end;

function IsTextAscii(const aText:LongString):Boolean; overload;
begin
 Result:=IsTextAscii(PChar(aText),Length(aText));
end;

function IsTextAscii(const aText:ShortString):Boolean; overload;
begin
 Result:=IsTextAscii(PChar(@aText[1]),Length(aText));
end;

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

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

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

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

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

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

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

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

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

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

 ///////////////////////////////////////////////////////////////////////////////
 // Replace format %g to %.15g to fix Format('%g',[]) problem.
 // Reason: by default FPC uses %g as %.17g, which is good for Extended type.
 //         Delphi5 uses format %g as %.15g, which is good for Double   type.
 //         The crwdaq package uses Double as main floating point type, so we
 //         have to convert %g to %.15g on the fly.
 //         Without this conversion Double(0.1) converts to 0.10000000000000001.
 //         That is not what we expected to see.
 ///////////////////////////////////////////////////////////////////////////////
procedure FixFormatG(var Fm:String);
const gDig:Integer=0; // Digits in SysUtils.Format(%g)
const PrecSpec='.15'; // Precision specifier string
var i,j,len:SizeInt; cn:Char;
begin
 // At first call calculate number of digits in Pi with format %g
 if (gDig=0) then gDig:=CountChars(SysUtils.Format('%g',[Pi]),['0'..'9']);
 if (gDig<=15) then Exit; // Format precision is valid, no need to fix it
 i:=1; len:=Length(Fm);
 while (i<len) do begin
  if (Fm[i]='%') then begin
   j:=i; // Special case - formats like: %-10g, %*g, %-*g, etc
   while (i+1<len) and (Fm[i+1] in ['-','*','0'..'9']) do Inc(i);
   cn:=Fm[i+1]; // next char is 'g' format?
   if (cn='g') or (cn='G') then begin
    // Check for double percent (%%) case
    if (StrFetch(Fm,j-1)<>'%') then begin
     Insert(PrecSpec,Fm,i+1);
     Inc(i,Length(PrecSpec));
     Inc(len,Length(PrecSpec));
    end;
    Inc(i);
   end;
  end;
  Inc(i);
 end;
end;

function Format(const Fmt:LongString; const Args: array of const; Fast:Boolean=False):LongString;
var Fm:String;
begin
 Result:='';
 if Fast then begin
  Fm:=Fmt;
  if UsesFixFormatG
  then FixFormatG(Fm);
  Result:=SysUtils.Format(Fm, Args);
 end else
 try
  Fm:=Fmt;
  if UsesFixFormatG
  then FixFormatG(Fm);
  Result:=SysUtils.Format(Fm, Args);
 except
  on E:Exception do BugReport(E,nil,'Format');
 end;
end;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

function NeedToTrimStr(const S:LongString):Boolean;
var Len:SizeInt;
begin
 Result:=False;
 Len:=Length(S); if (Len<=0) then Exit;
 if (S[1]<=' ') or (S[Len]<=' ') then Result:=True;
end;

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

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

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

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

function DropNLeadStr(const S:LongString; N:Integer):LongString;
begin
 Result:=S;
 N:=EnsureRange(N,0,Length(S));
 if (N>0) then Delete(Result,1,N);
end;

function DropNTailStr(const S:LongString; N:Integer):LongString;
begin
 Result:=S;
 N:=EnsureRange(N,0,Length(S));
 if (N>0) then Delete(Result,1+(Length(S)-N),N);
end;

function ContainsStr(const AText,ASubText:LongString): Boolean;
begin
 Result:=(Pos(ASubText,AText)>0);
end;

function StartsStr(const ASubText,AText:LongString):Boolean;
begin
 Result:=(ASubText='') or (LeftStr(AText,Length(ASubText))=ASubText);
end;

function EndsStr(const ASubText,AText:LongString):Boolean;
begin
 Result:=(ASubText='') or (RightStr(AText,Length(ASubText))=ASubText);
end;

function ContainsText(const AText,ASubText:LongString): Boolean;
begin
 Result:=(PosI(ASubText,AText)>0);
end;

function StartsText(const aSubText,aText:LongString):Boolean;
begin
 Result:=(aSubText='') or SameText(LeftStr(aText,Length(aSubText)),aSubText);
end;

function EndsText(const aSubText,aText:LongString):Boolean;
begin
 Result:=(aSubText='') or SameText(RightStr(aText,Length(aSubText)),aSubText);
end;

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

function EnsureEndingEol(const S:LongString):LongString;
var LS,LE:Integer;
begin
 Result:=S; if (S='') then Exit;
 LS:=Length(S); LE:=Length(Eol);
 if (LS<LE) then Result:=S+Eol else
 if (Copy(S,LS-LE+1,LE)<>Eol) then Result:=S+Eol;
end;

function EnsureHeapString(const S:LongString):LongString;
begin
 if (StringRefCount(S)<0)      // If S is constant string,
 then Result:=StringBuffer(S)  // then make a copy in heap
 else Result:=S;               // else use original string
end;

function StrRemoveTailAfterSep(const Line:LongString; Sep:TCharSet; KeepSep:Boolean=False):LongString;
var i:Integer;
begin
 Result:=Line;
 for i:=1 to Length(Result) do begin
  if (Line[i] in Sep) then begin
   if not KeepSep
   then System.Delete(Result,i,MaxInt)
   else System.Delete(Result,i+1,MaxInt);
   Break;
  end;
 end;
end;

{$IFDEF WINDOWS}
function GetLongPathName(lpszShortPath,lpszLongPath:PChar; cchBuffer:DWORD):DWORD;stdcall;
type  ft=function(lpszShortPath,lpszLongPath:PChar; cchBuffer:DWORD):DWORD;stdcall;
const fn:ft=nil;
begin
 if not Assigned(fn) then @fn:=GetProcAddress(GetModuleHandle('kernel32.dll'),'GetLongPathNameA');
 if Assigned(fn) then Result:=fn(lpszShortPath,lpszLongPath,cchBuffer) else Result:=0;
end;
{$ENDIF WINDOWS}
{$IFDEF WINDOWS}
function GetRealFilePathName(const FileName:LongString; BuffSize:Integer=MAX_PATH; Mode:Integer=$1F):LongString;
 function GetFQPN(const FileName:LongString):LongString;
 var Handle:THandle; FindData:TWin32FindData; i:Integer;
 begin
  Result:=FileName;
  SafeFillChar(FindData,SizeOf(FindData),0);
  if (Length(Result)>0) then
  for i:=Length(Result) downto 1 do begin
   if (Result[i] in ['\',':','/']) then begin
    if (Result[i]=':') then begin
     if (i=2) then // Drive name X:
     if (Result[i-1] in ['a'..'z'])
     then Result[i-1]:=UpCase(Result[i-1]);
     Break;
    end;
    if (i=2) then begin // UNC \\name
     if (Result[i] in ['\','/']) then
     if (Result[i-1] in ['\','/']) then Break;
    end;
    if (i=Length(Result)) then begin // Trail \
     Result:=GetFQPN(Copy(Result,1,i-1))+Result[i];
     Break;
    end;
    Handle:=Windows.FindFirstFile(PChar(Result),FindData);
    if (Handle<>INVALID_HANDLE_VALUE) then begin
     Windows.FindClose(Handle);
     Result:=GetFQPN(Copy(Result,1,i-1))+Result[i]+FindData.cFileName;
     Break;
    end;
    Break;
   end;
  end;
 end;
var i,err:Integer; Dummy:PChar; Temp,Buff:LongString;
begin
 Result:=FileName;
 if (Mode<>0) and (Length(Result)>0) then            // Skip empty and
 if (Pos('*',Result)=0) and (Pos('?',Result)=0) then // Skip wildcards
 try
  err:=GetLastError; Dummy:=nil; Buff:=''; Temp:='';
  try
   SetLength(Buff,BuffSize); // Use as temporary buffer
   if ((Mode and $01)<>0) then begin // Replace / to \
    for i:=1 to Length(Result) do if (Result[i]='/') then Result[i]:='\';
   end;
   if ((Mode and $02)<>0) then begin // GetFullPathName
    SetString(Temp,PChar(Buff),GetFullPathName(PChar(Result),Length(Buff),PChar(Buff),Dummy));
    if (Length(Temp)>0) then Result:=Temp;
   end;
   if ((Mode and $04)<>0) then begin // GetLongPathName
    SetString(Temp,PChar(Buff),GetLongPathName(PChar(Result),PChar(Buff),Length(Buff)));
    if (Length(Temp)>0) then Result:=Temp;
   end;
   if ((Mode and $08)<>0) then begin // Fully Qualified Path Name
    Result:=GetFQPN(Result);
   end;
  finally
   SetLastError(err);
   Temp:='';Buff:='';
  end;
 except
  on E:Exception do BugReport(E,nil,'GetRealFilePathName');
 end;
end;
{$ENDIF WINDOWS}
{$IFDEF UNIX}
function ReadSymLink(const FileName:LongString; MaxLevel:Integer=10):LongString;
var Target:LongString;
begin
 Result:=Trim(FileName); if (Result='') then Exit;
 while FileGetSymLinkTarget(Result,Target) do begin
  Result:=Target; Dec(MaxLevel);
  if (MaxLevel<0) then Break;
 end;
end;
function GetRealFilePathName(const FileName:LongString; BuffSize:Integer=MAX_PATH; Mode:Integer=$1F):LongString;
begin
 Result:=FileName;
 if (Mode<>0) and (Length(Result)>0) then            // Skip empty and
 if (Pos('*',Result)=0) and (Pos('?',Result)=0) then // Skip wildcards
 try
  if HasFlags(Mode,$01) then Result:=ValidatePathDelim(Result);
  if HasFlags(Mode,$02) then Result:=FExpand(Result);
  if HasFlags(Mode,$10) then Result:=ReadSymLink(Result);
 except
  on E:Exception do BugReport(E,nil,'GetRealFilePathName');
 end;
end;
{$ENDIF UNIX}

function ua_FileDefLow:Integer;
begin
 Result:=IfThen(FileNameCaseSensitive,ua_FileDef,ua_FileLow);
end;

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

function UnifyFileAlias(const FileName:LongString; Mode:Integer=ua_FileDef):LongString;
begin
 if IsEmptyStr(FileName) then Result:='' else begin
  if HasFlags(Mode,ua_FileDef) then Mode:=UnifyFileAliasDefMode or (Mode and not ua_ModeDef);
  Result:=UnifyAlias(FileName,Mode and not ua_ModeDef);
  if HasFlags(Mode,ua_DirSep) then Result:=ValidatePathDelim(Result);
  if HasFlags(Mode,ua_FExpand) then Result:=FExpand(Result);
  if HasFlags(Mode,ua_GetReal) then begin
   if not (FileNameCaseSensitive and HasFlags(Mode,ua_FExpand))
   then Result:=GetRealFilePathName(Result);
  end;
 end;
end;

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

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

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

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

function StrFirstChar(const s:LongString):AnsiChar;
begin
 if (s<>'') then Result:=s[1] else Result:=#0;
end;

function StrFirstChar(const s:WideString):WideChar;
begin
 if (s<>'') then Result:=s[1] else Result:=#0;
end;

function StrLastChar(const s:LongString):AnsiChar;
begin
 if (s<>'') then Result:=s[Length(s)] else Result:=#0;
end;

function StrLastChar(const s:WideString):WideChar;
begin
 if (s<>'') then Result:=s[Length(s)] else Result:=#0;
end;

function Tab2Space(const S:LongString; Numb:Byte):LongString;
var I:SizeInt;
begin
 Result:=S; I:=1;
 if (Result='') then Exit;
 while (I<=Length(Result)) do
 if (Result[I]<>ASCII_TAB) then Inc(I) else begin
  Result[I]:=' ';
  if (Numb>1) then Insert(StringOfChar(' ',Numb-1),Result,I);
  Inc(I,Numb);
 end;
end;

function Tab2SpaceAdjusted(const S:LongString; Numb:Byte; Mode:Integer=0):LongString;
var I,LI,LA:SizeInt; nb:Byte; UseAnsi:Boolean;
begin
 Result:=S; I:=1;
 if (Result='') then Exit;
 UseAnsi:=HasFlags(Mode,1) or IsTextAscii(S) or not utf8_valid(S);
 UseAnsi:=UseAnsi or (DefaultSystemCodePage<>CP_UTF8);
 while (I<=Length(Result)) do
 if (Result[I]<>ASCII_TAB) then Inc(I) else begin
  Result[I]:=' ';
  if UseAnsi then LI:=I else LI:=utf8_length(Copy(Result,1,I));
  LA:=AdjustBufferSize(LI,Numb);
  Nb:=Numb; if (LI>0) and (LA>=LI) then Nb:=LA-LI+1;
  if (Nb>1) then Insert(StringOfChar(' ',Nb-1),Result,I);
  Inc(I,Nb);
 end;
end;

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

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

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

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

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

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

function QArg(const s:LongString; quote:Char=QuoteMark; const Spaces:TCharSet=JustSpaces):LongString;
begin
 Result:=AnsiQuotedIfNeed(Trim(s),quote,Spaces);
end;

function ExtractFirstParamUrl(Line:LongString; quote:Char=QuoteMark; const Spaces:TCharSet=JustSpaces):LongString;
begin
 Result:='';
 Line:=Trim(Line);
 if (Line='') then Exit;
 if (StrFetch(Line,1)=quote)
 then Result:=ExtractFirstParam(Line,quote,Spaces)
 else Result:=URL_Decode(ExtractWord(1,Line,Spaces));
end;

function Dequote_or_URL_Decode(Line:LongString; quote:Char=QuoteMark; const Spaces:TCharSet=JustSpaces):LongString;
begin
 Result:='';
 Line:=Trim(Line);
 if (Line='') then Exit;
 if (StrFetch(Line,1)=quote)
 then Result:=ExtractFirstParam(Line,quote,Spaces)
 else Result:=URL_Decode(Line);
end;

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

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

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

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

function SafeExecRegExpr(const ARegExpr,AInputStr:LongString):Boolean;
begin
 Result:=False;
 try
  Result:=ExecRegExpr(ARegExpr,AInputStr);
 except
  on E:Exception do BugReport(E,nil,'SafeExecRegExpr');
 end;
end;

function SafeReplaceRegExpr(const ARegExpr,AInputStr,AReplaceStr:LongString;
                            AUseSubstitution:Boolean=False):LongString;
begin
 Result:=AInputStr;
 try
  Result:=ReplaceRegExpr(ARegExpr,AInputStr,AReplaceStr,AUseSubstitution);
 except
  on E:Exception do BugReport(E,nil,'SafeReplaceRegExpr');
 end;
end;

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

function IsLexeme(arg:PChar; leng:SizeInt; typ:Integer):Boolean; overload;
var i,np:SizeInt; vi,code:Integer; vf:Extended; st,rx:LongString;
const JustQuotes=[QuoteMark,Apostrophe];
begin
 Result:=false;
 if (arg=nil) then Exit;
 if (leng<=0) then Exit;
 try
  case typ of
   lex_Ansi : begin
    Result:=true;
    Exit;
   end;
   lex_Utf8 : begin
    Result:=utf8_valid(arg,leng);
    Exit;
   end;
   lex_Name: begin
    for i:=0 to leng-1 do
    case arg[i] of
     '0'..'9' : if (i=0) then Exit;
     'A'..'Z','_','a'..'z' : ;
     else Exit;
    end;
   end;
   lex_Word: begin
    for i:=0 to leng-1 do
    case arg[i] of
     '0'..'9','A'..'Z','_','a'..'z' : ;
     else Exit;
    end;
   end;
   lex_Blank: begin
    for i:=0 to leng-1 do
    case arg[i] of
     ASCII_HT,' ' : ;
     else Exit;
    end;
   end;
   lex_Space: begin
    for i:=0 to leng-1 do
    case arg[i] of
     ASCII_HT,ASCII_LF,ASCII_VT,ASCII_FF,ASCII_CR,' ' : ;
     else Exit;
    end;
   end;
   lex_Cntrl: begin
    for i:=0 to leng-1 do
    case arg[i] of
     #$00..#$1F,#$7F : ;
     else Exit;
    end;
   end;
   lex_Alpha: begin
    for i:=0 to leng-1 do
    case arg[i] of
     'A'..'Z','a'..'z' : ;
     else Exit;
    end;
   end;
   lex_Lower: begin
    for i:=0 to leng-1 do
    case arg[i] of
     'a'..'z' : ;
     else Exit;
    end;
   end;
   lex_Upper: begin
    for i:=0 to leng-1 do
    case arg[i] of
     'A'..'Z' : ;
     else Exit;
    end;
   end;
   lex_Digit: begin
    for i:=0 to leng-1 do
    case arg[i] of
     '0'..'9' : ;
     else Exit;
    end;
   end;
   lex_Alnum: begin
    for i:=0 to leng-1 do
    case arg[i] of
     '0'..'9','A'..'Z','a'..'z' : ;
     else Exit;
    end;
   end;
   lex_xDigit: begin
    for i:=0 to leng-1 do
    case arg[i] of
     '0'..'9','A'..'F','a'..'f' : ;
     else Exit;
    end;
   end;
   lex_Punct: begin
    for i:=0 to leng-1 do
    case arg[i] of
     '!','"','#','$','%','&','''','(',')','*','+',',','-','.','/',
     ':',';','<','=','>','?','@','[','\',']','_','`','{','|','}','~' : ;
     else Exit;
    end;
   end;
   lex_Print: begin
    for i:=0 to leng-1 do
    case arg[i] of
     #$20..#$7E : ;
     else Exit;
    end;
   end;
   lex_Graph: begin
    for i:=0 to leng-1 do
    case arg[i] of
     #$21..#$7E : ;
     else Exit;
    end;
   end;
   lex_Ascii: begin
    Exit(IsTextAscii(arg,leng)); // Use fast ASCII check function
    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;
   lex_LQuote: begin
    if (leng<1) then Exit;
    if not (arg[0] in JustQuotes) then Exit;
   end;
   lex_RQuote: begin
    if (leng<1) then Exit;
    if not (arg[leng-1] in JustQuotes) then Exit;
   end;
   lex_Quotes: begin
    if (leng<2) then Exit;
    if not (arg[0] in JustQuotes) then Exit;
    if (StrLScan(@arg[1],arg[0],leng-1)=nil) then Exit;
   end;
   lex_Quoted: begin
    if (leng<2) then Exit;
    if (arg[leng-1]<>arg[0]) then Exit;
    if not (arg[0] in JustQuotes) then Exit;
   end;
   lex_DomName: begin
    // RFC-952,RFC-1123
    if (leng<1) then Exit;  // RFC-952
    if (leng>63) then Exit; // RFC-1123
    for i:=0 to leng-1 do
    case arg[i] of
     'a'..'z','A'..'Z','0'..'9' : ;
     '-': if (i=0) or (i=(leng-1)) then Exit;
     else Exit;
    end;
   end;
   lex_DnsHost: begin
    // RFC-1123 based
    if (leng<1) then Exit;
    if (leng>253) then Exit; // Wiki
    np:=0; // Name position
    for i:=0 to leng-1 do
    case arg[i] of
     'a'..'z','A'..'Z','0'..'9' : ;
     '-': if (i=0) or (i=(leng-1)) then Exit;
     '.': if (i=0) or (i=(leng-1)) then Exit else begin
           if (i<=np) then Exit; // Check domain name component
           if not IsLexeme(@arg[np],i-np,lex_DomName) then Exit;
           np:=i+1;
          end;
     else Exit;
    end;
    if (leng<=np) then Exit; // Check last domain name part
    if not IsLexeme(@arg[np],leng-np,lex_DomName) then Exit;
   end;
   lex_AddUser: begin
    if (leng<1) then Exit;
    for i:=0 to leng-1 do
    case arg[i] of
     'a'..'z' : ;
     '-','_': if (i=0) then Exit;
     '0'..'9' : if (i=0) then Exit;
     '$': if (i=0) or (i<>(leng-1)) then Exit;
     else Exit;
    end;
   end;
   lex_DomUser: begin
    if (leng<1) then Exit;
    for i:=0 to leng-1 do
    case arg[i] of
     'a'..'z','A'..'Z' : ;
     '-','_': if (i=0) then Exit;
     '0'..'9' : if (i=0) then Exit;
     else Exit;
    end;
   end;
   lex_UsrHost: begin
    if (leng<3) then Exit;
    np:=0; while (np<leng) and (arg[np]<>'@') do inc(np);
    if (np<=0) or (np>=(leng-1)) then Exit; // @ missed/starts/ends
    if not IsLexeme(@arg[0],np,lex_DomUser) then Exit; // Invalid user
    if not IsLexeme(@arg[np+1],leng-np-1,lex_DnsHost) then Exit; // Invalid host
   end;
   lex_Ip4Addr: begin
    // https://stackoverflow.com/questions/5284147
    // Choose long but most robust regular expression
    rx:='^(?:(?:25[0-5]|2[0-4][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9])\.){3}'
           +'(?:25[0-5]|2[0-4][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9])$';
    if (leng<1) then Exit;
    st:=StringBuffer(arg,leng);
    if not SafeExecRegExpr(rx,st) then Exit;
   end;
   lex_Ip6Addr: begin
    // https://stackoverflow.com/questions/53497
    // https://uibakery.io/regex-library/ip-address
    rx:='^(([0-9a-fA-F]{1,4}:){7,7}[0-9a-fA-F]{1,4}|([0-9a-fA-F]{1,4}:){1,7}:|'
       +'([0-9a-fA-F]{1,4}:){1,6}:[0-9a-fA-F]{1,4}|([0-9a-fA-F]{1,4}:){1,5}'
       +'(:[0-9a-fA-F]{1,4}){1,2}|([0-9a-fA-F]{1,4}:){1,4}(:[0-9a-fA-F]{1,4}){1,3}|'
       +'([0-9a-fA-F]{1,4}:){1,3}(:[0-9a-fA-F]{1,4}){1,4}|([0-9a-fA-F]{1,4}:){1,2}'
       +'(:[0-9a-fA-F]{1,4}){1,5}|[0-9a-fA-F]{1,4}:((:[0-9a-fA-F]{1,4}){1,6})|:'
       +'((:[0-9a-fA-F]{1,4}){1,7}|:)|fe80:(:[0-9a-fA-F]{0,4}){0,4}%[0-9a-zA-Z]{1,}|::'
       +'(ffff(:0{1,4}){0,1}:){0,1}((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}'
       +'(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])|([0-9a-fA-F]{1,4}:){1,4}:'
       +'((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|'
       +'(2[0-4]|1{0,1}[0-9]){0,1}[0-9]))$';
    if (leng<1) then Exit;
    st:=StringBuffer(arg,leng);
    if not SafeExecRegExpr(rx,st) then Exit;
   end;
   lex_MacAddr: begin
    // https://stackoverflow.com/questions/4260467
    rx:='^([0-9A-Fa-f]{2}[:-]){5}([0-9A-Fa-f]{2})$';
    if (leng<1) then Exit;
    st:=StringBuffer(arg,leng);
    if not SafeExecRegExpr(rx,st) then Exit;
   end;
   lex_DotName: begin
    if (leng<1) then Exit;
    np:=0; // NamePosition
    for i:=0 to leng-1 do
    case arg[i] of
     'a'..'z','A'..'Z','0'..'9','_' : ;
     '.': if (i=0) or (i=(leng-1)) then Exit else begin
           if (i<=np) then Exit; // Check name component
           if not IsLexeme(@arg[np],i-np,lex_Name) then Exit;
           np:=i+1;
          end;
     else Exit;
    end;
    if (leng<=np) then Exit; // Check last name part
    if not IsLexeme(@arg[np],leng-np,lex_Name) then Exit;
   end;
   lex_UriAddr: begin
    // Extra check in addition to RFC: no spaces in string
    for i:=0 to leng-1 do if (arg[i] in JustSpaces) then Exit;
    // https://www.ietf.org/rfc/rfc3986.txt Appendix B with Errata 2624
    rx:='^(([^:\/?#]+):)?(\/\/([^\/?#]*))?([^?#]*)(\?([^#]*))?(#(.*))?';
    if (leng<1) then Exit;
    st:=StringBuffer(arg,leng);
    if not SafeExecRegExpr(rx,st) then Exit;
   end;
   lex_PctChar: begin
    for i:=0 to leng-1 do
    case arg[i] of
     '%' : Exit(True);
    end;
    Exit;
   end;
   lex_PctCode: begin
    for i:=0 to leng-1 do
    case arg[i] of
     '%' : if (i>leng-3) then Exit else // RFC-3986 valid %xx HEX code?
           if not (arg[i+1] in ['0'..'9','A'..'F','a'..'f']) then Exit else
           if not (arg[i+2] in ['0'..'9','A'..'F','a'..'f']) then Exit;
    end;
   end;
   lex_PctData: begin
    for i:=0 to leng-1 do
    case arg[i] of
     '%' : if (i>leng-3) then Exit else // RFC-3986 valid %xx HEX code?
           if not (arg[i+1] in ['0'..'9','A'..'F','a'..'f']) then Exit else
           if not (arg[i+2] in ['0'..'9','A'..'F','a'..'f']) then Exit;
     ':','/','?','#','[',']','@' : Exit;                  // gen_delims
     '!','$','&','''','(',')','*','+',',',';','=' : Exit; // sub_delims
     #0..' ' : Exit;                                      // JustSpaces
    end;
   end;
   lex_PctNeed: begin
    for i:=0 to leng-1 do
    case arg[i] of
     '%' : Exit(True);                                          // RFC-3986
     ':','/','?','#','[',']','@' : Exit(True);                  // gen_delims
     '!','$','&','''','(',')','*','+',',',';','=' : Exit(True); // sub_delims
     #0..' ' : Exit(True);                                      // JustSpaces
    end;
    Exit;
   end;
   else begin
    if Assigned(lex_regexp_test) then
    if (typ>=ObjectRegistryOffset) then begin
     SetString(st,arg,leng);
     Result:=lex_regexp_test(typ,st);
    end;
    Exit;
   end;
  end;
  Result:=true;
 except
  on E:Exception do BugReport(E,nil,'IsLexeme');
 end;
end;

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

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

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

function ReplaceChars(const Str:LongString; Find,Replace:Char;
                      Flags:TReplaceFlags=[rfReplaceAll]):LongString;
var p:Integer;
begin
 Result:=Str;
 if (Str='') then Exit;
 p:=Pos(Find,Str);
 if (rfIgnoreCase in Flags) then begin
  if (p=0) and (UpCase(Find)<>Find) then p:=Pos(UpCase(Find),Str);
  if (p=0) and (LoCase(Find)<>Find) then p:=Pos(LoCase(Find),Str);
 end;
 if (p>0) then Result:=StringReplace(Str,Find,Replace,Flags);
end;

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

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

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

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

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

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

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

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

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

 {
 **************
 Phrase parsing
 **************
 }
type
 PExPhRec=^TExPhRec;
 TExPhRec=record Extract,Skip,List,Term:Integer; Data:LongString; end;

function exphIterator(Index:SizeInt; Phrase:LongString; Tail:PChar;
                      Quote:Char; Custom:Pointer):Boolean;
var R:PExPhRec;
begin
 Result:=true; R:=Custom;
 if not Assigned(Custom) then Exit(false);
 if (R.Term>0) then Exit(false);
 if (R.List>0) then begin R.Data:=R.Data+Phrase+EOL; Exit; end;
 if (Index=R.Extract) then begin R.Data:=Phrase; R.Term:=1; Exit; end;
 if (Index=R.Skip) then begin R.Data:=StrPas(Tail); R.Term:=1; Exit; end;
end;

function PhraseCount(const S:LongString; const Delims:TCharSet;
                     Quotes:LongString=QuoteMark+Apostrophe):Integer;
var p,t,x:LongString; quote:Char;
begin
 Result:=0;
 if (S='') then Exit;
 if UsesPhraseIterator then begin
  Result:=ForEachQuotedPhrase(S,nil,nil,Delims,Quotes);
  Exit;
 end;
 // Fallback version
 t:=S; x:='';
 repeat
  t:=TrimRightChars(t,Delims); quote:=StrFetch(t,1);
  if (Pos(quote,Quotes)=0) then quote:=QuoteMark;
  p:=ExtractFirstParam(t,quote,Delims); x:=t;
  if (p<>'') then Inc(Result) else Break;
  t:=SkipFirstParam(t,quote,Delims);
  if (Length(t)>=Length(x)) then Break;
 until (t='');
end;

function ExtractPhrase(N:Integer; const S:LongString; const Delims:TCharSet;
                       Quotes:LongString=QuoteMark+Apostrophe):LongString;
var i:Integer; t,x:LongString; R:TExPhRec; quote:Char;
begin
 Result:='';
 if (S='') then Exit;
 if (N<=0) then Exit;
 if UsesPhraseIterator then begin
  SafeFillChar(R,SizeOf(R),0); R.Extract:=N;
  ForEachQuotedPhrase(S,exphIterator,@R,Delims,Quotes);
  Result:=R.Data; R.Data:='';
  Exit;
 end;
 // Fallback version
 t:=S; x:='';
 for i:=1 to N do begin
  t:=TrimRightChars(t,Delims); quote:=StrFetch(t,1);
  if (Pos(quote,Quotes)=0) then quote:=QuoteMark;
  Result:=ExtractFirstParam(t,quote,Delims); x:=t;
  if (Result='') then Break else t:=SkipFirstParam(t,quote,Delims);
  if (Length(t)>=Length(x)) then Exit(''); // Failed
 end;
end;

function SkipPhrases(N:Integer; const S:LongString; const Delims:TCharSet;
                     Quotes:LongString=QuoteMark+Apostrophe):LongString;
var i:Integer; t,x:LongString; R:TExPhRec; quote:Char;
begin
 Result:='';
 if (S='') then Exit;
 if (N<=0) then Exit(S);
 if UsesPhraseIterator then begin
  SafeFillChar(R,SizeOf(R),0); R.Skip:=N;
  ForEachQuotedPhrase(S,exphIterator,@R,Delims,Quotes);
  Result:=TrimLeftChars(R.Data,Delims); R.Data:='';
  Exit;
 end;
 // Fallback version
 t:=S; x:='';
 for i:=1 to N do begin
  t:=TrimRightChars(t,Delims); quote:=StrFetch(t,1);
  if (Pos(quote,Quotes)=0) then quote:=QuoteMark;
  x:=t; t:=SkipFirstParam(t,quote,Delims);
  if (Length(t)>=Length(x)) then Exit(''); // Failed
  Result:=t; if (Result='') then Break;
 end;
end;

function PhraseListToTextLines(const S:LongString; const Delims:TCharSet;
                               Quotes:LongString=QuoteMark+Apostrophe):LongString;
var p,t,x:LongString; R:TExPhRec; quote:Char;
begin
 Result:='';
 if (S='') then Exit;
 if UsesPhraseIterator then begin
  SafeFillChar(R,SizeOf(R),0); R.List:=1;
  ForEachQuotedPhrase(S,exphIterator,@R,Delims,Quotes);
  Result:=R.Data; R.Data:='';
  Exit;
 end;
 // Fallback version
 t:=S; x:='';
 repeat
  t:=TrimRightChars(t,Delims); quote:=StrFetch(t,1);
  if (Pos(quote,Quotes)=0) then quote:=QuoteMark;
  p:=ExtractFirstParam(t,quote,Delims); x:=t;
  if (p<>'') then Result:=Result+p+EOL else Break;
  t:=SkipFirstParam(t,quote,Delims);
  if (Length(t)>=Length(x)) then Break;
 until (t='');
end;

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

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

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

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

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

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

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

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

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

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

function IntToStrBase(Value:LongInt; Base:Integer=10; Width:Integer=0):LongString;
begin
 case Base of
  2:   Result:=BinL(Value);
  8:   Result:=OctL(Value);
  10:  Result:=IntToStr(Value);
  16:  Result:=HexL(Value);
  else Result:='';
 end;
 if (Result<>'') then begin
  Width:=Max(Width,1);
  while (Length(Result)>Width) and (StrFetch(Result,1)='0') do Delete(Result,1,1);
 end;
end;

function StrToIntBase(S:LongString; Base:Integer=10; Def:Integer=0):LongInt;
var Value:LongInt;
begin
 Result:=Def; S:=Trim(S); if (S='') then Exit;
 case StrFetch(S,1) of
  '%': begin Base:=2;  Delete(S,1,1); end;
  '&': begin Base:=8;  Delete(S,1,1); end;
  '$': begin Base:=16; Delete(S,1,1); end;
 end;
 Value:=0;
 case Base of
  2:   if StrBin2Long(S,Value) then Result:=Value else Result:=Def;
  8:   if StrOct2Long(S,Value) then Result:=Value else Result:=Def;
  10:  if TryStrToInt(S,Value) then Result:=Value else Result:=Def;
  16:  if StrHex2Long(S,Value) then Result:=Value else Result:=Def;
  else Result:=Def;
 end;
end;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

function ScanVarRecord(svMode:Cardinal; Str:PChar; const Format:LongString; var Data):PChar;
begin
 Result:=ScanVar(svMode,Str,Format,Data);
end;

const
 ScanVarKeyFmtErrors:SizeInt=0;
 ScanVarKeyFmtBugs:LongString='';
 ScanVarKeyFmtMaxLen=80;

procedure KeyFmtBug(const Key,Fmt:LongString);
var Item:LongString;
begin
 Inc(ScanVarKeyFmtErrors);
 if (Length(ScanVarKeyFmtBugs)<ScanVarKeyFmtMaxLen) then begin
  Item:=' '+Key+':'+Fmt;
  if (PosI(Item,ScanVarKeyFmtBugs)=0)
  then ScanVarKeyFmtBugs:=ScanVarKeyFmtBugs+Item;
 end;
end;

function KeyFmt(const Key,Fmt:LongString):LongString;
var p:SizeInt;
begin
 p:=Pos('%',Key);
 if (p<1) then Result:=Key+Fmt else Result:=Copy(Key,1,p-1)+Fmt;
 if (p>0) and (SysUtils.StrIComp(PChar(Fmt),@Key[p])<>0) then KeyFmtBug(Key,Fmt);
end;

function ScanVarBoolean(svMode:Cardinal; Str:PChar; const Key:LongString; var Data:Boolean):PChar;
begin
 Result:=ScanVar(svMode,Str,KeyFmt(Key,'%b'),Data);
end;

function ScanVarWord(svMode:Cardinal; Str:PChar; const Key:LongString; var Data:Word):PChar;
begin
 Result:=ScanVar(svMode,Str,KeyFmt(Key,'%w'),Data);
end;

function ScanVarInteger(svMode:Cardinal; Str:PChar; const Key:LongString; var Data:Integer):PChar;
begin
 Result:=ScanVar(svMode,Str,KeyFmt(Key,'%i'),Data);
end;

function ScanVarLongInt(svMode:Cardinal; Str:PChar; const Key:LongString; var Data:LongInt):PChar;
begin
 Result:=ScanVar(svMode,Str,KeyFmt(Key,'%d'),Data);
end;

function ScanVarDouble(svMode:Cardinal; Str:PChar; const Key:LongString; var Data:Double):PChar;
begin
 Result:=ScanVar(svMode,Str,KeyFmt(Key,'%f'),Data);
end;

function ScanVarAlpha(svMode:Cardinal; Str:PChar; const Key:LongString; var Data:PureString):PChar;
begin
 Result:=ScanVar(svMode,Str,KeyFmt(Key,'%a'),Data);
end;

function ScanVarAlpha(svMode:Cardinal; Str:PChar; const Key:LongString; var Data:LongString):PChar;
var s:PureString;
begin
 s:=Data;
 Result:=ScanVar(svMode,Str,KeyFmt(Key,'%a'),s);
 if Assigned(Result) then Data:=s;
end;

function ScanVarString(svMode:Cardinal; Str:PChar; const Key:LongString; var Data:PureString):PChar;
begin
 Result:=ScanVar(svMode,Str,KeyFmt(Key,'%s'),Data);
end;

function ScanVarString(svMode:Cardinal; Str:PChar; const Key:LongString; var Data:LongString):PChar;
var s:PureString;
begin
 s:=Data;
 Result:=ScanVar(svMode,Str,KeyFmt(Key,'%s'),s);
 if Assigned(Result) then Data:=s;
end;

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

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

function CookieScanAlter(const Buff,Items:LongString; Mode:Integer=csm_Default):LongString;
const Delims=EolnDelims+[';',','];
var i:Integer; Item:LongString;
begin
 Result:='';
 if (Buff<>'') and (Items<>'') then
 try
  for i:=1 to WordCount(Items,Delims) do begin
   Item:=Trim(ExtractWord(i,Items,Delims));
   if IsEmptyStr(Item) then Continue;
   Result:=CookieScan(Buff,Item,Mode);
   if (Result<>'') then Break;
  end;
 except
  on E:Exception do BugReport(E,nil,'CookieScanAlter');
 end;
end;

function coupIter(n:SizeInt; Line:LongString; Custom:Pointer):Boolean;
var Lines:TStringList absolute Custom;
var sn,sv:LongString; i:Integer;
begin
 Result:=True; sn:=''; sv:='';
 if not Assigned(Lines) then Exit(False);
 if (ExtractNameValuePair(Line,sn,sv)>0) then begin
  if (sn<>'') then begin
   if (sv<>'') then begin
    Lines.Values[sn]:=sv;
   end else begin
    i:=Lines.IndexOfName(sn);
    if (i>=0) then Lines.Delete(i);
   end;
  end;
 end;
end;

procedure CookListUpdate(Cook:LongString; Sep:Char; Lines:TStringList);
begin
 if (Cook='') or (Lines=nil) then Exit;
 if (Sep<>#0) then Cook:=StringReplace(Cook,Sep,EOL,[rfReplaceAll]);
 ForEachStringLine(Cook,coupIter,Lines);
end;

function CookieUpdate(const Buff,Items:LongString; Mode:Integer=csm_Default):LongString;
var Lines:TStringList; Sep:Char;
begin
 Result:=Buff;
 if (Items<>'') then
 try
  Lines:=TStringList.Create;
  try
   Sep:=Chr(Mode);
   Lines.Sorted:=False;
   Lines.UseLocale:=False;
   Lines.CaseSensitive:=HasFlags(Mode,csm_CaseSense);
   CookListUpdate(Buff,Sep,Lines);
   CookListUpdate(Items,Sep,Lines);
   Result:=Lines.Text;
   if (Sep<>#0) then Result:=StringReplace(Result,EOL,Sep,[rfReplaceAll]);
  finally
   Kill(Lines);
  end;
 except
  on E:Exception do BugReport(E,nil,'CookieUpdate');
 end;
end;

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

function  IsNonEmptyStr(const S:LongString):Boolean;
var i:SizeInt;
begin
 if (S<>'') then for i:=1 to Length(S) do if (S[i]>' ') then Exit(true);
 Result:=false;
end;

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

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

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

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

function CountChars(const S:LongString; const C:TCharSet):SizeInt;
var i:SizeInt;
begin
 Result:=0;
 for i:=1 to Length(S) do if (S[i] in C) then Inc(Result);
end;

function CountChars(const S:LongString; const C:LongString):SizeInt;
begin
 Result:=CountChars(S,StringToSetOfChars(C));
end;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

function ExtractDllBaseName(const FileName:LongString):LongString;
const libPrefix='lib'; var Base,Ext:LongString;
begin
 Ext:=ExtractFileExt(FileName);
 Base:=ExtractBaseName(FileName);
 if IsSameText(Ext,'.so') then begin
  if SameText(libPrefix,Copy(Base,1,Length(libPrefix)))
  then Delete(Base,1,Length(libPrefix));
 end;
 Result:=Base;
end;

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

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

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

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

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

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

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

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

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

function AdaptFileName(const FileName:LongString; Mode:Integer=afnm_Def):LongString;
const dup=LongString(PathDelim)+PathDelim;
begin
 Result:=FileName;
 // Apply Trim
 if HasFlags(Mode,afnm_Trim) then Result:=Trim(Result);
 if (Result='') then Exit;
 // Validate drive (drop C:) on Unix
 if IsUnix and HasFlags(Mode,afnm_Drive) then begin
  if (StrFetch(Result,2)=':') and (StrFetch(Result,1) in ['a'..'z','A'..'Z'])
  then System.Delete(Result,1,2);
  if (Result='') then Exit;
 end;
 // Validate char case - LowerCase on Unix
 if IsUnix and HasFlags(Mode,afnm_Lower) then begin
  if HasFlags(Mode,afnm_Utf8) and utf8_valid(Result)
  then Result:=utf8_lowercase(Result)
  else Result:=LowerCase(Result);
 end;
 // Validate directory separators ['\','/'].
 if HasFlags(Mode,afnm_Delim) then begin
  if (PathDelim<>'\') and HasChars(Result,['\'])
  then Result:=StringReplace(Result,'\',PathDelim,[rfReplaceAll]);
  if (PathDelim<>'/') and HasChars(Result,['/'])
  then Result:=StringReplace(Result,'/',PathDelim,[rfReplaceAll]);
  // Drop dublicates like //
  if HasFlags(Mode,afnm_NoDup) and (Pos(dup,Result)>0)
  then Result:=StringReplace(Result,dup,PathDelim,[rfReplaceAll]);
 end;
end;

function AdaptExeFileName(const FileName:LongString; Mode:Integer=afnm_Def):LongString;
var Ext:LongString;
begin
 Result:=AdaptFileName(FileName,Mode);
 if IsUnix and (Result<>'') then begin
  if HasExtension(Result) then begin
   Ext:=ExtractFileExt(Result);
   if SameText(Ext,'.bat') then Result:=ForceExtension(Result,'.sh');
   if SameText(Ext,'.cmd') then Result:=ForceExtension(Result,'.sh');
   if SameText(Ext,'.exe') then Result:=ForceExtension(Result,'');
  end;
 end;
 if IsWindows and (Result<>'') then begin
  if HasExtension(Result) then begin
   Ext:=ExtractFileExt(Result);
   if SameText(Ext,'.sh') then Result:=ForceExtension(Result,'.cmd');
   if SameText(Ext,'.bash') then Result:=ForceExtension(Result,'.cmd');
  end else
  Result:=DefaultExtension(Result,'.exe');
 end;
end;

function AdaptDllFileName(const FileName:LongString; Mode:Integer=afnm_Def):LongString;
var Dir,Base,Ext:LongString;
begin
 Result:=AdaptFileName(FileName,Mode);
 if IsUnix and (Result<>'') then begin
  if HasExtension(Result) then begin
   Ext:=ExtractFileExt(Result);
   if SameText(Ext,'.dll') then Result:=ForceExtension(Result,'.so');
  end else
  Result:=DefaultExtension(Result,'.so');
  if HasFlags(Mode,afnm_LibSo) then begin
   Base:=ExtractBaseName(Result);
   if not SameText(Copy(Base,1,3),'lib') then begin
    Dir:=ExtractFileDir(Result);
    Ext:=ExtractFileExt(Result);
    Result:='lib'+Base+Ext;
    if (Dir<>'') then Result:=AddPathDelim(Dir)+Result;
   end;
  end;
 end;
 if IsWindows and (Result<>'') then begin
  if HasExtension(Result) then begin
   Ext:=ExtractFileExt(Result);
   if SameText(Ext,'.so') then Result:=ForceExtension(Result,'.dll');
  end else
  Result:=DefaultExtension(Result,'.dll');
  if SameText(ExtractFileExt(FileName),'.so') then
  if HasFlags(Mode,afnm_LibSo) then begin
   Base:=ExtractBaseName(Result);
   if SameText(Copy(Base,1,3),'lib') then begin
    Dir:=ExtractFileDir(Result);
    Ext:=ExtractFileExt(Result);
    Result:=Copy(Base,4,Length(Base)-3)+Ext;
    if (Dir<>'') then Result:=AddPathDelim(Dir)+Result;
   end;
  end;
 end;
end;

function AdaptLnkFileName(const FileName:LongString; Mode:Integer=afnm_Def):LongString;
var Ext:LongString;
begin
 Result:=AdaptFileName(FileName,Mode);
 if IsUnix and (Result<>'') then begin
  if HasExtension(Result) then begin
   Ext:=ExtractFileExt(Result);
   if SameText(Ext,'.lnk') then Result:=ForceExtension(Result,'.desktop');
  end else
  Result:=DefaultExtension(Result,'.desktop');
 end;
 if IsWindows and (Result<>'') then begin
  if HasExtension(Result) then begin
   Ext:=ExtractFileExt(Result);
   if SameText(Ext,'.desktop') then Result:=ForceExtension(Result,'.lnk');
  end else
  Result:=DefaultExtension(Result,'.lnk');
 end;
end;

function StartsWithTildeDir(const S:LongString):Boolean;
begin
 Result:=(StrFetch(S,1)='~') and (StrFetch(S,2) in ['\','/']);
end;

function ReplaceTildeDir(const S,Dir:LongString):LongString;
begin
 if StartsWithTildeDir(S) and (Dir<>'')
 then Result:=AddPathDelim(Dir)+Copy(S,3,Length(S)-2)
 else Result:=S;
end;

function StartsWithTwinTildeDir(const S:LongString):Boolean;
begin
 Result:=(StrFetch(S,1)='~') and (StrFetch(S,2)='~') and (StrFetch(S,3) in ['\','/']);
end;

function ReplaceTwinTildeDir(const S,Dir:LongString):LongString;
begin
 if StartsWithTwinTildeDir(S) and (Dir<>'')
 then Result:=AddPathDelim(Dir)+Copy(S,4,Length(S)-3)
 else Result:=S;
end;

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

function CalcStringMem(const S:LongString):SizeInt; inline;
begin
 if (S='') then Result:=0 else Result:=Length(S);
end;

 {
 *****************************************************
 TText, collection of strings. Thread safe and simple.
 *****************************************************
 }
constructor TText.Create(aCapacity : LongInt = DefaultTTextCapacity;
                         aStep     : LongInt = DefaultTTextStep);
begin
 inherited Create;
 myStep:=Max(1,aStep);
 myLines:=TStringList.Create;
 EnsureCapacity(aCapacity);
end;

destructor TText.Destroy;
begin
 Lock;
 try
  Kill(myLines);
 finally
  Unlock;
 end;
 inherited Destroy;
end;

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

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

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

procedure TText.SetCount(NewCount:LongInt);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myLines) then begin
    NewCount:=Max(0,NewCount);
    if (NewCount=0) then myLines.Clear;
    if (NewCount>0) then EnsureCapacity(NewCount);
    while (myLines.Count<NewCount) do myLines.Add('');
    while (myLines.Count>NewCount) do myLines.Delete(myLines.Count-1);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorReport(E,'SetCount');
 end;
end;

function TText.GetCapacity:LongInt;
begin
 Result:=0;
 if Assigned(Self) then begin
  Lock;
  try
   if Assigned(myLines) then begin
    Result:=myLines.Capacity;
   end;
  finally
   Unlock;
  end;
 end;
end;

procedure TText.SetCapacity(NewCapacity:LongInt);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myLines) then begin
    NewCapacity:=Max(NewCapacity,0);
    if (NewCapacity<>myLines.Capacity)
    then myLines.Capacity:=NewCapacity;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorReport(E,'SetCapacity');
 end;
end;

procedure TText.EnsureCapacity(NewCapacity:LongInt);
var Cap:LongInt;
begin
 if Assigned(Self) and Assigned(myLines) then
 if (NewCapacity>myLines.Capacity) then begin
  Cap:=LeastPowerOfTwo(AdjustBufferSize(NewCapacity,myStep));
  if (Cap>myLines.Capacity) then myLines.Capacity:=Cap;
 end;
end;

function TText.GetLn( NumLn:LongInt ): LongString;
begin
 Result:='';
 if Assigned(Self) then begin
  Lock;
  try
   if Assigned(myLines) then begin
    if (NumLn>=0) and (NumLn<myLines.Count)
    then Result:=myLines.Strings[NumLn];
   end;
  finally
   Unlock;
  end;
 end;
end;

procedure TText.PutLn( NumLn:LongInt; const aLine: LongString );
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myLines) then begin
    EnsureCapacity(myLines.Count+1);
    if (NumLn=myLines.Count) then myLines.Add(aLine) else
    if (NumLn>=0) and (NumLn<myLines.Count)
    then myLines.Strings[NumLn]:=aLine;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorReport(E,'PutLn');
 end;
end;

procedure TText.DelLn( NumLn:LongInt );
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myLines) then begin
    if (NumLn>=0) and (NumLn<myLines.Count)
    then myLines.Delete(NumLn);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorReport(E,'DelLn');
 end;
end;

procedure TText.InsLn( NumLn:LongInt; const aLine: LongString);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myLines) then begin
    EnsureCapacity(myLines.Count+1);
    if (NumLn>=0) and (NumLn<=myLines.Count)
    then myLines.Insert(NumLn,aLine);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorReport(E,'InsLn');
 end;
end;

procedure TText.AddLn( const aLine: LongString );
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myLines) then begin
    EnsureCapacity(myLines.Count+1);
    myLines.Add(aLine);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorReport(E,'AddLn');
 end;
end;

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

procedure AddLineLengthMax(Index:LongInt; const TextLine:LongString;
                  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:LongString;
                 var Terminate:Boolean; CustomData:Pointer);
begin
 if TextLine<>''  then inc(LongInt(CustomData^),CalcStringMem(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:LongString;
                 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;

function TText.GetText:LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myLines) then begin
    Result:=myLines.Text;
   end;
  finally
   UnLock;
  end;
 except
  on E:Exception do ErrorReport(E,'GetText');
 end;
end;

procedure TText.SetText(const aText:LongString);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myLines) then begin
    if (aText='') then myLines.Clear else
    myLines.Text:=AdjustLineBreaks(aText);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorReport(E,'SetText');
 end;
end;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

procedure FindVarLine(Index:LongInt; const TextLine:LongString;
                  var Terminate:Boolean; CustomData:Pointer);
var sn,sv:Longstring;
begin
 if (TFindVarRec(CustomData^).VarName='') then Exit;
 if (ExtractNameValuePair(TextLine,sn,sv)<=0) then Exit;
 if (sn='') or not SameText(TFindVarRec(CustomData^).VarName,sn) then Exit;
 TFindVarRec(CustomData^).Index:=Index;
 Terminate:=true;
end;

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

function    TText.GetVar(const VarName:LongString):LongString;
var i:LongInt; sn,sv:LongString;
begin
 Result:='';
 if Assigned(Self) and IsNonEmptyStr(VarName) then
 try
  Lock;
  try
   i:=FindVar(VarName);
   if (i>=0) and (ExtractNameValuePair(Line[i],sn,sv)>0)
   then Result:=sv;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorReport(E,'GetVar');
 end;
end;

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

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

function ConcatText_Iterator(n:SizeInt; Line:LongString; Custom:Pointer):Boolean;
begin
 Result:=true;
 TText(Custom).AddLn(Line);
end;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

function FpcRunErrorCodeToString(ErrorCode:Integer):LongString;
begin
 Result:=sysconst.GetRunError(ErrorCode);
end;

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

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

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

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

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

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

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

procedure Free_crw_str;
begin
 ResourceLeakageLog(Format('%-60s = %d%s',['ScanVarKeyFmtErrors',ScanVarKeyFmtErrors,ScanVarKeyFmtBugs]));
end;

initialization

 Init_crw_str;

finalization

 Free_crw_str;

end.

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

