{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL)                                                                  }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is JclStrings.pas.                                                             }
{                                                                                                  }
{ The Initial Developer of the Original Code is Marcel van Brakel.                                 }
{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All rights reserved.  }
{                                                                                                  }
{ Contributor(s):                                                                                  }
{   Alexander Radchenko                                                                            }
{   Andreas Hausladen (ahuser)                                                                     }
{   Anthony Steele                                                                                 }
{   Azret Botash                                                                                   }
{   Barry Kelly                                                                                    }
{   Huanlin Tsai                                                                                   }
{   Jack N.A. Bakker                                                                               }
{   Jean-Fabien Connault (cycocrew)                                                                }
{   John C Molyneux                                                                                }
{   Leonard Wennekers                                                                              }
{   Marcel Bestebroer                                                                              }
{   Martin Kimmings                                                                                }
{   Martin Kubecka                                                                                 }
{   Massimo Maria Ghisalberti                                                                      }
{   Matthias Thoma (mthoma)                                                                        }
{   Michael Winter                                                                                 }
{   Nick Hodges                                                                                    }
{   Olivier Sannier (obones)                                                                       }
{   Pelle F. S. Liljendal                                                                          }
{   Petr Vones (pvones)                                                                            }
{   Rik Barker (rikbarker)                                                                         }
{   Robert Lee                                                                                     }
{   Robert Marquardt (marquardt)                                                                   }
{   Robert Rossmair (rrossmair)                                                                    }
{   Andreas Schmidt                                                                                }
{   Sean Farrow (sfarrow)                                                                          }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ Various character and string routines (searching, testing and transforming)                      }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ Last modified: $Date:: 2009-01-07 20:12:30 +0100 (mer., 07 janv. 2009)                         $ }
{ Revision:      $Rev:: 2582                                                                     $ }
{ Author:        $Author:: ahuser                                                                $ }
{                                                                                                  }
{**************************************************************************************************}

unit JclStrings;

{$I jcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF MSWINDOWS}
  Classes, SysUtils,
  {$IFDEF CLR}
  System.Text,
  System.IO,
  {$ELSE}
  JclAnsiStrings,
  JclWideStrings,
  {$ENDIF CLR}
  JclBase, JclSysUtils;

// Exceptions
type
  EJclStringError = EJclError;

// Character constants and sets

const
  // Misc. often used character definitions
  NativeNull = Char(#0);
  NativeSoh = Char(#1);
  NativeStx = Char(#2);
  NativeEtx = Char(#3);
  NativeEot = Char(#4);
  NativeEnq = Char(#5);
  NativeAck = Char(#6);
  NativeBell = Char(#7);
  NativeBackspace = Char(#8);
  NativeTab = Char(#9);
  NativeLineFeed = JclBase.NativeLineFeed;
  NativeVerticalTab = Char(#11);
  NativeFormFeed = Char(#12);
  NativeCarriageReturn = JclBase.NativeCarriageReturn;
  NativeCrLf = JclBase.NativeCrLf;
  NativeSo = Char(#14);
  NativeSi = Char(#15);
  NativeDle = Char(#16);
  NativeDc1 = Char(#17);
  NativeDc2 = Char(#18);
  NativeDc3 = Char(#19);
  NativeDc4 = Char(#20);
  NativeNak = Char(#21);
  NativeSyn = Char(#22);
  NativeEtb = Char(#23);
  NativeCan = Char(#24);
  NativeEm = Char(#25);
  NativeEndOfFile = Char(#26);
  NativeEscape = Char(#27);
  NativeFs = Char(#28);
  NativeGs = Char(#29);
  NativeRs = Char(#30);
  NativeUs = Char(#31);
  NativeSpace = Char(' ');
  NativeComma = Char(',');
  NativeBackslash = Char('\');
  NativeForwardSlash = Char('/');

  NativeDoubleQuote = Char('"');
  NativeSingleQuote = Char('''');

  NativeLineBreak = JclBase.NativeLineBreak;

const
  // CharType return values
  C1_UPPER = $0001; // Uppercase
  C1_LOWER = $0002; // Lowercase
  C1_DIGIT = $0004; // Decimal digits
  C1_SPACE = $0008; // Space characters
  C1_PUNCT = $0010; // Punctuation
  C1_CNTRL = $0020; // Control characters
  C1_BLANK = $0040; // Blank characters
  C1_XDIGIT = $0080; // Hexadecimal digits
  C1_ALPHA = $0100; // Any linguistic character: alphabetic, syllabary, or ideographic

  {$IFDEF MSWINDOWS}
  {$IFDEF SUPPORTS_EXTSYM}
  {$EXTERNALSYM C1_UPPER}
  {$EXTERNALSYM C1_LOWER}
  {$EXTERNALSYM C1_DIGIT}
  {$EXTERNALSYM C1_SPACE}
  {$EXTERNALSYM C1_PUNCT}
  {$EXTERNALSYM C1_CNTRL}
  {$EXTERNALSYM C1_BLANK}
  {$EXTERNALSYM C1_XDIGIT}
  {$EXTERNALSYM C1_ALPHA}
  {$ENDIF SUPPORTS_EXTSYM}
  {$ENDIF MSWINDOWS}

type
  TCharValidator = function(const C: Char): Boolean;

function ArrayContainsChar(const Chars: array of Char; const C: Char): Boolean;

// String Test Routines
function StrIsAlpha(const S: string): Boolean;
function StrIsAlphaNum(const S: string): Boolean;
function StrIsAlphaNumUnderscore(const S: string): Boolean;
function StrContainsChars(const S: string; const Chars: TCharValidator; CheckAll: Boolean): Boolean; overload;
function StrContainsChars(const S: string; const Chars: array of Char; CheckAll: Boolean): Boolean; overload;
function StrConsistsOfNumberChars(const S: string): Boolean;
function StrIsDigit(const S: string): Boolean;
function StrIsSubset(const S: string; const ValidChars: TCharValidator): Boolean; overload;
function StrIsSubset(const S: string; const ValidChars: array of Char): Boolean; overload;
function StrSame(const S1, S2: string): Boolean;

// String Transformation Routines
function StrCenter(const S: string; L: Integer; C: Char = ' '): string;
function StrCharPosLower(const S: string; CharPos: Integer): string;
function StrCharPosUpper(const S: string; CharPos: Integer): string;
function StrDoubleQuote(const S: string): string;
function StrEnsureNoPrefix(const Prefix, Text: string): string;
function StrEnsureNoSuffix(const Suffix, Text: string): string;
function StrEnsurePrefix(const Prefix, Text: string): string;
function StrEnsureSuffix(const Suffix, Text: string): string;
function StrEscapedToString(const S: string): string;
function StrLower(const S: string): string;
procedure StrLowerInPlace(var S: string);
{$IFNDEF CLR}
procedure StrLowerBuff(S: PChar);
{$ENDIF ~CLR}
procedure StrMove(var Dest: string; const Source: string; const ToIndex,
  FromIndex, Count: Integer);
function StrPadLeft(const S: string; Len: Integer; C: Char = NativeSpace): string;
function StrPadRight(const S: string; Len: Integer; C: Char = NativeSpace): string;
function StrProper(const S: string): string;
{$IFNDEF CLR}
procedure StrProperBuff(S: PChar);
{$ENDIF ~CLR}
function StrQuote(const S: string; C: Char): string;
function StrRemoveChars(const S: string; const Chars: TCharValidator): string; overload;
function StrRemoveChars(const S: string; const Chars: array of Char): string; overload;
function StrRemoveEndChars(const S: string; const Chars: TCharValidator): string; overload;
function StrRemoveEndChars(const S: string; const Chars: array of Char): string; overload;
function StrKeepChars(const S: string; const Chars: TCharValidator): string; overload;
function StrKeepChars(const S: string; const Chars: array of Char): string; overload;
procedure StrReplace(var S: string; const Search, Replace: string; Flags: TReplaceFlags = []);
function StrReplaceChar(const S: string; const Source, Replace: Char): string;
function StrReplaceChars(const S: string; const Chars: TCharValidator; Replace: Char): string; overload;
function StrReplaceChars(const S: string; const Chars: array of Char; Replace: Char): string; overload;
function StrReplaceButChars(const S: string; const Chars: TCharValidator; Replace: Char): string; overload;
function StrReplaceButChars(const S: string; const Chars: array of Char; Replace: Char): string; overload;
function StrRepeat(const S: string; Count: Integer): string;
function StrRepeatLength(const S: string; L: Integer): string;
function StrReverse(const S: string): string;
procedure StrReverseInPlace(var S: string);
function StrSingleQuote(const S: string): string;
function StrSmartCase(const S: string; const Delimiters: TCharValidator): string; overload;
function StrSmartCase(const S: string; const Delimiters: array of Char): string; overload;
function StrStringToEscaped(const S: string): string;
function StrStripNonNumberChars(const S: string): string;
function StrToHex(const Source: string): string;
function StrTrimCharLeft(const S: string; C: Char): string;
function StrTrimCharsLeft(const S: string; const Chars: TCharValidator): string; overload;
function StrTrimCharsLeft(const S: string; const Chars: array of Char): string; overload;
function StrTrimCharRight(const S: string; C: Char): string;
function StrTrimCharsRight(const S: string; const Chars: TCharValidator): string; overload;
function StrTrimCharsRight(const S: string; const Chars: array of Char): string; overload;
function StrTrimQuotes(const S: string): string;
function StrUpper(const S: string): string;
procedure StrUpperInPlace(var S: string);
{$IFNDEF CLR}
procedure StrUpperBuff(S: PChar);
{$ENDIF ~CLR}

{$IFNDEF CLR}
{$IFNDEF SUPPORTS_UNICODE}
{$IFDEF KEEP_DEPRECATED}
// String Management
procedure StrAddRef(var S: string); {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF}
function StrAllocSize(const S: string): Longint; {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF}
procedure StrDecRef(var S: string); {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF}
function StrLength(const S: string): Longint; {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF}
function StrRefCount(const S: string): Longint; {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF}
{$ENDIF KEEP_DEPRECATED}
{$ENDIF ~SUPPORTS_UNICODE}

{$ENDIF ~CLR}

// String Search and Replace Routines
function StrCharCount(const S: string; C: Char): Integer; overload;
function StrCharsCount(const S: string; const Chars: TCharValidator): Integer; overload;
function StrCharsCount(const S: string; const Chars: array of Char): Integer; overload;
function StrStrCount(const S, SubS: string): Integer;
function StrCompare(const S1, S2: string): Integer;
function StrCompareRange(const S1, S2: string; const Index, Count: Integer): Integer;
{$IFNDEF CLR}
procedure StrFillChar(var S; Count: Integer; C: Char);
{$ENDIF ~CLR}
function StrRepeatChar(C: Char; Count: Integer): string;
function StrFind(const Substr, S: string; const Index: Integer = 1): Integer;
function StrHasPrefix(const S: string; const Prefixes: array of string): Boolean;
function StrIndex(const S: string; const List: array of string): Integer;
function StrILastPos(const SubStr, S: string): Integer;
function StrIPos(const SubStr, S: string): Integer;
function StrIsOneOf(const S: string; const List: array of string): Boolean;
function StrLastPos(const SubStr, S: string): Integer;
function StrMatch(const Substr, S: string; const Index: Integer = 1): Integer;
function StrMatches(const Substr, S: string; const Index: Integer = 1): Boolean;
function StrNIPos(const S, SubStr: string; N: Integer): Integer;
function StrNPos(const S, SubStr: string; N: Integer): Integer;
function StrPrefixIndex(const S: string; const Prefixes: array of string): Integer;
function StrSearch(const Substr, S: string; const Index: Integer = 1): Integer;

// String Extraction
function StrAfter(const SubStr, S: string): string;
function StrBefore(const SubStr, S: string): string;
function StrBetween(const S: string; const Start, Stop: Char): string;
function StrChopRight(const S: string; N: Integer): string;
function StrLeft(const S: string; Count: Integer): string;
function StrMid(const S: string; Start, Count: Integer): string;
function StrRestOf(const S: string; N: Integer): string;
function StrRight(const S: string; Count: Integer): string;

// Character Test Routines
function CharEqualNoCase(const C1, C2: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function CharIsAlpha(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function CharIsAlphaNum(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function CharIsBlank(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function CharIsControl(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function CharIsDelete(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function CharIsDigit(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function CharIsFracDigit(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function CharIsHexDigit(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function CharIsLower(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function CharIsNumberChar(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function CharIsNumber(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function CharIsPrintable(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function CharIsPunctuation(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function CharIsReturn(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function CharIsSpace(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function CharIsUpper(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function CharIsValidIdentifierLetter(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function CharIsWhiteSpace(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function CharIsWildcard(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
{$IFNDEF CLR}
function CharType(const C: Char): Word;
{$ENDIF ~CLR}

// Character Transformation Routines
function CharHex(const C: Char): Byte;
function CharLower(const C: Char): Char; {$IFDEF CLR} inline; {$ENDIF}
function CharUpper(const C: Char): Char; {$IFDEF CLR} inline; {$ENDIF}
function CharToggleCase(const C: Char): Char;

// Character Search and Replace
function CharPos(const S: string; const C: Char; const Index: Integer = 1): Integer;
function CharLastPos(const S: string; const C: Char; const Index: Integer = 1): Integer;
function CharIPos(const S: string; C: Char; const Index: Integer = 1): Integer;
function CharReplace(var S: string; const Search, Replace: Char): Integer;

{$IFNDEF CLR}
// PCharVector
type
  PCharVector = ^PChar;

function StringsToPCharVector(var Dest: PCharVector; const Source: TStrings): PCharVector;
function PCharVectorCount(Source: PCharVector): Integer;
procedure PCharVectorToStrings(const Dest: TStrings; Source: PCharVector);
procedure FreePCharVector(var Dest: PCharVector);

// MultiSz Routines
type
  PMultiSz = PChar;
  PAnsiMultiSz = JclAnsiStrings.PMultiSz;
  PWideMultiSz = JclWideStrings.PMultiSz;

  TAnsiStrings = JclAnsiStrings.TAnsiStrings;
  TWideStrings = JclWideStrings.TWideStrings;
  TAnsiStringList = JclAnsiStrings.TAnsiStringList;
  TWideStringList = JclWideStrings.TWideStringList;

function StringsToMultiSz(var Dest: PMultiSz; const Source: TStrings): PMultiSz;
procedure MultiSzToStrings(const Dest: TStrings; const Source: PMultiSz);
function MultiSzLength(const Source: PMultiSz): Integer;
procedure AllocateMultiSz(var Dest: PMultiSz; Len: Integer);
procedure FreeMultiSz(var Dest: PMultiSz);
function MultiSzDup(const Source: PMultiSz): PMultiSz;

function AnsiStringsToAnsiMultiSz(var Dest: PAnsiMultiSz; const Source: TAnsiStrings): PAnsiMultiSz;
 {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
procedure AnsiMultiSzToAnsiStrings(const Dest: TAnsiStrings; const Source: PAnsiMultiSz); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function AnsiMultiSzLength(const Source: PAnsiMultiSz): Integer; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
procedure AllocateAnsiMultiSz(var Dest: PAnsiMultiSz; Len: Integer); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
procedure FreeAnsiMultiSz(var Dest: PAnsiMultiSz); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function AnsiMultiSzDup(const Source: PAnsiMultiSz): PAnsiMultiSz; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}

function WideStringsToWideMultiSz(var Dest: PWideMultiSz; const Source: TWideStrings): PWideMultiSz;
 {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
procedure WideMultiSzToWideStrings(const Dest: TWideStrings; const Source: PWideMultiSz); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function WideMultiSzLength(const Source: PWideMultiSz): Integer; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
procedure AllocateWideMultiSz(var Dest: PWideMultiSz; Len: Integer); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
procedure FreeWideMultiSz(var Dest: PWideMultiSz); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function WideMultiSzDup(const Source: PWideMultiSz): PWideMultiSz; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
{$ENDIF ~CLR}

// TStrings Manipulation
procedure StrIToStrings(S, Sep: string; const List: TStrings; const AllowEmptyString: Boolean = True);
procedure StrToStrings(S, Sep: string; const List: TStrings; const AllowEmptyString: Boolean = True);
function StringsToStr(const List: TStrings; const Sep: string; const AllowEmptyString: Boolean = True): string;
procedure TrimStrings(const List: TStrings; DeleteIfEmpty: Boolean = True);
procedure TrimStringsRight(const List: TStrings; DeleteIfEmpty: Boolean = True);
procedure TrimStringsLeft(const List: TStrings; DeleteIfEmpty: Boolean = True);
function AddStringToStrings(const S: string; Strings: TStrings; const Unique: Boolean): Boolean;

// Miscellaneous
{$IFDEF KEEP_DEPRECATED}
function BooleanToStr(B: Boolean): string;
{$ENDIF KEEP_DEPRECATED}
 // AnsiString here because it is binary data
function FileToString(const FileName: string): {$IFDEF COMPILER12_UP}RawByteString{$ELSE}AnsiString{$ENDIF};
procedure StringToFile(const FileName: string; const Contents: {$IFDEF COMPILER12_UP}RawByteString{$ELSE}AnsiString{$ENDIF};
  Append: Boolean = False);

function StrToken(var S: string; Separator: Char): string;
procedure StrTokens(const S: string; const List: TStrings);
procedure StrTokenToStrings(S: string; Separator: Char; const List: TStrings);
{$IFDEF CLR}
function StrWord(const S: string; var Index: Integer; out Word: string): Boolean;
{$ELSE}
function StrWord(var S: PChar; out Word: string): Boolean;
{$ENDIF CLR}
function StrToFloatSafe(const S: string): Float;
function StrToIntSafe(const S: string): Integer;
procedure StrNormIndex(const StrLen: Integer; var Index: Integer; var Count: Integer); overload;

{$IFDEF CLR}
function ArrayOf(List: TStrings): TDynStringArray; overload;
{$ENDIF CLR}

{$IFDEF COMPILER5} // missing Delphi 5 functions
function TryStrToInt(const S: string; out Value: Integer): Boolean;
function TryStrToInt64(const S: string; out Value: Int64): Boolean;
function TryStrToFloat(const S: string; out Value: Extended): Boolean; overload;
function TryStrToFloat(const S: string; out Value: Double): Boolean; overload;
function TryStrToFloat(const S: string; out Value: Single): Boolean; overload;
function TryStrToCurr(const S: string; out Value: Currency): Boolean;
{$ENDIF COMPILER5}


{$IFDEF CLR}
type
  TJclStringBuilder = System.Text.StringBuilder;
  TStringBuilder = TJclStringBuilder;

function DotNetFormat(const Fmt: string; const Args: array of System.Object): string; overload;
function DotNetFormat(const Fmt: string; const Arg0: System.Object): string; overload;
function DotNetFormat(const Fmt: string; const Arg0, Arg1: System.Object): string; overload;
function DotNetFormat(const Fmt: string; const Arg0, Arg1, Arg2: System.Object): string; overload;

{$ELSE ~CLR}

type
  FormatException = class(EJclError);
  ArgumentException = class(EJclError);
  ArgumentNullException = class(EJclError);
  ArgumentOutOfRangeException = class(EJclError);

  IToString = interface
    ['{C4ABABB4-1029-46E7-B5FA-99800F130C05}']
    function ToString: string;
  end;

  TCharDynArray = array of Char;

  // The TStringBuilder class is a Delphi implementation of the .NET
  // System.Text.StringBuilder.
  // It is zero based and the method that allow an TObject (Append, Insert,
  // AppendFormat) are limited to IToString implementors.
  // This class is not threadsafe. Any instance of TStringBuilder should not
  // be used in different threads at the same time.
  TJclStringBuilder = class(TInterfacedObject, IToString)
  private
    FChars: TCharDynArray;
    FLength: Integer;
    FMaxCapacity: Integer;

    function GetCapacity: Integer;
    procedure SetCapacity(const Value: Integer);
    function GetChars(Index: Integer): Char;
    procedure SetChars(Index: Integer; const Value: Char);
    procedure Set_Length(const Value: Integer);
  protected
    function AppendPChar(Value: PChar; Count: Integer; RepeatCount: Integer = 1): TJclStringBuilder;
    function InsertPChar(Index: Integer; Value: PChar; Count: Integer; RepeatCount: Integer = 1): TJclStringBuilder;
  public
    constructor Create(const Value: string; Capacity: Integer = 16); overload;
    constructor Create(Capacity: Integer = 16; MaxCapacity: Integer = MaxInt); overload;
    constructor Create(const Value: string; StartIndex, Length, Capacity: Integer); overload;

    function Append(const Value: string): TJclStringBuilder; overload;
    function Append(const Value: string; StartIndex, Length: Integer): TJclStringBuilder; overload;
    function Append(Value: Boolean): TJclStringBuilder; overload;
    function Append(Value: Char; RepeatCount: Integer = 1): TJclStringBuilder; overload;
    function Append(const Value: array of Char): TJclStringBuilder; overload;
    function Append(const Value: array of Char; StartIndex, Length: Integer): TJclStringBuilder; overload;
    function Append(Value: Cardinal): TJclStringBuilder; overload;
    function Append(Value: Integer): TJclStringBuilder; overload;
    function Append(Value: Double): TJclStringBuilder; overload;
    function Append(Value: Int64): TJclStringBuilder; overload;
    function Append(Obj: TObject): TJclStringBuilder; overload;
    function AppendFormat(const Fmt: string; const Args: array of const): TJclStringBuilder; overload;
    function AppendFormat(const Fmt: string; Arg0: Variant): TJclStringBuilder; overload;
    function AppendFormat(const Fmt: string; Arg0, Arg1: Variant): TJclStringBuilder; overload;
    function AppendFormat(const Fmt: string; Arg0, Arg1, Arg2: Variant): TJclStringBuilder; overload;

    function Insert(Index: Integer; const Value: string; Count: Integer = 1): TJclStringBuilder; overload;
    function Insert(Index: Integer; Value: Boolean): TJclStringBuilder; overload;
    function Insert(Index: Integer; const Value: array of Char): TJclStringBuilder; overload;
    function Insert(Index: Integer; const Value: array of Char; StartIndex, Length: Integer): TJclStringBuilder;
      overload;
    function Insert(Index: Integer; Value: Cardinal): TJclStringBuilder; overload;
    function Insert(Index: Integer; Value: Integer): TJclStringBuilder; overload;
    function Insert(Index: Integer; Value: Double): TJclStringBuilder; overload;
    function Insert(Index: Integer; Value: Int64): TJclStringBuilder; overload;
    function Insert(Index: Integer; Obj: TObject): TJclStringBuilder; overload;

    function Replace(OldChar, NewChar: Char; StartIndex: Integer = 0; Count: Integer = -1): TJclStringBuilder;
      overload;
    function Replace(OldValue, NewValue: string; StartIndex: Integer = 0; Count: Integer = -1): TJclStringBuilder;
      overload;

    function Remove(StartIndex, Length: Integer): TJclStringBuilder;
    function EnsureCapacity(Capacity: Integer): Integer;

    function ToString: string; {$IFDEF RTL200_UP} override; {$ENDIF RTL200_UP}

    property __Chars__[Index: Integer]: Char read GetChars write SetChars; default;
    property Chars: TCharDynArray read FChars;
    property Length: Integer read FLength write Set_Length;
    property Capacity: Integer read GetCapacity write SetCapacity;
    property MaxCapacity: Integer read FMaxCapacity;
  end;

  TStringBuilder = TJclStringBuilder;

// DotNetFormat() uses the .NET format style: "{argX}"
function DotNetFormat(const Fmt: string; const Args: array of const): string; overload;
function DotNetFormat(const Fmt: string; const Arg0: Variant): string; overload;
function DotNetFormat(const Fmt: string; const Arg0, Arg1: Variant): string; overload;
function DotNetFormat(const Fmt: string; const Arg0, Arg1, Arg2: Variant): string; overload;

// TJclTabSet
type
  TJclTabSet = class {$IFNDEF CLR}(TInterfacedObject, IToString){$ENDIF}
  private
    FStops: TDynIntegerArray;
    FRealWidth: Integer;
    FWidth: Integer;
    FZeroBased: Boolean;
    procedure CalcRealWidth;
    function GetCount: Integer;
    function GetStops(Index: Integer): Integer;
    function GetTabWidth: Integer;
    function GetZeroBased: Boolean;
    procedure SetStops(Index, Value: Integer);
    procedure SetTabWidth(Value: Integer);
    procedure SetZeroBased(Value: Boolean);
  protected
    function FindStop(Column: Integer): Integer;
    function InternalTabStops: TDynIntegerArray;
    function InternalTabWidth: Integer;
    procedure RemoveAt(Index: Integer);
  public
    constructor Create; overload;
    constructor Create(TabWidth: Integer); overload;
    constructor Create(const Tabstops: array of Integer; ZeroBased: Boolean); overload;
    constructor Create(const Tabstops: array of Integer; ZeroBased: Boolean; TabWidth: Integer); overload;

    // Tab stops manipulation
    function Add(Column: Integer): Integer;
    function Delete(Column: Integer): Integer;

    // Usage
    function Expand(const S: string): string; overload;
    function Expand(const S: string; Column: Integer): string; overload;
    procedure OptimalFillInfo(StartColumn, TargetColumn: Integer; out TabsNeeded, SpacesNeeded: Integer);
    function Optimize(const S: string): string; overload;
    function Optimize(const S: string; Column: Integer): string; overload;
    function StartColumn: Integer;
    function TabFrom(Column: Integer): Integer;
    function UpdatePosition(const S: string): Integer; overload;
    function UpdatePosition(const S: string; Column: Integer): Integer; overload;
    function UpdatePosition(const S: string; var Column, Line: Integer): Integer; overload;

    // Conversions
    function ToString: string; overload; {$IFDEF RTL200_UP} override; {$ENDIF RTL200_UP}
    function ToString(FormattingOptions: Integer): string; {$IFDEF RTL200_UP} reintroduce; {$ENDIF RTL200_UP} overload;
    class function FromString(const S: string): TJclTabSet; {$IFDEF SUPPORTS_STATIC} static; {$ENDIF SUPPORTS_STATIC}

    // Properties
    property ActualTabWidth: Integer read InternalTabWidth;
    property Count: Integer read GetCount;
    property TabStops[Index: Integer]: Integer read GetStops write SetStops; default;
    property TabWidth: Integer read GetTabWidth write SetTabWidth;
    property ZeroBased: Boolean read GetZeroBased write SetZeroBased;
  end;

// Formatting constants
const
  TabSetFormatting_SurroundStopsWithBrackets = 1;
  TabSetFormatting_EmptyBracketsIfNoStops = 2;
  TabSetFormatting_NoTabStops = 4;
  TabSetFormatting_NoTabWidth = 8;
  TabSetFormatting_AutoTabWidth = 16;
  // common combinations
  TabSetFormatting_Default = 0;
  TabSetFormatting_AlwaysUseBrackets = TabSetFormatting_SurroundStopsWithBrackets or
    TabSetFormatting_EmptyBracketsIfNoStops;
  TabSetFormatting_Full = TabSetFormatting_AlwaysUseBrackets or TabSetFormatting_AutoTabWidth;
  // aliases
  TabSetFormatting_StopsOnly = TabSetFormatting_NoTabWidth;
  TabSetFormatting_TabWidthOnly = TabSetFormatting_NoTabStops;
  TabSetFormatting_StopsWithoutBracketsAndTabWidth = TabSetFormatting_Default;

// Tab expansion routines
function StrExpandTabs(S: string): string; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF} overload;
function StrExpandTabs(S: string; TabWidth: Integer): string; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF} overload;
function StrExpandTabs(S: string; TabSet: TJclTabSet): string; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF} overload;
// Tab optimization routines
function StrOptimizeTabs(S: string): string; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF} overload;
function StrOptimizeTabs(S: string; TabWidth: Integer): string; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF} overload;
function StrOptimizeTabs(S: string; TabSet: TJclTabSet): string; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF} overload;

// move to JclBase?
type
  NullReferenceException = class(EJclError)
  public
    constructor Create; overload;
  end;

{$ENDIF ~CLR}

procedure StrResetLength(var S: WideString); overload;
procedure StrResetLength(var S: AnsiString); overload;
procedure StrResetLength(S: TJclStringBuilder); overload;
{$IFDEF SUPPORTS_UNICODE_STRING}
procedure StrResetLength(var S: UnicodeString); overload;
{$ENDIF SUPPORTS_UNICODE_STRING}

// natural comparison functions
function CompareNaturalStr(const S1, S2: string): Integer;
function CompareNaturalText(const S1, S2: string): Integer;

// internal structures published to make function inlining working
{$IFNDEF CLR}
const
  MaxStrCharCount = Ord(High(Char)) + 1;       // # of chars in one set
  StrLoOffset = MaxStrCharCount * 0;       // offset to lower case chars
  StrUpOffset = MaxStrCharCount * 1;       // offset to upper case chars
  StrReOffset = MaxStrCharCount * 2;       // offset to reverse case chars
  StrCaseMapSize = MaxStrCharCount * 3;       // # of chars is a table

var
  StrCaseMap: array [0..StrCaseMapSize - 1] of Char; // case mappings
  StrCaseMapReady: Boolean = False;         // true if case map exists
  StrCharTypes: array [Char] of Word;
{$ENDIF ~CLR}

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/source/common/JclStrings.pas $';
    Revision: '$Revision: 2582 $';
    Date: '$Date: 2009-01-07 20:12:30 +0100 (mer., 07 janv. 2009) $';
    LogPath: 'JCL\source\common'
    );
{$ENDIF UNITVERSIONING}

implementation

uses
  {$IFDEF CLR}
  System.Globalization,
  {$ENDIF CLR}
  {$IFDEF HAS_UNIT_LIBC}
  Libc,
  {$ENDIF HAS_UNIT_LIBC}
  {$IFDEF SUPPORTS_UNICODE}
  StrUtils,
  {$ENDIF SUPPORTS_UNICODE}
  JclLogic, JclResources, JclStreams;

//=== Internal ===============================================================

{$IFNDEF CLR}

{$IFNDEF SUPPORTS_UNICODE}
type
  TStrRec = packed record
    AllocSize: Longint;
    RefCount: Longint;
    Length: Longint;
  end;

const
  StrRecSize = SizeOf(TStrRec);           // size of the string header rec
  StrAllocOffset = 12;                        // offset to AllocSize in StrRec
  StrRefCountOffset = 8;                         // offset to RefCount in StrRec
  StrLengthOffset = 4;                         // offset to Length in StrRec
{$ENDIF ~SUPPORTS_UNICODE}

procedure LoadCharTypes;
var
  CurrChar: Char;
  CurrType: Word;
  {$IFDEF CLR}
  Category: System.Globalization.UnicodeCategory;
  {$ENDIF CLR}
begin
  for CurrChar := Low(CurrChar) to High(CurrChar) do
  begin
    {$IFDEF MSWINDOWS}
    GetStringTypeEx(LOCALE_USER_DEFAULT, CT_CTYPE1, @CurrChar, 1, CurrType);
    {$DEFINE CHAR_TYPES_INITIALIZED}
    {$ENDIF MSWINDOWS}
    {$IFDEF LINUX}
    CurrType := 0;
    if isupper(Byte(CurrChar)) <> 0 then
      CurrType := CurrType or C1_UPPER;
    if islower(Byte(CurrChar)) <> 0 then
      CurrType := CurrType or C1_LOWER;
    if isdigit(Byte(CurrChar)) <> 0 then
      CurrType := CurrType or C1_DIGIT;
    if isspace(Byte(CurrChar)) <> 0 then
      CurrType := CurrType or C1_SPACE;
    if ispunct(Byte(CurrChar)) <> 0 then
      CurrType := CurrType or C1_PUNCT;
    if iscntrl(Byte(CurrChar)) <> 0 then
      CurrType := CurrType or C1_CNTRL;
    if isblank(Byte(CurrChar)) <> 0 then
      CurrType := CurrType or C1_BLANK;
    if isxdigit(Byte(CurrChar)) <> 0 then
      CurrType := CurrType or C1_XDIGIT;
    if isalpha(Byte(CurrChar)) <> 0 then
      CurrType := CurrType or C1_ALPHA;
    {$DEFINE CHAR_TYPES_INITIALIZED}
    {$ENDIF LINUX}
    StrCharTypes[CurrChar] := CurrType;
    {$IFNDEF CHAR_TYPES_INITIALIZED}
    Implement case map initialization here
    {$ENDIF ~CHAR_TYPES_INITIALIZED}
  end;
end;

procedure LoadCaseMap;
var
  CurrChar, UpCaseChar, LoCaseChar, ReCaseChar: Char;
begin
  if not StrCaseMapReady then
  begin
    for CurrChar := Low(Char) to High(Char) do
    begin
      {$IFDEF MSWINDOWS}
      LoCaseChar := CurrChar;
      UpCaseChar := CurrChar;
      Windows.CharLowerBuff(@LoCaseChar, 1);
      Windows.CharUpperBuff(@UpCaseChar, 1);
      {$DEFINE CASE_MAP_INITIALIZED}
      {$ENDIF MSWINDOWS}
      {$IFDEF LINUX}
      LoCaseChar := Char(tolower(Byte(CurrChar)));
      UpCaseChar := Char(toupper(Byte(CurrChar)));
      {$DEFINE CASE_MAP_INITIALIZED}
      {$ENDIF LINUX}
      {$IFNDEF CASE_MAP_INITIALIZED}
      Implement case map initialization here
      {$ENDIF ~CASE_MAP_INITIALIZED}
      if CharIsUpper(CurrChar) then
        ReCaseChar := LoCaseChar
      else
      if CharIsLower(CurrChar) then
        ReCaseChar := UpCaseChar
      else
        ReCaseChar := CurrChar;
      StrCaseMap[Ord(CurrChar) + StrLoOffset] := LoCaseChar;
      StrCaseMap[Ord(CurrChar) + StrUpOffset] := UpCaseChar;
      StrCaseMap[Ord(CurrChar) + StrReOffset] := ReCaseChar;
    end;
    StrCaseMapReady := True;
  end;
end;
{$ENDIF ~CLR}

// Uppercases or Lowercases a give string depending on the
// passed offset. (UpOffset or LoOffset)

{$IFDEF CLR}
const
  StrLoOffset    = 0;
  StrUpOffset    = 1;

procedure StrCase(var Str: string; const Offset: Integer);
begin
  if Offset = StrUpOffset then
    Str := Str.ToUpper
  else
    Str := Str.ToLower;
end;
{$ELSE}
procedure StrCase(var Str: string; const Offset: Integer);
{$IFDEF SUPPORTS_UNICODE}
var
  Len: Integer;
  RetValue: string;
begin
  case Offset of
    StrUpOffset:
      begin
        Len := LCMapString(LOCALE_USER_DEFAULT, LCMAP_UPPERCASE, PChar(Str), Length(Str), nil, 0);
        SetLength(RetValue, Len);
        if Len > 0 then
          LCMapString(LOCALE_USER_DEFAULT, LCMAP_UPPERCASE, PChar(Str), Length(Str), PChar(RetValue), Len);
      end;
    StrLoOffset:
      begin
        Len := LCMapString(LOCALE_USER_DEFAULT, LCMAP_LOWERCASE, PChar(Str), Length(Str), nil, 0);
        SetLength(RetValue, Len);
        if Len > 0 then
          LCMapString(LOCALE_USER_DEFAULT, LCMAP_LOWERCASE, PChar(Str), Length(Str), PChar(RetValue), Len);
      end
  else
    Assert(False, 'StrReOffset not supported');
    Exit;
  end;
  Str := RetValue;
end;
{$ELSE}
asm
        // make sure that the string is not null

         TEST    EAX, EAX
         JZ      @@StrIsNull

        // create unique string if this one is ref-counted

         PUSH    EDX
         CALL    UniqueString
         POP     EDX

        // make sure that the new string is not null

         TEST    EAX, EAX
         JZ      @@StrIsNull

        // get the length, and prepare the counter

         MOV     ECX, [EAX - StrRecSize].TStrRec.Length
         DEC     ECX
         JS      @@StrIsNull

        // ebx will hold the case map, esi pointer to Str

         PUSH    EBX
         PUSH    ESI
         PUSH    EDI

        // load case map and prepare variables }

        {$IFDEF PIC}
        LEA     EBX, [EBX][STRCASEMAP + EDX]
        {$ELSE}
         LEA     EBX, [StrCaseMap + EDX]
        {$ENDIF PIC}
         MOV     ESI, EAX
         XOR     EDX, EDX
         XOR     EAX, EAX

         @@NextChar:
        // get current char from the string

         MOV     DL, [ESI]

        // get corresponding char from the case map

         MOV     AL, [EBX + EDX]

        // store it back in the string

         MOV     [ESI], AL

        // update the loop counter and check the end of stirng

         DEC     ECX
         JL      @@Done

        // do the same thing with next 3 chars

         MOV     DL, [ESI + 1]
         MOV     AL, [EBX + EDX]
         MOV     [ESI + 1], AL

         DEC     ECX
         JL      @@Done
         MOV     DL, [ESI + 2]
         MOV     AL, [EBX+EDX]
         MOV     [ESI + 2], AL

         DEC     ECX
         JL      @@Done
         MOV     DL, [ESI + 3]
         MOV     AL, [EBX + EDX]
         MOV     [ESI + 3], AL

        // point string to next 4 chars

         ADD     ESI, 4

        // update the loop counter and check the end of stirng

         DEC     ECX
         JGE     @@NextChar

         @@Done:
         POP     EDI
         POP     ESI
         POP     EBX

         @@StrIsNull:
end;
{$ENDIF SUPPORTS_UNICODE}
{$ENDIF CLR}

{$IFNDEF CLR}
// Internal utility function
// Uppercases or Lowercases a give null terminated string depending on the
// passed offset. (UpOffset or LoOffset)

procedure StrCaseBuff(S: PChar; const Offset: Integer);
{$IFDEF SUPPORTS_UNICODE}
var
  Len, SLen: Integer;
  RetValue: string;
begin
  if S <> nil then
  begin
    SLen := StrLen(S);
    case Offset of
      StrUpOffset:
        begin
          Len := LCMapString(LOCALE_USER_DEFAULT, LCMAP_UPPERCASE, S, SLen, nil, 0);
          SetLength(RetValue, Len);
          if Len > 0 then
            LCMapString(LOCALE_USER_DEFAULT, LCMAP_UPPERCASE, S, SLen, PChar(RetValue), Len);
        end;
      StrLoOffset:
        begin
          Len := LCMapString(LOCALE_USER_DEFAULT, LCMAP_LOWERCASE, S, SLen, nil, 0);
          SetLength(RetValue, Len);
          if Len > 0 then
            LCMapString(LOCALE_USER_DEFAULT, LCMAP_LOWERCASE, S, SLen, PChar(RetValue), Len);
        end
    else
      Assert(False, 'StrReOffset not supported');
      Exit;
    end;
    Move(PChar(RetValue)^, S^, Len * SizeOf(Char));
  end;
end;
{$ELSE}
asm
        // make sure the string is not null

         TEST    EAX, EAX
         JZ      @@StrIsNull

        // ebx will hold the case map, esi pointer to Str

         PUSH    EBX
         PUSH    ESI

        // load case map and prepare variables

        {$IFDEF PIC}
        LEA     EBX, [EBX][STRCASEMAP + EDX]
        {$ELSE}
         LEA     EBX, [StrCaseMap + EDX]
        {$ENDIF PIC}
         MOV     ESI, EAX
         XOR     EDX, EDX
         XOR     EAX, EAX

         @@NextChar:
        // get current char from the string

         MOV     DL, [ESI]

        // check for null char

         TEST    DL, DL
         JZ      @@Done

        // get corresponding char from the case map

         MOV     AL, [EBX + EDX]

        // store it back in the string

         MOV     [ESI], AL

        // do the same thing with next 3 chars

         MOV     DL, [ESI + 1]
         TEST    DL, DL
         JZ      @@Done
         MOV     AL, [EBX+EDX]
         MOV     [ESI + 1], AL

         MOV     DL, [ESI + 2]
         TEST    DL, DL
         JZ      @@Done
         MOV     AL, [EBX+EDX]
         MOV     [ESI + 2], AL

         MOV     DL, [ESI + 3]
         TEST    DL, DL
         JZ      @@Done
         MOV     AL, [EBX+EDX]
         MOV     [ESI + 3], AL

        // point string to next 4 chars

         ADD     ESI, 4
         JMP     @@NextChar

         @@Done:
         POP     ESI
         POP     EBX

         @@StrIsNull:
end;
{$ENDIF SUPPORTS_UNICODE}

function StrEndW(Str: PWideChar): PWideChar;
begin
  Result := Str;
  while Result^ <> #0 do
    Inc(Result);
end;
{$ENDIF ~CLR}

function ArrayContainsChar(const Chars: array of Char; const C: Char): Boolean;
{ optimized version for sorted arrays
var
  I, L, H: Integer;
begin
  L := Low(Chars);
  H := High(Chars);
  while L <= H do
  begin
    I := (L + H) div 2;
    if C = Chars[I] then
    begin
      Result := True;
      Exit;
    end
    else
    if C < Chars[I] then
      H := I - 1
    else
      // C > Chars[I]
      L := I + 1;
  end;
  Result := False;
end;}
var
  I: Integer;
begin
  Result := True;
  for I := Low(Chars) to High(Chars) do
    if Chars[I] = C then
      Exit;
  Result := False;
end;

// String Test Routines
function StrIsAlpha(const S: string): Boolean;
var
  I: Integer;
begin
  Result := S <> '';
  for I := 1 to Length(S) do
  begin
    if not CharIsAlpha(S[I]) then
    begin
      Result := False;
      Exit;
    end;
  end;
end;

function StrIsAlphaNum(const S: string): Boolean;
var
  I: Integer;
begin
  Result := S <> '';
  for I := 1 to Length(S) do
  begin
    if not CharIsAlphaNum(S[I]) then
    begin
      Result := False;
      Exit;
    end;
  end;
end;

function StrConsistsofNumberChars(const S: string): Boolean;
var
  I: Integer;
begin
  Result := S <> '';
  for I := 1 to Length(S) do
  begin
    if not CharIsNumberChar(S[I]) then
    begin
      Result := False;
      Exit;
    end;
  end;
end;

function StrContainsChars(const S: string; const Chars: TCharValidator; CheckAll: Boolean): Boolean;
var
  I: Integer;
begin
  Result := False;
  if CheckAll then
  begin
    for I := 1 to Length(S) do
    begin
      Result := Chars(S[I]);
      if not Result then
        Break;
    end;
  end
  else
  begin
    for I := 1 to Length(S) do
    begin
      Result := Chars(S[I]);
      if Result then
        Break;
    end;
  end;
end;

function StrContainsChars(const S: string; const Chars: array of Char; CheckAll: Boolean): Boolean;
var
  I: Integer;
begin
  Result := False;
  if CheckAll then
  begin
    for I := 1 to Length(S) do
    begin
      Result := ArrayContainsChar(Chars, S[I]);
      if not Result then
        Break;
    end;
  end
  else
  begin
    for I := 1 to Length(S) do
    begin
      Result := ArrayContainsChar(Chars, S[I]);
      if Result then
        Break;
    end;
  end;
end;

function StrIsAlphaNumUnderscore(const S: string): Boolean;
var
  I: Integer;
  C: Char;
begin
  for I := 1 to Length(S) do
  begin
    C := S[I];

    if not (CharIsAlphaNum(C) or (C = '_')) then
    begin
      Result := False;
      Exit;
    end;
  end;

  Result := Length(S) > 0;
end;

function StrIsDigit(const S: string): Boolean;
var
  I: Integer;
begin
  Result := S <> '';
  for I := 1 to Length(S) do
  begin
    if not CharIsDigit(S[I]) then
    begin
      Result := False;
      Exit;
    end;
  end;
end;

function StrIsSubset(const S: string; const ValidChars: TCharValidator): Boolean;
var
  I: Integer;
begin
  for I := 1 to Length(S) do
  begin
    Result := ValidChars(S[I]);
    if not Result then
      Exit;
  end;

  Result := Length(S) > 0;
end;

function StrIsSubset(const S: string; const ValidChars: array of Char): Boolean;
var
  I: Integer;
begin
  for I := 1 to Length(S) do
  begin
    Result := ArrayContainsChar(ValidChars, S[I]);
    if not Result then
      Exit;
  end;

  Result := Length(S) > 0;
end;

function StrSame(const S1, S2: string): Boolean;
begin
  Result := StrCompare(S1, S2) = 0;
end;

//=== String Transformation Routines =========================================

function StrCenter(const S: string; L: Integer; C: Char = ' '): string;
begin
  if Length(S) < L then
  begin
    Result := StringOfChar(C, (L - Length(S)) div 2) + S;
    Result := Result + StringOfChar(C, L - Length(Result));
  end
  else
    Result := S;
end;

function StrCharPosLower(const S: string; CharPos: Integer): string;
begin
  Result := S;
  if (CharPos > 0) and (CharPos <= Length(S)) then
    Result[CharPos] := CharLower(Result[CharPos]);
end;

function StrCharPosUpper(const S: string; CharPos: Integer): string;
begin
  Result := S;
  if (CharPos > 0) and (CharPos <= Length(S)) then
    Result[CharPos] := CharUpper(Result[CharPos]);
end;

function StrDoubleQuote(const S: string): string;
begin
  Result := NativeDoubleQuote + S + NativeDoubleQuote;
end;

function StrEnsureNoPrefix(const Prefix, Text: string): string;
var
  PrefixLen: Integer;
begin
  PrefixLen := Length(Prefix);
  if Copy(Text, 1, PrefixLen) = Prefix then
    Result := Copy(Text, PrefixLen + 1, Length(Text))
  else
    Result := Text;
end;

function StrEnsureNoSuffix(const Suffix, Text: string): string;
var
  SuffixLen: Integer;
  StrLength: Integer;
begin
  SuffixLen := Length(Suffix);
  StrLength := Length(Text);
  if Copy(Text, StrLength - SuffixLen + 1, SuffixLen) = Suffix then
    Result := Copy(Text, 1, StrLength - SuffixLen)
  else
    Result := Text;
end;

function StrEnsurePrefix(const Prefix, Text: string): string;
var
  PrefixLen: Integer;
begin
  PrefixLen := Length(Prefix);
  if Copy(Text, 1, PrefixLen) = Prefix then
    Result := Text
  else
    Result := Prefix + Text;
end;

function StrEnsureSuffix(const Suffix, Text: string): string;
var
  SuffixLen: Integer;
begin
  SuffixLen := Length(Suffix);
  if Copy(Text, Length(Text) - SuffixLen + 1, SuffixLen) = Suffix then
    Result := Text
  else
    Result := Text + Suffix;
end;

function StrEscapedToString(const S: string): string;
var
  I, Len: Integer;

  procedure HandleHexEscapeSeq;
  const
    HexDigits = string('0123456789abcdefABCDEF');
  var
    Val, N: Integer;
  begin
    N := Pos(S[I + 1], HexDigits) - 1;
    if N < 0 then
      // '\x' without hex digit following is not escape sequence
      Result := Result + '\x'
    else
    begin
      Inc(I); // Jump over x
      if N >= 16 then
        N := N - 6;
      Val := N;
      // Same for second digit
      if I < Len then
      begin
        N := Pos(S[I + 1], HexDigits) - 1;
        if N >= 0 then
        begin
          Inc(I); // Jump over first digit
          if N >= 16 then
            N := N - 6;
          Val := Val * 16 + N;
        end;
      end;

      if Val > Ord(High(Char)) then
        {$IFDEF CLR}
        raise EJclStringError.Create(RsNumericConstantTooLarge);
        {$ELSE}
        raise EJclStringError.CreateRes(@RsNumericConstantTooLarge);
        {$ENDIF CLR}

      Result := Result + Char(Val);
    end;
  end;

  procedure HandleOctEscapeSeq;
  const
    OctDigits = string('01234567');
  var
    Val, N: Integer;
  begin
    // first digit
    Val := Pos(S[I], OctDigits) - 1;
    if I < Len then
    begin
      N := Pos(S[I + 1], OctDigits) - 1;
      if N >= 0 then
      begin
        Inc(I);
        Val := Val * 8 + N;
      end;
      if I < Len then
      begin
        N := Pos(S[I + 1], OctDigits) - 1;
        if N >= 0 then
        begin
          Inc(I);
          Val := Val * 8 + N;
        end;
      end;
    end;

    if Val > Ord(High(Char)) then
      {$IFDEF CLR}
      raise EJclStringError.Create(RsNumericConstantTooLarge);
      {$ELSE}
      raise EJclStringError.CreateRes(@RsNumericConstantTooLarge);
      {$ENDIF CLR}

    Result := Result + Char(Val);
  end;

begin
  Result := '';
  I := 1;
  Len := Length(S);
  while I <= Len do
  begin
    if not ((S[I] = '\') and (I < Len)) then
      Result := Result + S[I]
    else
    begin
      Inc(I); // Jump over escape character
      case S[I] of
        'a':
          Result := Result + NativeBell;
        'b':
          Result := Result + NativeBackspace;
        'f':
          Result := Result + NativeFormFeed;
        'n':
          Result := Result + NativeLineFeed;
        'r':
          Result := Result + NativeCarriageReturn;
        't':
          Result := Result + NativeTab;
        'v':
          Result := Result + NativeVerticalTab;
        '\':
          Result := Result + '\';
        '"':
          Result := Result + '"';
        '''':
          Result := Result + ''''; // Optionally escaped
        '?':
          Result := Result + '?';  // Optionally escaped
        'x':
          if I < Len then
            // Start of hex escape sequence
            HandleHexEscapeSeq
          else
            // '\x' at end of string is not escape sequence
            Result := Result + '\x';
        '0'..'7':
          // start of octal escape sequence
          HandleOctEscapeSeq;
      else
        // no escape sequence
        Result := Result + '\' + S[I];
      end;
    end;
    Inc(I);
  end;
end;

function StrLower(const S: string): string;
begin
  Result := S;
  StrLowerInPlace(Result);
end;

procedure StrLowerInPlace(var S: string);
{$IFDEF PIC}
begin
  StrCase(S, StrLoOffset);
end;
{$ELSE}
asm
        // StrCase(S, StrLoOffset)

         XOR     EDX, EDX         // MOV     EDX, StrLoOffset
         JMP     StrCase
end;
{$ENDIF PIC}

{$IFNDEF CLR}
procedure StrLowerBuff(S: PChar);
{$IFDEF PIC}
begin
  StrCaseBuff(S, StrLoOffset);
end;
{$ELSE}
asm
        // StrCaseBuff(S, LoOffset)
         XOR     EDX, EDX                // MOV     EDX, LoOffset
         JMP     StrCaseBuff
end;
{$ENDIF PIC}
{$ENDIF ~CLR}

{$IFDEF CLR}
procedure MoveString(const Source: string; SrcIndex: Integer;
  var Dest: string; DstIndex, Count: Integer);
begin
  Dec(SrcIndex);
  Dec(DstIndex);
  Dest := Dest.Remove(DstIndex, Count).Insert(DstIndex, Source.Substring(SrcIndex, Count));
end;
{$ENDIF CLR}

procedure StrMove(var Dest: string; const Source: string;
  const ToIndex, FromIndex, Count: Integer);
begin
  // Check strings
  if (Source = '') or (Length(Dest) = 0) then
    Exit;

  // Check FromIndex
  if (FromIndex <= 0) or (FromIndex > Length(Source)) or
    (ToIndex <= 0) or (ToIndex > Length(Dest)) or
    ((FromIndex + Count - 1) > Length(Source)) or ((ToIndex + Count - 1) > Length(Dest)) then
     { TODO : Is failure without notice the proper thing to do here? }
    Exit;

  // Move
  {$IFDEF CLR}
  MoveString(Source, FromIndex, Dest, ToIndex, Count);
  {$ELSE}
  Move(Source[FromIndex], Dest[ToIndex], Count * SizeOf(Char));
  {$ENDIF CLR}
end;

function StrPadLeft(const S: string; Len: Integer; C: Char): string;
var
  L: Integer;
begin
  L := Length(S);
  if L < Len then
    Result := StringOfChar(C, Len - L) + S
  else
    Result := S;
end;

function StrPadRight(const S: string; Len: Integer; C: Char): string;
var
  L: Integer;
begin
  L := Length(S);
  if L < Len then
    Result := S + StringOfChar(C, Len - L)
  else
    Result := S;
end;

function StrProper(const S: string): string;
begin
  {$IFDEF CLR}
  Result := S.ToLower;
  {$ELSE}
  Result := StrLower(S);
  {$ENDIF CLR}
  if Result <> '' then
    Result[1] := UpCase(Result[1]);
end;

{$IFNDEF CLR}
procedure StrProperBuff(S: PChar);
begin
  if (S <> nil) and (S^ <> #0) then
  begin
    StrLowerBuff(S);
    S^ := CharUpper(S^);
  end;
end;
{$ENDIF ~CLR}

function StrQuote(const S: string; C: Char): string;
var
  L: Integer;
begin
  L := Length(S);
  Result := S;
  if L > 0 then
  begin
    if Result[1] <> C then
    begin
      Result := C + Result;
      Inc(L);
    end;
    if Result[L] <> C then
      Result := Result + C;
  end;
end;

function StrRemoveChars(const S: string; const Chars: TCharValidator): string;
{$IFDEF CLR}
var
  I: Integer;
  sb: StringBuilder;
begin
  sb := StringBuilder.Create(Length(S));
  for I := 0 to S.Length - 1 do
    if not Chars(S[I]) then
      sb.Append(S[I]);
  Result := sb.ToString();
end;
{$ELSE}
var
  Source, Dest: PChar;
  Len, Index:   Integer;
begin
  Len := Length(S);
  SetLength(Result, Len);
  UniqueString(Result);
  Source := PChar(S);
  Dest := PChar(Result);
  for Index := 0 to Len - 1 do
  begin
    if not Chars(Source^) then
    begin
      Dest^ := Source^;
      Inc(Dest);
    end;
    Inc(Source);
  end;
  SetLength(Result, Dest - PChar(Result));
end;
{$ENDIF CLR}

function StrRemoveChars(const S: string; const Chars: array of Char): string;
{$IFDEF CLR}
var
  I: Integer;
  sb: StringBuilder;
begin
  sb := StringBuilder.Create(Length(S));
  for I := 0 to S.Length - 1 do
    if not ArrayContainsChar(Chars,S[I]) then
      sb.Append(S[I]);
  Result := sb.ToString();
end;
{$ELSE}
var
  Source, Dest: PChar;
  Len, Index:   Integer;
begin
  Len := Length(S);
  SetLength(Result, Len);
  UniqueString(Result);
  Source := PChar(S);
  Dest := PChar(Result);
  for Index := 0 to Len - 1 do
  begin
    if not ArrayContainsChar(Chars, Source^) then
    begin
      Dest^ := Source^;
      Inc(Dest);
    end;
    Inc(Source);
  end;
  SetLength(Result, Dest - PChar(Result));
end;
{$ENDIF CLR}

function StrRemoveEndChars(const S: string; const Chars: TCharValidator): string;
{$IFDEF CLR}
var
  Len: Integer;
  I: Integer;
  sb: StringBuilder;
begin
  Len := Length(S);
  while (Len > 0) and Chars(s[Len]) do
    Dec(Len);
  sb := StringBuilder.Create(Len);
  for I := 0 to Len  do
    sb.Append(S[I]);
  Result := sb.ToString();
end;
{$ELSE}
var
  Len :   Integer;
begin
  Len := Length(S);
  while (Len > 0) and Chars(s[Len]) do
    Dec(Len);
  Result := Copy (s, 1, Len);
end;
{$ENDIF CLR}

function StrRemoveEndChars(const S: string; const Chars: array of Char): string;
{$IFDEF CLR}
var
  Len: Integer;
  I: Integer;
  sb: StringBuilder;
begin
  Len := Length(S);
  while (Len > 0) and ArrayContainsChar(Chars, s[Len]) do
    Dec(Len);
  sb := StringBuilder.Create(Len);
  for I := 0 to Len  do
    sb.Append(S[I]);
  Result := sb.ToString();
end;
{$ELSE}
var
  Len :   Integer;
begin
  Len := Length(S);
  while (Len > 0) and ArrayContainsChar(Chars, s[Len]) do
    Dec(Len);
  Result := Copy (s, 1, Len);
end;
{$ENDIF CLR}

function StrKeepChars(const S: string; const Chars: TCharValidator): string;
{$IFDEF CLR}
var
  I: Integer;
  sb: StringBuilder;
begin
  sb := StringBuilder.Create(Length(S));
  for I := 0 to S.Length - 1 do
    if Chars(S[I]) then
      sb.Append(S[I]);
  Result := sb.ToString();
end;
{$ELSE}
var
  Source, Dest: PChar;
  Len, Index:   Integer;
begin
  Len := Length(S);
  SetLength(Result, Len);
  UniqueString(Result);
  Source := PChar(S);
  Dest := PChar(Result);
  for Index := 0 to Len - 1 do
  begin
    if Chars(Source^) then
    begin
      Dest^ := Source^;
      Inc(Dest);
    end;
    Inc(Source);
  end;
  SetLength(Result, Dest - PChar(Result));
end;
{$ENDIF CLR}

function StrKeepChars(const S: string; const Chars: array of Char): string;
{$IFDEF CLR}
var
  I: Integer;
  sb: StringBuilder;
begin
  sb := StringBuilder.Create(Length(S));
  for I := 0 to S.Length - 1 do
    if ArrayContainsChar(Chars,S[I]) then
      sb.Append(S[I]);
  Result := sb.ToString();
end;
{$ELSE}
var
  Source, Dest: PChar;
  Len, Index:   Integer;
begin
  Len := Length(S);
  SetLength(Result, Len);
  UniqueString(Result);
  Source := PChar(S);
  Dest := PChar(Result);
  for Index := 0 to Len - 1 do
  begin
    if ArrayContainsChar(Chars, Source^) then
    begin
      Dest^ := Source^;
      Inc(Dest);
    end;
    Inc(Source);
  end;
  SetLength(Result, Dest - PChar(Result));
end;
{$ENDIF CLR}

function StrRepeat(const S: string; Count: Integer): string;
{$IFDEF CLR}
var
  I, Len: Integer;
  sb: StringBuilder;
begin
  Len := Length(S);
  if Len * Count > 0 then
  begin
    sb := StringBuilder.Create(Len * Count);
    for I := Count - 1 downto 0 do
      sb.Append(S);
    Result := sb.ToString();
  end
  else
    Result := '';
end;
{$ELSE}
var
  Len, Index: Integer;
  Dest, Source: PChar;
begin
  Len := Length(S);
  SetLength(Result, Count * Len);
  Dest := PChar(Result);
  Source := PChar(S);
  if Dest <> nil then
    for Index := 0 to Count - 1 do
    begin
      Move(Source^, Dest^, Len * SizeOf(Char));
      Inc(Dest, Len);
    end;
end;
{$ENDIF CLR}

function StrRepeatLength(const S: string; L: Integer): string;
{$IFDEF CLR}
var
  Count: Integer;
  LenS, Index: Integer;
begin
  Result := '';
  LenS := Length(S);

  if (LenS > 0) and (S <> '') then
  begin
    Count := L div LenS;
    if Count * LenS < L then
      Inc(Count);
    SetLength(Result, Count * LenS);
    Index := 1;
    while Count > 0 do
    begin
      MoveString(S, 1, Result, Index, LenS);
      Inc(Index, LenS);
      Dec(Count);
    end;
    if Length(S) > L then
      SetLength(Result, L);
  end;
end;
{$ELSE}
var
  Len: Integer;
  Dest: PChar;
begin
  Result := '';
  Len := Length(S);

  if (Len > 0) and (S <> '') then
  begin
    SetLength(Result, L);
    Dest := PChar(Result);
    while (L > 0) do
    begin
      Move(S[1], Dest^, Min(L, Len) * SizeOf(Char));
      Inc(Dest, Len);
      Dec(L, Len);
    end;
  end;
end;
{$ENDIF CLR}

procedure StrReplace(var S: string; const Search, Replace: string; Flags: TReplaceFlags);
{$IFDEF CLR}
begin
  S := StringReplace(S, Search, Replace, Flags); // !!! Convertion to System.String
end;
{$ELSE}
var
  SearchStr: string;
  ResultStr: string; { result string }
  SourcePtr: PChar;      { pointer into S of character under examination }
  SourceMatchPtr: PChar; { pointers into S and Search when first character has }
  SearchMatchPtr: PChar; { been matched and we're probing for a complete match }
  ResultPtr: PChar;      { pointer into Result of character being written }
  ResultIndex,
  SearchLength,          { length of search string }
  ReplaceLength,         { length of replace string }
  BufferLength,          { length of temporary result buffer }
  ResultLength: Integer; { length of result string }
  C: Char;               { first character of search string }
  IgnoreCase: Boolean;
begin
  if Search = '' then
  begin
    if S = '' then
    begin
      S := Replace;
      Exit;
    end
    else
      raise EJclStringError.CreateRes(@RsBlankSearchString);
  end;

  if S <> '' then
  begin
    IgnoreCase := rfIgnoreCase in Flags;
    if IgnoreCase then
      SearchStr := StrUpper(Search)
    else
      SearchStr := Search;
    { avoid having to call Length() within the loop }
    SearchLength := Length(Search);
    ReplaceLength := Length(Replace);
    ResultLength := Length(S);
    BufferLength := ResultLength;
    SetLength(ResultStr, BufferLength);
    { get pointers to begin of source and result }
    ResultPtr := PChar(ResultStr);
    SourcePtr := PChar(S);
    C := SearchStr[1];
    { while we haven't reached the end of the string }
    while True do
    begin
      { copy characters until we find the first character of the search string }
      if IgnoreCase then
        while (CharUpper(SourcePtr^) <> C) and (SourcePtr^ <> #0) do
        begin
          ResultPtr^ := SourcePtr^;
          Inc(ResultPtr);
          Inc(SourcePtr);
        end
      else
        while (SourcePtr^ <> C) and (SourcePtr^ <> #0) do
        begin
          ResultPtr^ := SourcePtr^;
          Inc(ResultPtr);
          Inc(SourcePtr);
        end;
      { did we find that first character or did we hit the end of the string? }
      if SourcePtr^ = #0 then
        Break
      else
      begin
        { continue comparing, +1 because first character was matched already }
        SourceMatchPtr := SourcePtr + 1;
        SearchMatchPtr := PChar(SearchStr) + 1;
        if IgnoreCase then
          while (CharUpper(SourceMatchPtr^) = SearchMatchPtr^) and (SearchMatchPtr^ <> #0) do
          begin
            Inc(SourceMatchPtr);
            Inc(SearchMatchPtr);
          end
        else
          while (SourceMatchPtr^ = SearchMatchPtr^) and (SearchMatchPtr^ <> #0) do
          begin
            Inc(SourceMatchPtr);
            Inc(SearchMatchPtr);
          end;
        { did we find a complete match? }
        if SearchMatchPtr^ = #0 then
        begin
          // keep track of result length
          Inc(ResultLength, ReplaceLength - SearchLength);
          if ReplaceLength > 0 then
          begin
            // increase buffer size if required
            if ResultLength > BufferLength then
            begin
              BufferLength := ResultLength * 2;
              ResultIndex := ResultPtr - PChar(ResultStr) + 1;
              SetLength(ResultStr, BufferLength);
              ResultPtr := @ResultStr[ResultIndex];
            end;
            { append replace to result and move past the search string in source }
            Move((@Replace[1])^, ResultPtr^, ReplaceLength * SizeOf(Char));
          end;
          Inc(SourcePtr, SearchLength);
          Inc(ResultPtr, ReplaceLength);
          { replace all instances or just one? }
          if not (rfReplaceAll in Flags) then
          begin
            { just one, copy until end of source and break out of loop }
            while SourcePtr^ <> #0 do
            begin
              ResultPtr^ := SourcePtr^;
              Inc(ResultPtr);
              Inc(SourcePtr);
            end;
            Break;
          end;
        end
        else
        begin
          { copy current character and start over with the next }
          ResultPtr^ := SourcePtr^;
          Inc(ResultPtr);
          Inc(SourcePtr);
        end;
      end;
    end;
    { set result length and copy result into S }
    SetLength(ResultStr, ResultLength);
    S := ResultStr;
  end;
end;
{$ENDIF CLR}

function StrReplaceChar(const S: string; const Source, Replace: Char): string;
{$IFNDEF CLR}
var
  I: Integer;
{$ENDIF ~CLR}
begin
  {$IFDEF CLR}
  Result := S.Replace(Source, Replace);
  {$ELSE}
  Result := S;
  for I := 1 to Length(S) do
    if Result[I] = Source then
      Result[I] := Replace;
  {$ENDIF CLR}
end;

function StrReplaceChars(const S: string; const Chars: TCharValidator; Replace: Char): string;
var
  I: Integer;
  {$IFDEF CLR}
  sb: StringBuilder;
  {$ENDIF CLR}
begin
  {$IFDEF CLR}
  sb := StringBuilder.Create(S);
  for I := 0 to sb.Length - 1 do
    if Chars(sb[I]) then
      sb[I] := Replace;
  Result := sb.ToString();
  {$ELSE}
  Result := S;
  for I := 1 to Length(S) do
    if Chars(Result[I]) then
      Result[I] := Replace;
  {$ENDIF CLR}
end;

function StrReplaceChars(const S: string; const Chars: array of Char; Replace: Char): string;
var
  I: Integer;
  {$IFDEF CLR}
  sb: StringBuilder;
  {$ENDIF CLR}
begin
  {$IFDEF CLR}
  sb := StringBuilder.Create(S);
  for I := 0 to sb.Length - 1 do
    if ArrayContainsChar(Chars,sb[I]) then
      sb[I] := Replace;
  Result := sb.ToString();
  {$ELSE}
  Result := S;
  for I := 1 to Length(S) do
    if ArrayContainsChar(Chars, Result[I]) then
      Result[I] := Replace;
  {$ENDIF CLR}
end;

function StrReplaceButChars(const S: string; const Chars: TCharValidator;
  Replace: Char): string;
var
  I: Integer;
  {$IFDEF CLR}
  sb: StringBuilder;
  {$ENDIF CLR}
begin
  {$IFDEF CLR}
  sb := StringBuilder.Create(S);
  for I := 0 to sb.Length - 1 do
    if not Chars(sb[I]) then
      sb[I] := Replace;
  Result := sb.ToString();
  {$ELSE}
  Result := S;
  for I := 1 to Length(S) do
    if not Chars(Result[I]) then
      Result[I] := Replace;
  {$ENDIF CLR}
end;

function StrReplaceButChars(const S: string; const Chars: array of Char; Replace: Char): string;
var
  I: Integer;
  {$IFDEF CLR}
  sb: StringBuilder;
  {$ENDIF CLR}
begin
  {$IFDEF CLR}
  sb := StringBuilder.Create(S);
  for I := 0 to sb.Length - 1 do
    if not ArrayContainsChar(Chars,sb[I]) then
      sb[I] := Replace;
  Result := sb.ToString();
  {$ELSE}
  Result := S;
  for I := 1 to Length(S) do
    if not ArrayContainsChar(Chars, Result[I]) then
      Result[I] := Replace;
  {$ENDIF CLR}
end;

function StrReverse(const S: string): string;
begin
  Result := S;
  StrReverseInplace(Result);
end;

procedure StrReverseInPlace(var S: string);
{ TODO -oahuser : Warning: This is dangerous for unicode surrogates }
{$IFDEF CLR}
var
  I, LenS: Integer;
  sb: StringBuilder;
begin
  LenS := Length(S);
  sb := StringBuilder.Create(LenS);
  sb.Length := LenS;
  for I := 0 to LenS - 1 do
    sb[I] := S[LenS - I - 1];
  S := sb.ToString();
end;
{$ELSE}
var
  P1, P2: PChar;
  C:      Char;
begin
  UniqueString(S);
  P1 := PChar(S);
  P2 := P1 + SizeOf(Char) * (Length(S) - 1);
  while P1 < P2 do
  begin
    C := P1^;
    P1^ := P2^;
    P2^ := C;
    Inc(P1);
    Dec(P2);
  end;
end;
{$ENDIF CLR}

function StrSingleQuote(const S: string): string;
begin
  Result := NativeSingleQuote + S + NativeSingleQuote;
end;

function StrSmartCase(const S: string; const Delimiters: TCharValidator): string;
var
  {$IFDEF CLR}
  Index: Integer;
  LenS: Integer;
  sb: StringBuilder;
  {$ELSE}
  Source, Dest: PChar;
  Index, Len:   Integer;
  {$ENDIF CLR}
  InternalDelimiters: TCharValidator;
begin
  Result := '';
  if Assigned(Delimiters) then
    InternalDelimiters := Delimiters
  else
    InternalDelimiters := CharIsSpace;

  if S <> '' then
  begin
    Result := S;
    {$IFDEF CLR}
    sb := StringBuilder.Create(S);
    LenS := Length(S);
    Index := 0;
    while Index < LenS do
    begin
      if (InternalDelimiters(sb[Index])) and (Index + 1 < LenS) and
        not (InternalDelimiters(sb[Index + 1])) then
        sb[Index + 1] := CharUpper(sb[Index + 1]);
      Inc(Index);
    end;
    sb[0] := CharUpper(sb[0]);
    Result := sb.ToString();
    {$ELSE}
    UniqueString(Result);

    Len := Length(S);
    Source := PChar(S);
    Dest := PChar(Result);
    Inc(Dest);

    for Index := 2 to Len do
    begin
      if InternalDelimiters(Source^) and not InternalDelimiters(Dest^) then
        Dest^ := CharUpper(Dest^);
      Inc(Dest);
      Inc(Source);
    end;
    Result[1] := CharUpper(Result[1]);
    {$ENDIF CLR}
  end;
end;

function StrSmartCase(const S: string; const Delimiters: array of Char): string;
var
  {$IFDEF CLR}
  Index: Integer;
  LenS: Integer;
  sb: StringBuilder;
  {$ELSE}
  Source, Dest: PChar;
  Index, Len:   Integer;
  {$ENDIF CLR}
begin
  Result := '';

  if S <> '' then
  begin
    Result := S;
    {$IFDEF CLR}
    sb := StringBuilder.Create(S);
    LenS := Length(S);
    Index := 0;
    while Index < LenS do
    begin
      if ArrayContainsChar(Delimiters,sb[Index]) and (Index + 1 < LenS) and
        not ArrayContainsChar(Delimiters,sb[Index + 1]) then
        sb[Index + 1] := CharUpper(sb[Index + 1]);
      Inc(Index);
    end;
    sb[0] := CharUpper(sb[0]);
    Result := sb.ToString();
    {$ELSE}
    UniqueString(Result);

    Len := Length(S);
    Source := PChar(S);
    Dest := PChar(Result);
    Inc(Dest);

    for Index := 2 to Len do
    begin
      if ArrayContainsChar(Delimiters, Source^) and not ArrayContainsChar(Delimiters, Dest^) then
        Dest^ := CharUpper(Dest^);
      Inc(Dest);
      Inc(Source);
    end;
    Result[1] := CharUpper(Result[1]);
    {$ENDIF CLR}
  end;
end;

function StrStringToEscaped(const S: string): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length(S) do
  begin
    case S[I] of
      NativeBackspace:
        Result := Result + '\b';
      NativeBell:
        Result := Result + '\a';
      NativeCarriageReturn:
        Result := Result + '\r';
      NAtiveFormFeed:
        Result := Result + '\f';
      NativeLineFeed:
        Result := Result + '\n';
      NativeTab:
        Result := Result + '\t';
      NativeVerticalTab:
        Result := Result + '\v';
      NativeBackSlash:
        Result := Result + '\\';
      NativeDoubleQuote:
        Result := Result + '\"';
    else
      // Characters < ' ' are escaped with hex sequence
      if S[I] < #32 then
        Result := Result + Format('\x%.2x', [Integer(S[I])])
      else
        Result := Result + S[I];
    end;
  end;
end;

function StrStripNonNumberChars(const S: string): string;
var
  I: Integer;
  C: Char;
begin
  Result := '';
  for I := 1 to Length(S) do
  begin
    C := S[I];
    if CharIsNumberChar(C) then
      Result := Result + C;
  end;
end;

function StrToHex(const Source: string): string;
var
  Index: Integer;
  C, L, N: Integer;
  BL, BH: Byte;
  S:     string;
  {$IFDEF CLR}
  sb: StringBuilder;
  {$ENDIF CLR}
begin
  {$IFDEF CLR}
  sb := StringBuilder.Create;
  {$ELSE}
  Result := '';
  {$ENDIF CLR}
  if Source <> '' then
  begin
    S := Source;
    L := Length(S);
    if Odd(L) then
    begin
      S := '0' + S;
      Inc(L);
    end;
    Index := 1;
    {$IFDEF CLR}
    sb.Length := L div 2;
    {$ELSE}
    SetLength(Result, L div 2);
    {$ENDIF CLR}
    C := 1;
    N := 1;
    while C <= L do
    begin
      BH := CharHex(S[Index]);
      Inc(Index);
      BL := CharHex(S[Index]);
      Inc(Index);
      Inc(C, 2);
      if (BH = $FF) or (BL = $FF) then
      begin
        Result := '';
        Exit;
      end;
      {$IFDEF CLR}
      sb[N] :=
      {$ELSE}
      Result[N] :=
      {$ENDIF CLR}
        Char((BH shl 4) + BL);
      Inc(N);
    end;
  end;
  {$IFDEF CLR}
  Result := sb.ToString();
  {$ENDIF CLR}
end;

function StrTrimCharLeft(const S: string; C: Char): string;
var
  I, L: Integer;
begin
  I := 1;
  L := Length(S);
  while (I <= L) and (S[I] = C) do
    Inc(I);
  Result := Copy(S, I, L - I + 1);
end;

function StrTrimCharsLeft(const S: string; const Chars: TCharValidator): string;
var
  I, L: Integer;
begin
  I := 1;
  L := Length(S);
  while (I <= L) and Chars(S[I]) do
    Inc(I);
  Result := Copy(S, I, L - I + 1);
end;

function StrTrimCharsLeft(const S: string; const Chars: array of Char): string;
var
  I, L: Integer;
begin
  I := 1;
  L := Length(S);
  while (I <= L) and ArrayContainsChar(Chars, S[I]) do
    Inc(I);
  Result := Copy(S, I, L - I + 1);
end;

function StrTrimCharRight(const S: string; C: Char): string;
var
  I: Integer;
begin
  I := Length(S);
  while (I >= 1) and (S[I] = C) do
    Dec(I);
  Result := Copy(S, 1, I);
end;

function StrTrimCharsRight(const S: string; const Chars: TCharValidator): string;
var
  I: Integer;
begin
  I := Length(S);
  while (I >= 1) and Chars(S[I]) do
    Dec(I);
  Result := Copy(S, 1, I);
end;

function StrTrimCharsRight(const S: string; const Chars: array of Char): string;
var
  I: Integer;
begin
  I := Length(S);
  while (I >= 1) and ArrayContainsChar(Chars, S[I]) do
    Dec(I);
  Result := Copy(S, 1, I);
end;

function StrTrimQuotes(const S: string): string;
var
  First, Last: Char;
  L: Integer;
begin
  L := Length(S);
  if L > 1 then
  begin
    First := S[1];
    Last := S[L];
    if (First = Last) and ((First = NativeSingleQuote) or (First = NativeDoubleQuote)) then
      Result := Copy(S, 2, L - 2)
    else
      Result := S;
  end
  else
    Result := S;
end;

function StrUpper(const S: string): string;
begin
  Result := S;
  StrUpperInPlace(Result);
end;

procedure StrUpperInPlace(var S: string);
{$IFDEF PIC}
begin
  StrCase(S, StrUpOffset);
end;
{$ELSE}
asm
        // StrCase(Str, StrUpOffset)
         MOV     EDX, StrUpOffset
         JMP     StrCase
end;
{$ENDIF PIC}

{$IFNDEF CLR}
procedure StrUpperBuff(S: PChar);
{$IFDEF PIC}
begin
  StrCaseBuff(S, StrUpOffset);
end;
{$ELSE}
asm
        // StrCaseBuff(S, UpOffset)
         MOV     EDX, StrUpOffset
         JMP     StrCaseBuff
end;
{$ENDIF PIC}
{$ENDIF ~CLR}

{$IFNDEF CLR}
//=== String Management ======================================================

{$IFNDEF SUPPORTS_UNICODE}
{$IFDEF KEEP_DEPRECATED}
procedure StrAddRef(var S: string);
var
  Foo: string;
begin
  if StrRefCount(S) = -1 then
    UniqueString(S)
  else
  begin
    Foo := S;
    Pointer(Foo) := nil;
  end;
end;

function StrAllocSize(const S: string): Longint;
var
  P: Pointer;
begin
  Result := 0;
  if Pointer(S) <> nil then
  begin
    P := Pointer(INT_PTR(Pointer(S)) - StrRefCountOffset);
    if Integer(P^) <> -1 then
    begin
      P := Pointer(INT_PTR(Pointer(S)) - StrAllocOffset);
      Result := Integer(P^);
    end;
  end;
end;

procedure StrDecRef(var S: string);
var
  Foo: string;
begin
  case StrRefCount(S) of
    -1, 0: { nothing } ;
     1:
       begin
         Finalize(S);
         Pointer(S) := nil;
       end;
  else
    Pointer(Foo) := Pointer(S);
  end;
end;

function StrLength(const S: string): Longint;
var
  P: Pointer;
begin
  Result := 0;
  if Pointer(S) <> nil then
  begin
    P := Pointer(INT_PTR(Pointer(S)) - StrLengthOffset);
    Result := Longint(P^) and (not $80000000 shr 1);
  end;
end;

function StrRefCount(const S: string): Longint;
var
  P: Pointer;
begin
  Result := 0;
  if Pointer(S) <> nil then
  begin
    P := Pointer(INT_PTR(Pointer(S)) - StrRefCountOffset);
    Result := Longint(P^);
  end;
end;
{$ENDIF KEEP_DEPRECATED}
{$ENDIF ~SUPPORTS_UNICODE}

{$ENDIF ~CLR}

procedure StrResetLength(var S: WideString);
var
  I: Integer;
begin
  for I := 0 to Length(S) - 1 do
    if S[I + 1] = #0 then
    begin
      SetLength(S, I);
      Exit;
    end;
end;

procedure StrResetLength(var S: AnsiString);
var
  I: Integer;
begin
  for I := 0 to Length(S) - 1 do
    if S[I + 1] = #0 then
    begin
      SetLength(S, I);
      Exit;
    end;
end;

procedure StrResetLength(S: TJclStringBuilder);
var
  I: Integer;
begin
  if S <> nil then
    for I := 0 to S.Length - 1 do
      if S[I] = #0 then
      begin
        S.Length := I;
        Exit;
      end;
end;

{$IFDEF SUPPORTS_UNICODE_STRING}
procedure StrResetLength(var S: UnicodeString);
var
  I: Integer;
begin
  for I := 0 to Length(S) - 1 do
    if S[I + 1] = #0 then
    begin
      SetLength(S, I);
      Exit;
    end;
end;
{$ENDIF SUPPORTS_UNICODE_STRING}

//=== String Search and Replace Routines =====================================

function StrCharCount(const S: string; C: Char): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 1 to Length(S) do
    if S[I] = C then
      Inc(Result);
end;

function StrCharsCount(const S: string; const Chars: TCharValidator): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 1 to Length(S) do
    if Chars(S[I]) then
      Inc(Result);
end;

function StrCharsCount(const S: string; const Chars: array of Char): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 1 to Length(S) do
    if ArrayContainsChar(Chars, S[I]) then
      Inc(Result);
end;

function StrStrCount(const S, SubS: string): Integer;
var
  I: Integer;
begin
  Result := 0;
  if (Length(SubS) > Length(S)) or (Length(SubS) = 0) or (Length(S) = 0) then
    Exit;
  if Length(SubS) = 1 then
  begin
    Result := StrCharCount(S, SubS[1]);
    Exit;
  end;
  I := StrSearch(SubS, S, 1);

  if I > 0 then
    Inc(Result);

  while (I > 0) and (Length(S) > I + Length(SubS)) do
  begin
    I := StrSearch(SubS, S, I + 1);

    if I > 0 then
      Inc(Result);
  end;
end;

{$IFDEF SUPPORTS_UNICODE}
(*
{ 1}  Test(StrCompareRange('', '', 1, 5), 0);
{ 2}  Test(StrCompareRange('A', '', 1, 5), -1);
{ 3}  Test(StrCompareRange('AB', '', 1, 5), -1);
{ 4}  Test(StrCompareRange('ABC', '', 1, 5), -1);
{ 5}  Test(StrCompareRange('', 'A', 1, 5), -1);
{ 6}  Test(StrCompareRange('', 'AB',  1, 5), -1);
{ 7}  Test(StrCompareRange('', 'ABC', 1, 5), -1);
{ 8}  Test(StrCompareRange('A', 'a', 1, 5), -2);
{ 9}  Test(StrCompareRange('A', 'a', 1, 1), -32);
{10}  Test(StrCompareRange('aA', 'aB', 1, 1), 0);
{11}  Test(StrCompareRange('aA', 'aB', 1, 2), -1);
{12}  Test(StrCompareRange('aB', 'aA', 1, 2), 1);
{13}  Test(StrCompareRange('aA', 'aa', 1, 2), -32);
{14}  Test(StrCompareRange('aa', 'aA', 1, 2), 32);
{15}  Test(StrCompareRange('', '', 1, 0), 0);
{16}  Test(StrCompareRange('A', 'A', 1, 0), -2);
{17}  Test(StrCompareRange('Aa', 'A', 1, 0), -2);
{18}  Test(StrCompareRange('Aa', 'Aa', 1, 2), 0);
{19}  Test(StrCompareRange('Aa', 'A', 1, 2), 0);
{20}  Test(StrCompareRange('Ba', 'A', 1, 2), 1);
*)
function StrCompareRangeEx(const S1, S2: string; Index, Count: Integer; CaseSensitive: Boolean): Integer;
var
  Len1, Len2: Integer;
  I: Integer;
  C1, C2: Char;
begin
  {$IFDEF CLR}
  if S1 = S2 then
  {$ELSE}
  if Pointer(S1) = Pointer(S2) then
  {$ENDIF CLR}
  begin
    if (Count <= 0) and (S1 <> '') then
      Result := -2 // no work
    else
      Result := 0;
  end
  else
  if (S1 = '') or (S2 = '') then
    Result := -1 // null string
  else
  if Count <= 0 then
    Result := -2 // no work
  else
  begin
    Len1 := Length(S1);
    Len2 := Length(S2);

    if (Index - 1) + Count > Len1 then
      Result := -2
    else
    begin
      if (Index - 1) + Count > Len2 then // strange behaviour, but the assembler code does it
        Count := Len2 - (Index - 1);

      if CaseSensitive then
      begin
        for I := 0 to Count - 1 do
        begin
          C1 := S1[Index + I];
          C2 := S2[Index + I];
          if C1 <> C2 then
          begin
            Result := Ord(C1) - Ord(C2);
            Exit;
          end;
        end;
      end
      else
      begin
        for I := 0 to Count - 1 do
        begin
          C1 := S1[Index + I];
          C2 := S2[Index + I];
          if C1 <> C2 then
          begin
            C1 := CharLower(C1);
            C2 := CharLower(C2);
            if C1 <> C2 then
            begin
              Result := Ord(C1) - Ord(C2);
              Exit;
            end;
          end;
        end;
      end;
      Result := 0;
    end;
  end;
end;

function StrCompare(const S1, S2: string): Integer;
var
  Len1, Len2: Integer;
begin
  {$IFDEF CLR}
  if S1 = S2 then
  {$ELSE}
  if Pointer(S1) = Pointer(S2) then
  {$ENDIF CLR}
    Result := 0
  else
  begin
    Len1 := Length(S1);
    Len2 := Length(S2);
    Result := Len1 - Len2;
    if Result = 0 then
      Result := StrCompareRangeEx(S1, S2, 1, Len1, False);
  end;
end;

{$ELSE} // UNICODE

{$IFDEF PIC}
function _StrCompare(const S1, S2: string): Integer; forward;

function StrCompare(const S1, S2: string): Integer;
begin
  Result := _StrCompare(S1, S2);
end;

function _StrCompare(const S1, S2: string): Integer;
{$ELSE}
function StrCompare(const S1, S2: string): Integer;
{$ENDIF PIC}
asm
        // check if pointers are equal

         CMP     EAX, EDX
         JE      @@Equal

        // if S1 is nil return - Length(S2)

         TEST    EAX, EAX
         JZ      @@Str1Null

        // if S2 is nil return  Length(S1)

         TEST    EDX, EDX
         JZ      @@Str2Null

        // EBX will hold case map, ESI S1, EDI S2

         PUSH    EBX
         PUSH    ESI
         PUSH    EDI

        // move string pointers

         MOV     ESI, EAX
         MOV     EDI, EDX

        // get the length of strings

         MOV     EAX, [ESI-StrRecSize].TStrRec.Length
         MOV     EDX, [EDI-StrRecSize].TStrRec.Length

        // exit if Length(S1) <> Length(S2)

         CMP     EAX, EDX
         JNE     @@MissMatch

        // check the length just in case

         DEC     EDX
         JS      @@InvalidStr

         DEC     EAX
         JS      @@InvalidStr

        // load case map

         LEA     EBX, StrCaseMap

        // make ECX our loop counter

         MOV     ECX, EAX

        // clear working regs

         XOR     EAX, EAX
         XOR     EDX, EDX

        // get last chars

         MOV     AL, [ESI+ECX]
         MOV     DL, [EDI+ECX]

        // lower case them

         MOV     AL, [EBX+EAX]
         MOV     DL, [EBX+EDX]

        // compare them

         CMP     AL, DL
         JNE     @@MissMatch

        // if there was only 1 char then exit

         JECXZ   @@Match

         @@NextChar:
        // case sensitive compare of strings

         REPE    CMPSB
         JE      @@Match

        // if there was a missmatch try case insensitive compare, get the chars

         MOV     AL, [ESI-1]
         MOV     DL, [EDI-1]

        // lowercase and compare them, if equal then continue

         MOV     AL, [EBX+EAX]
         MOV     DL, [EBX+EDX]
         CMP     AL, DL
         JE      @@NextChar

        // if we make it here then strings don't match,  return the difference

         @@MissMatch:
         SUB     EAX, EDX
         POP     EDI
         POP     ESI
         POP     EBX
         RET

         @@Match:
        // match, return 0

         XOR     EAX, EAX
         POP     EDI
         POP     ESI
         POP     EBX
         RET

         @@InvalidStr:
         XOR     EAX, EAX
         DEC     EAX
         POP     EDI
         POP     ESI
         POP     EBX
         RET

         @@Str1Null:
        // return = - Length(Str2);

         MOV     EDX, [EDX-StrRecSize].TStrRec.Length
         SUB     EAX, EDX
         RET

         @@Str2Null:
        // return = Length(Str2);

         MOV     EAX, [EAX-StrRecSize].TStrRec.Length
         RET

         @@Equal:
         XOR     EAX, EAX
end;
{$ENDIF SUPPORTS_UNICODE}

function StrCompareRange(const S1, S2: string; const Index, Count: Integer): Integer;
{$IFDEF SUPPORTS_UNICODE}
begin
  Result := StrCompareRangeEx(S1, S2, Index, Count, True);
end;
{$ELSE}
asm
         TEST    EAX, EAX
         JZ      @@Str1Null

         TEST    EDX, EDX
         JZ      @@StrNull

         DEC     ECX
         JS      @@StrNull

         PUSH    EBX
         PUSH    ESI
         PUSH    EDI

         MOV     EBX, Count
         DEC     EBX
         JS      @@NoWork

         MOV     ESI, EAX
         MOV     EDI, EDX

         MOV     EDX, [ESI - StrRecSize].TStrRec.Length

        // # of chars in S1 - (Index - 1)
         SUB     EDX, ECX
         JLE     @@NoWork

        // # of chars in S1 - (Count - 1)
         SUB     EDX, EBX
         JLE     @@NoWork

        // move to index'th char
         ADD     ESI, ECX

         MOV     ECX, [EDI - StrRecSize].TStrRec.Length
         DEC     ECX
         JS      @@NoWork

        // if Length(S2) > Count then ECX := Count else ECX := Length(S2)

         CMP     ECX, EBX
         JLE     @@Skip1
         MOV     ECX, EBX

         @@Skip1:
         XOR     EAX, EAX
         XOR     EDX, EDX

         @@Loop:
         MOV     AL, [ESI]
         INC     ESI
         MOV     DL, [EDI]
         INC     EDI

         CMP     AL, DL
         JNE     @@MisMatch

         DEC     ECX
         JGE     @@Loop

         @@Match:
         XOR     EAX, EAX
         POP     EDI
         POP     ESI
         POP     EBX
         JMP     @@Exit

         @@MisMatch:
         SUB     EAX, EDX
         POP     EDI
         POP     ESI
         POP     EBX
         JMP     @@Exit

         @@NoWork:
         MOV     EAX, -2
         POP     EDI
         POP     ESI
         POP     EBX
         JMP     @@Exit

         @@Str1Null:
         MOV     EAX, 0
         TEST    EDX, EDX
         JZ      @@Exit

         @@StrNull:
         MOV     EAX, -1

         @@Exit:
end;
{$ENDIF SUPPORTS_UNICODE}

{$IFNDEF CLR}
procedure StrFillChar(var S; Count: Integer; C: Char);
{$IFDEF SUPPORTS_UNICODE}
asm
        DEC     EDX
        JS      @@Leave
@@Loop:
        MOV     [EAX], CX
        ADD     EAX, 2
        DEC     EDX
        JNS     @@Loop
@@Leave:
end;
{$ELSE}
begin
  if Count > 0 then
    FillChar(S, Count, C);
end;
{$ENDIF SUPPORTS_UNICODE}
{$ENDIF CLR}

function StrRepeatChar(C: Char; Count: Integer): string;
{$IFDEF CLR}
var
  sb: StringBuilder;
begin
  sb := StringBuilder.Create(Count);
  while Count > 0 do
  begin
    sb.Append(C);
    Dec(Count);
  end;
  Result := sb.ToString();
end;
{$ELSE}
begin
  SetLength(Result, Count);
  if Count > 0 then
    StrFillChar(Result[1], Count, C);
end;
{$ENDIF CLR}

{$IFDEF CLR}
function StrFind(const Substr, S: string; const Index: Integer): Integer;
begin
  Result := System.String(S).ToLower().IndexOf(System.String(SubStr).ToLower(), Index - 1) + 1;
end;
{$ELSE}
function StrFind(const Substr, S: string; const Index: Integer): Integer;
var
  Pos: PChar;
begin
  if (SubStr <> '') and (S <> '') then
  begin
    pos := StrPos(@S[Index], PChar(SubStr));
    if Pos = nil then
      result := 0
    else
      Result := (Cardinal(Pos) - Cardinal(@S[1])) div SizeOf(Char) + 1;
  end
  else
    result := 0;
end;
{$ENDIF CLR}

function StrHasPrefix(const S: string; const Prefixes: array of string): Boolean;
begin
  Result := StrPrefixIndex(S, Prefixes) > -1;
end;

function StrIndex(const S: string; const List: array of string): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := Low(List) to High(List) do
  begin
    if StrCompare(S, List[I]) = 0 then
    begin
      Result := I;
      Break;
    end;
  end;
end;

function StrILastPos(const SubStr, S: string): Integer;
begin
  Result := StrLastPos(StrUpper(SubStr), StrUpper(S));
end;

function StrIPos(const SubStr, S: string): Integer;
begin
  {$IFDEF CLR}
  Result := Pos(SubStr.ToUpper, S.ToUpper);
  {$ELSE}
  Result := Pos(StrUpper(SubStr), StrUpper(S));
  {$ENDIF CLR}
end;

function StrIsOneOf(const S: string; const List: array of string): Boolean;
begin
  Result := StrIndex(S, List) > -1;
end;

function StrLastPos(const SubStr, S: string): Integer;
{$IFDEF CLR}
begin
  Result := System.String(S).LastIndexOf(SubStr) + 1;
end;
{$ELSE}
var
  Last, Current: PChar;
begin
  Result := 0;
  Last := nil;
  Current := PChar(S);

  while (Current <> nil) and (Current^ <> #0) do
  begin
    Current := StrPos(PChar(Current), PChar(SubStr));
    if Current <> nil then
    begin
      Last := Current;
      Inc(Current);
    end;
  end;
  if Last <> nil then
    Result := Abs(PChar(S) - Last) + 1;
end;
{$ENDIF CLR}

// IMPORTANT NOTE: The StrMatch function does currently not work with the Asterix (*)

function StrMatch(const Substr, S: string; const Index: Integer): Integer;
{$IFDEF CLR}
begin
  { TODO : StrMatch }
  Assert(False, 'Not implemented yet');
  Result := 0;
end;
{$ELSE}
{$IFDEF SUPPORTS_UNICODE}
begin
  { TODO : StrMatch }
  Assert(False, 'Not implemented yet');
  Result := 0;
end;
{$ELSE}
asm
        // make sure that strings are not null

         TEST    EAX, EAX
         JZ      @@SubstrIsNull

         TEST    EDX, EDX
         JZ      @@StrIsNull

        // limit index to satisfy 1 <= index, and dec it

         DEC     ECX
         JL      @@IndexIsSmall

        // EBX will hold the case table, ESI pointer to Str, EDI pointer
        // to Substr and EBP # of chars in Substr to compare

         PUSH    EBX
         PUSH    ESI
         PUSH    EDI
         PUSH    EBP

        // set the string pointers

         MOV     ESI, EDX
         MOV     EDI, EAX

        // save the Index in EDX

         MOV     EDX, ECX

        // save the address of Str to compute the result

         PUSH    ESI

        // temporary get the length of Substr and Str

         MOV     EBX, [EDI - StrRecSize].TStrRec.Length
         MOV     ECX, [ESI - StrRecSize].TStrRec.Length

        // dec the length of Substr because the first char is brought out of it

         DEC     EBX
         JS      @@NotFound

        // #positions in Str to look at = Length(Str) - Length(Substr) - Index - 2

         SUB     ECX, EBX
         JLE     @@NotFound

         SUB     ECX, EDX
         JLE     @@NotFound

        // # of chars in Substr to compare

         MOV     EBP, EBX

        // point Str to Index'th char

         ADD     ESI, EDX

        // load case map into EBX, and clear EAX & ECX

         LEA     EBX, StrCaseMap
         XOR     EAX, EAX
         XOR     ECX, ECX

        // bring the first char out of the Substr and point Substr to the next char

         MOV     CL, [EDI]
         INC     EDI

        // lower case it

         MOV     CL, [EBX + ECX]

         @@FindNext:

        // get the current char from Str into al

         MOV     AL, [ESI]
         INC     ESI

        // check the end of string

         TEST    AL, AL
         JZ      @@NotFound


         CMP     CL, '*'    // Wild Card?
         JE      @@Compare

         CMP     CL, '?'    // Wild Card?
         JE      @@Compare

        // lower case current char

         MOV     AL, [EBX + EAX]

        // check if the current char matches the primary search char,
        // if not continue searching

         CMP     AL, CL
         JNE     @@FindNext

         @@Compare:

        // # of chars in Substr to compare }

         MOV     EDX, EBP

         @@CompareNext:

        // dec loop counter and check if we reached the end. If yes then we found it

         DEC     EDX
         JL      @@Found

        // get the chars from Str and Substr, if they are equal then continue comparing

         MOV     AL, [EDI + EDX]               // char from  Substr

         CMP     AL, '*'                     // wild card?
         JE      @@CompareNext

         CMP     AL, '?'                     // wild card?
         JE      @@CompareNext

         CMP     AL, [ESI + EDX]               // equal to PChar(Str)^ ?
         JE      @@CompareNext

         MOV     AL, [EBX + EAX + StrReOffset]  // reverse case?
         CMP     AL, [ESI + EDX]
         JNE     @@FindNext                  // if still no, go back to the main loop

        // if they matched, continue comparing

         JMP     @@CompareNext

         @@Found:
        // we found it, calculate the result

         MOV     EAX, ESI
         POP     ESI
         SUB     EAX, ESI

         POP     EBP
         POP     EDI
         POP     ESI
         POP     EBX
         RET

         @@NotFound:

        // not found it, clear the result

         XOR     EAX, EAX
         POP     ESI
         POP     EBP
         POP     EDI
         POP     ESI
         POP     EBX
         RET

         @@IndexIsSmall:
         @@StrIsNull:

        // clear the result

         XOR     EAX, EAX

         @@SubstrIsNull:
         @@Exit:
end;
{$ENDIF SUPPORTS_UNICODE}
{$ENDIF CLR}

// Derived from "Like" by Michael Winter
function StrMatches(const Substr, S: string; const Index: Integer): Boolean;
{$IFDEF CLR}
begin
  Result := Substr = S;
  { TODO : StrMatches }
end;
{$ELSE}
var
  StringPtr: PChar;
  PatternPtr: PChar;
  StringRes: PChar;
  PatternRes: PChar;
begin
  if SubStr = '' then
    raise EJclStringError.CreateRes(@RsBlankSearchString);

  Result := SubStr = '*';

  if Result or (S = '') then
    Exit;

  if (Index <= 0) or (Index > Length(S)) then
    raise EJclStringError.CreateRes(@RsArgumentOutOfRange);

  StringPtr := PChar(@S[Index]);
  PatternPtr := PChar(SubStr);
  StringRes := nil;
  PatternRes := nil;

  repeat
    repeat
      case PatternPtr^ of
        #0:
        begin
          Result := StringPtr^ = #0;
          if Result or (StringRes = nil) or (PatternRes = nil) then
            Exit;

          StringPtr := StringRes;
          PatternPtr := PatternRes;
          Break;
        end;
        '*':
        begin
          Inc(PatternPtr);
          PatternRes := PatternPtr;
          Break;
        end;
        '?':
        begin
          if StringPtr^ = #0 then
            Exit;
          Inc(StringPtr);
          Inc(PatternPtr);
        end;
      else
      begin
        if StringPtr^ = #0 then
          Exit;
        if StringPtr^ <> PatternPtr^ then
        begin
          if (StringRes = nil) or (PatternRes = nil) then
            Exit;
          StringPtr := StringRes;
          PatternPtr := PatternRes;
          Break;
        end
        else
        begin
          Inc(StringPtr);
          Inc(PatternPtr);
        end;
      end;
      end;
    until False;

    repeat
      case PatternPtr^ of
        #0:
        begin
          Result := True;
          Exit;
        end;
        '*':
        begin
          Inc(PatternPtr);
          PatternRes := PatternPtr;
        end;
        '?':
        begin
          if StringPtr^ = #0 then
            Exit;
          Inc(StringPtr);
          Inc(PatternPtr);
        end;
      else
      begin
        repeat
          if StringPtr^ = #0 then
            Exit;
          if StringPtr^ = PatternPtr^ then
            Break;
          Inc(StringPtr);
        until False;
        Inc(StringPtr);
        StringRes := StringPtr;
        Inc(PatternPtr);
        Break;
      end;
      end;
    until False;
  until False;
end;
{$ENDIF CLR}

function StrNPos(const S, SubStr: string; N: Integer): Integer;
var
  I, P: Integer;
begin
  if N < 1 then
  begin
    Result := 0;
    Exit;
  end;

  Result := StrSearch(SubStr, S, 1);
  I := 1;
  while I < N do
  begin
    P := StrSearch(SubStr, S, Result + 1);
    if P = 0 then
    begin
      Result := 0;
      Break;
    end
    else
    begin
      Result := P;
      Inc(I);
    end;
  end;
end;

function StrNIPos(const S, SubStr: string; N: Integer): Integer;
var
  I, P: Integer;
begin
  if N < 1 then
  begin
    Result := 0;
    Exit;
  end;

  Result := StrFind(SubStr, S, 1);
  I := 1;
  while I < N do
  begin
    P := StrFind(SubStr, S, Result + 1);
    if P = 0 then
    begin
      Result := 0;
      Break;
    end
    else
    begin
      Result := P;
      Inc(I);
    end;
  end;
end;

function StrPrefixIndex(const S: string; const Prefixes: array of string): Integer;
var
  I: Integer;
  Test: string;
begin
  Result := -1;
  for I := Low(Prefixes) to High(Prefixes) do
  begin
    Test := StrLeft(S, Length(Prefixes[I]));
    if CompareStr(Test, Prefixes[I]) = 0 then
    begin
      Result := I;
      Break;
    end;
  end;
end;

{$IFDEF CLR}
function StrSearch(const Substr, S: string; const Index: Integer): Integer;
begin
  Result := System.String(S).IndexOf(SubStr, Index - 1) + 1;
end;
{$ELSE}
function StrSearch(const Substr, S: string; const Index: Integer): Integer;
{$IFDEF SUPPORTS_UNICODE}
begin
  Result := PosEx(SubStr, S, Index);
end;
{$ELSE}
asm
        // make sure that strings are not null

         TEST    EAX, EAX
         JZ      @@SubstrIsNull

         TEST    EDX, EDX
         JZ      @@StrIsNull

        // limit index to satisfy 1 <= index, and dec it

         DEC     ECX
         JL      @@IndexIsSmall

        // ebp will hold # of chars in Substr to compare, esi pointer to Str,
        // edi pointer to Substr, ebx primary search char

         PUSH    EBX
         PUSH    ESI
         PUSH    EDI
         PUSH    EBP

        // set the string pointers

         MOV     ESI, EDX
         MOV     EDI, EAX

        // save the (Index - 1) in edx

         MOV     EDX, ECX

        // save the address of Str to compute the result

         PUSH    ESI

        // temporary get the length of Substr and Str

         MOV     EBX, [EDI-StrRecSize].TStrRec.Length
         MOV     ECX, [ESI-StrRecSize].TStrRec.Length

        // dec the length of Substr because the first char is brought out of it

         DEC     EBX
         JS      @@NotFound

        // # of positions in Str to look at = Length(Str) - Length(Substr) - Index - 2

         SUB     ECX, EBX
         JLE     @@NotFound

         SUB     ECX, EDX
         JLE     @@NotFound

        // point Str to Index'th char

         ADD     ESI, EDX

        // # of chars in Substr to compare

         MOV     EBP, EBX

        // clear EAX & ECX (working regs)

         XOR     EAX, EAX
         XOR     EBX, EBX

        // bring the first char out of the Substr, and
        // point Substr to the next char

         MOV     BL, [EDI]
         INC     EDI

        // jump into the loop

         JMP     @@Find

         @@FindNext:

        // update the loop counter and check the end of string.
        // if we reached the end, Substr was not found.

         DEC     ECX
         JL      @@NotFound

         @@Find:

        // get current char from the string, and /point Str to the next one.
         MOV     AL, [ESI]
         INC     ESI

        // does current char match primary search char? if not, go back to the main loop

         CMP     AL, BL
         JNE     @@FindNext

        // otherwise compare SubStr

         @@Compare:

        // move # of char to compare into edx, edx will be our compare loop counter.

         MOV     EDX, EBP

         @@CompareNext:

        // check if we reached the end of Substr. If yes we found it.

         DEC     EDX
         JL      @@Found

        // get last chars from Str and SubStr and compare them,
        // if they don't match go back to out main loop.

         MOV     AL, [EDI+EDX]
         CMP     AL, [ESI+EDX]
         JNE     @@FindNext

        // if they matched, continue comparing

         JMP     @@CompareNext

         @@Found:
        // we found it, calculate the result and exit.

         MOV     EAX, ESI
         POP     ESI
         SUB     EAX, ESI

         POP     EBP
         POP     EDI
         POP     ESI
         POP     EBX
         RET

         @@NotFound:
        // not found it, clear result and exit.

         XOR     EAX, EAX
         POP     ESI
         POP     EBP
         POP     EDI
         POP     ESI
         POP     EBX
         RET

         @@IndexIsSmall:
         @@StrIsNull:
        // clear result and exit.

         XOR     EAX, EAX

         @@SubstrIsNull:
         @@Exit:
end;
{$ENDIF SUPPORTS_UNICODE}
{$ENDIF CLR}

//=== String Extraction ======================================================

function StrAfter(const SubStr, S: string): string;
var
  P: Integer;
begin
  P := StrFind(SubStr, S, 1); // StrFind is case-insensitive pos
  if P <= 0 then
    Result := ''           // substr not found -> nothing after it
  else
    Result := StrRestOf(S, P + Length(SubStr));
end;

function StrBefore(const SubStr, S: string): string;
var
  P: Integer;
begin
  P := StrFind(SubStr, S, 1);
  if P <= 0 then
    Result := S
  else
    Result := StrLeft(S, P - 1);
end;


function StrBetween(const S: string; const Start, Stop: Char): string;
var
  PosStart, PosEnd: Integer;
  L: Integer;
begin
  PosStart := Pos(Start, S);
  PosEnd := StrSearch(Stop, S, PosStart + 1);  // PosEnd has to be after PosStart.

  if (PosStart > 0) and (PosEnd > PosStart) then
  begin
    L := PosEnd - PosStart;
    Result := Copy(S, PosStart + 1, L - 1);
  end
  else
    Result := '';
end;

function StrChopRight(const S: string; N: Integer): string;
begin
  Result := Copy(S, 1, Length(S) - N);
end;

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

function StrMid(const S: string; Start, Count: Integer): string;
begin
  Result := Copy(S, Start, Count);
end;

function StrRestOf(const S: string; N: Integer): string;
begin
  Result := Copy(S, N, (Length(S) - N + 1));
end;

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

//=== Character (do we have it ;) ============================================

function CharEqualNoCase(const C1, C2: Char): Boolean;
begin
  //if they are not equal chars, may be same letter different case
  Result := (C1 = C2) or
    (CharIsAlpha(C1) and CharIsAlpha(C2) and (CharLower(C1) = CharLower(C2)));
end;


function CharIsAlpha(const C: Char): Boolean;
begin
  {$IFDEF CLR}
  Result := System.Char.IsLetter(C);
  {$ELSE}
  Result := (StrCharTypes[C] and C1_ALPHA) <> 0;
  {$ENDIF CLR}
end;

function CharIsAlphaNum(const C: Char): Boolean;
begin
  {$IFDEF CLR}
  Result := System.Char.IsLetterOrDigit(C);
  {$ELSE}
  Result := ((StrCharTypes[C] and C1_ALPHA) <> 0) or
    ((StrCharTypes[C] and C1_DIGIT) <> 0);
  {$ENDIF CLR}
end;

function CharIsBlank(const C: Char): Boolean;
begin
  {$IFDEF CLR}
  Result := System.Char.IsSurrogate(C);
  {$ELSE}
  Result := ((StrCharTypes[C] and C1_BLANK) <> 0);
  {$ENDIF CLR}
end;

function CharIsControl(const C: Char): Boolean;
begin
  {$IFDEF CLR}
  Result := System.Char.IsControl(C);
  {$ELSE}
  Result := (StrCharTypes[C] and C1_CNTRL) <> 0;
  {$ENDIF CLR}
end;

function CharIsDelete(const C: Char): Boolean;
begin
  Result := (C = #8);
end;

function CharIsDigit(const C: Char): Boolean;
begin
  {$IFDEF CLR}
  Result := System.Char.IsDigit(C);
  {$ELSE}
  Result := (StrCharTypes[C] and C1_DIGIT) <> 0;
  {$ENDIF CLR}
end;

function CharIsFracDigit(const C: Char): Boolean;
begin
  {$IFDEF CLR}
  Result := (C = '.') or System.Char.IsDigit(C);
  {$ELSE}
  Result := (C = '.') or ((StrCharTypes[C] and C1_DIGIT) <> 0);
  {$ENDIF CLR}
end;

function CharIsHexDigit(const C: Char): Boolean;
begin
  case C of
    'A'..'F',
    'a'..'f':
      Result := True;
  else
    {$IFDEF CLR}
    Result := System.Char.IsDigit(C);
    {$ELSE}
    Result := ((StrCharTypes[C] and C1_DIGIT) <> 0);
    {$ENDIF CLR}
  end;
end;

function CharIsLower(const C: Char): Boolean;
begin
  {$IFDEF CLR}
  Result := System.Char.IsLower(C);
  {$ELSE}
  Result := (StrCharTypes[C] and C1_LOWER) <> 0;
  {$ENDIF CLR}
end;

function CharIsNumberChar(const C: Char): Boolean;
begin
  {$IFDEF CLR}
  Result := System.Char.IsDigit(C) or (C = '+') or (C = '-') or (C = DecimalSeparator);
  {$ELSE}
  Result := ((StrCharTypes[C] and C1_DIGIT) <> 0) or (C = '+') or (C = '-') or (C = DecimalSeparator);
  {$ENDIF CLR}
end;

function CharIsNumber(const C: Char): Boolean;
begin
  {$IFDEF CLR}
  Result := System.Char.IsDigit(C) or (C = DecimalSeparator);
  {$ELSE}
  Result := ((StrCharTypes[C] and C1_DIGIT) <> 0) or (C = DecimalSeparator);
  {$ENDIF CLR}
end;

function CharIsPrintable(const C: Char): Boolean;
begin
  Result := not CharIsControl(C);
end;

function CharIsPunctuation(const C: Char): Boolean;
begin
  {$IFDEF CLR}
  Result := System.Char.IsPunctuation(C);
  {$ELSE}
  Result := ((StrCharTypes[C] and C1_PUNCT) <> 0);
  {$ENDIF CLR}
end;

function CharIsReturn(const C: Char): Boolean;
begin
  Result := (C = NativeLineFeed) or (C = NativeCarriageReturn);
end;

function CharIsSpace(const C: Char): Boolean;
begin
  {$IFDEF CLR}
  Result := System.Char.IsSeparator(C);
  {$ELSE}
  Result := (StrCharTypes[C] and C1_SPACE) <> 0;
  {$ENDIF CLR}
end;

function CharIsUpper(const C: Char): Boolean;
begin
  {$IFDEF CLR}
  Result := System.Char.IsUpper(C);
  {$ELSE}
  Result := (StrCharTypes[C] and C1_UPPER) <> 0;
  {$ENDIF CLR}
end;

function CharIsValidIdentifierLetter(const C: Char): Boolean;
begin
  case C of
    {$IFDEF SUPPORTS_UNICODE}
    // from XML specifications
    #$00C0..#$00D6, #$00D8..#$00F6, #$00F8..#$02FF, #$0370..#$037D,
    #$037F..#$1FFF, #$200C..#$200D, #$2070..#$218F, #$2C00..#$2FEF,
    #$3001..#$D7FF, #$F900..#$FDCF, #$FDF0..#$FFFD, // #$10000..#$EFFFF, howto match surrogate pairs?
    #$00B7, #$0300..#$036F, #$203F..#$2040,
    {$ENDIF SUPPORTS_UNICODE}
    '0'..'9', 'A'..'Z', 'a'..'z', '_':
      Result := True;
  else
    Result := False;
  end;
end;

function CharIsWhiteSpace(const C: Char): Boolean;
begin
  {$IFDEF CLR}
  Result := System.Char.IsWhiteSpace(C);
  {$ELSE}
  case C of
    NativeTab,
    NativeLineFeed,
    NativeVerticalTab,
    NativeFormFeed,
    NativeCarriageReturn,
    NativeSpace:
      Result := True;
  else
    Result := False;
  end;
  {$ENDIF CLR}
end;

function CharIsWildcard(const C: Char): Boolean;
begin
  case C of
    '*', '?':
      Result := True;
  else
    Result := False;
  end;
end;

{$IFNDEF CLR}
function CharType(const C: Char): Word;
begin
  Result := StrCharTypes[C];
end;

//=== PCharVector ============================================================

function StringsToPCharVector(var Dest: PCharVector; const Source: TStrings): PCharVector;
var
  I: Integer;
  S: string;
  List: array of PChar;
begin
  Assert(Source <> nil);
  Dest := AllocMem((Source.Count + SizeOf(Char)) * SizeOf(PChar));
  SetLength(List, Source.Count + SizeOf(Char));
  for I := 0 to Source.Count - 1 do
  begin
    S := Source[I];
    List[I] := StrAlloc(Length(S) + SizeOf(Char));
    StrPCopy(List[I], S);
  end;
  List[Source.Count] := nil;
  Move(List[0], Dest^, (Source.Count + 1) * SizeOf(PChar));
  Result := Dest;
end;

function PCharVectorCount(Source: PCharVector): Integer;
var
  P: PChar;
begin
  Result := 0;
  if Source <> nil then
  begin
    P := Source^;
    while P <> nil do
    begin
      Inc(Result);
      P := PCharVector(INT_PTR(Source) + (SizeOf(PChar) * Result))^;
    end;
  end;
end;

procedure PCharVectorToStrings(const Dest: TStrings; Source: PCharVector);
var
  I, Count: Integer;
  List:     array of PChar;
begin
  Assert(Dest <> nil);
  if Source <> nil then
  begin
    Count := PCharVectorCount(Source);
    SetLength(List, Count);
    Move(Source^, List[0], Count * SizeOf(PChar));
    Dest.BeginUpdate;
    try
      Dest.Clear;
      for I := 0 to Count - 1 do
        Dest.Add(List[I]);
    finally
      Dest.EndUpdate;
    end;
  end;
end;

procedure FreePCharVector(var Dest: PCharVector);
var
  I, Count: Integer;
  List:     array of PChar;
begin
  if Dest <> nil then
  begin
    Count := PCharVectorCount(Dest);
    SetLength(List, Count);
    Move(Dest^, List[0], Count * SizeOf(PChar));
    for I := 0 to Count - 1 do
      StrDispose(List[I]);
    FreeMem(Dest, (Count + 1) * SizeOf(PChar));
    Dest := nil;
  end;
end;
{$ENDIF ~CLR}

//=== Character Transformation Routines ======================================

function CharHex(const C: Char): Byte;
begin
  case C of
    '0'..'9':
      Result := Ord(C) - Ord('0');
    'a'..'f':
      Result := Ord(C) - Ord('a') + 10;
    'A'..'F':
      Result := Ord(C) - Ord('A') + 10;
  else
    Result := $FF;
  end;
end;

function CharLower(const C: Char): Char;
begin
  {$IFDEF CLR}
  Result := System.Char.ToLower(C);
  {$ELSE}
  Result := StrCaseMap[Ord(C) + StrLoOffset];
  {$ENDIF CLR}
end;

function CharToggleCase(const C: Char): Char;
begin
  {$IFDEF CLR}
  if System.Char.IsUpper(C) then
    Result := System.Char.ToLower(C)
  else
  if System.Char.IsLower(C) then
    Result := System.Char.ToUpper(C)
  else
    Result := C;
  {$ELSE}
  Result := StrCaseMap[Ord(C) + StrReOffset];
  {$ENDIF CLR}
end;

function CharUpper(const C: Char): Char;
begin
  {$IFDEF CLR}
  Result := System.Char.ToUpper(C);
  {$ELSE}
  Result := StrCaseMap[Ord(C) + StrUpOffset];
  {$ENDIF CLR}
end;

//=== Character Search and Replace ===========================================

function CharLastPos(const S: string; const C: Char; const Index: Integer): Integer;
begin
  if (Index > 0) and (Index <= Length(S)) then
  begin
    for Result := Length(S) downto Index do
      if S[Result] = C then
        Exit;
  end;
  Result := 0;
end;

function CharPos(const S: string; const C: Char; const Index: Integer): Integer;
begin
  if (Index > 0) and (Index <= Length(S)) then
  begin
    for Result := Index to Length(S) do
      if S[Result] = C then
        Exit;
  end;
  Result := 0;
end;

function CharIPos(const S: string; C: Char; const Index: Integer): Integer;
begin
  if (Index > 0) and (Index <= Length(S)) then
  begin
    C := CharUpper(C);
    for Result := Index to Length(S) do
      {$IFDEF CLR}
      if System.Char.ToUpper(S[Result]) = C then
      {$ELSE}
      if StrCaseMap[Ord(S[Result]) + StrUpOffset] = C then
      {$ENDIF CLR}
        Exit;
  end;
  Result := 0;
end;

function CharReplace(var S: string; const Search, Replace: Char): Integer;
{$IFDEF CLR}
var
  I: Integer;
begin
  Result := 0;
  for I := 1 to Length(S) do
    if S[I] = Search then
      Inc(Result);
  S := S.Replace(Search, Replace);
end;
{$ELSE}
var
  P: PChar;
  Index, Len: Integer;
begin
  Result := 0;
  if Search <> Replace then
  begin
    UniqueString(S);
    P := PChar(S);
    Len := Length(S);
    for Index := 0 to Len - 1 do
    begin
      if P^ = Search then
      begin
        P^ := Replace;
        Inc(Result);
      end;
      Inc(P);
    end;
  end;
end;
{$ENDIF CLR}

{$IFNDEF CLR}
//=== MultiSz ================================================================

function StringsToMultiSz(var Dest: PMultiSz; const Source: TStrings): PMultiSz;
var
  I, TotalLength: Integer;
  P: PMultiSz;
begin
  Assert(Source <> nil);
  TotalLength := 1;
  for I := 0 to Source.Count - 1 do
    if Source[I] = '' then
      raise EJclStringError.CreateRes(@RsInvalidEmptyStringItem)
    else
      Inc(TotalLength, StrLen(PChar(Source[I])) + 1);
  AllocateMultiSz(Dest, TotalLength);
  P := Dest;
  for I := 0 to Source.Count - 1 do
  begin
    P := StrECopy(P, PChar(Source[I]));
    Inc(P);
  end;
  P^ := #0;
  Result := Dest;
end;

procedure MultiSzToStrings(const Dest: TStrings; const Source: PMultiSz);
var
  P: PMultiSz;
begin
  Assert(Dest <> nil);
  Dest.BeginUpdate;
  try
    Dest.Clear;
    if Source <> nil then
    begin
      P := Source;
      while P^ <> #0 do
      begin
        Dest.Add(P);
        P := StrEnd(P);
        Inc(P);
      end;
    end;
  finally
    Dest.EndUpdate;
  end;
end;

function MultiSzLength(const Source: PMultiSz): Integer;
var
  P: PMultiSz;
begin
  Result := 0;
  if Source <> nil then
  begin
    P := Source;
    repeat
      Inc(Result, StrLen(P) + 1);
      P := StrEnd(P);
      Inc(P);
    until P^ = #0;
    Inc(Result);
  end;
end;

procedure AllocateMultiSz(var Dest: PMultiSz; Len: Integer);
begin
  if Len > 0 then
    GetMem(Dest, Len * SizeOf(Char))
  else
    Dest := nil;
end;

procedure FreeMultiSz(var Dest: PMultiSz);
begin
  if Dest <> nil then
    FreeMem(Dest);
  Dest := nil;
end;

function MultiSzDup(const Source: PMultiSz): PMultiSz;
var
  Len: Integer;
begin
  if Source <> nil then
  begin
    Len := MultiSzLength(Source);
    AllocateMultiSz(Result, Len);
    Move(Source^, Result^, Len * SizeOf(Char));
  end
  else
    Result := nil;
end;

function AnsiStringsToAnsiMultiSz(var Dest: PAnsiMultiSz; const Source: TAnsiStrings): PAnsiMultiSz;
begin
  Result := JclAnsiStrings.StringsToMultiSz(Dest, Source);
end;

procedure AnsiMultiSzToAnsiStrings(const Dest: TAnsiStrings; const Source: PAnsiMultiSz);
begin
  JclAnsiStrings.MultiSzToStrings(Dest, Source);
end;

function AnsiMultiSzLength(const Source: PAnsiMultiSz): Integer;
begin
  Result := JclAnsiStrings.MultiSzLength(Source);
end;

procedure AllocateAnsiMultiSz(var Dest: PAnsiMultiSz; Len: Integer);
begin
  JclAnsiStrings.AllocateMultiSz(Dest, Len);
end;

procedure FreeAnsiMultiSz(var Dest: PAnsiMultiSz);
begin
  JclAnsiStrings.FreeMultiSz(Dest);
end;

function AnsiMultiSzDup(const Source: PAnsiMultiSz): PAnsiMultiSz;
begin
  Result := JclAnsiStrings.MultiSzDup(Source);
end;

function WideStringsToWideMultiSz(var Dest: PWideMultiSz; const Source: TWideStrings): PWideMultiSz;
begin
  Result := JclWideStrings.StringsToMultiSz(Dest, Source);
end;

procedure WideMultiSzToWideStrings(const Dest: TWideStrings; const Source: PWideMultiSz);
begin
  JclWideStrings.MultiSzToStrings(Dest, Source);
end;

function WideMultiSzLength(const Source: PWideMultiSz): Integer;
begin
  Result := JclWideStrings.MultiSzLength(Source);
end;

procedure AllocateWideMultiSz(var Dest: PWideMultiSz; Len: Integer);
begin
  JclWideStrings.AllocateMultiSz(Dest, Len);
end;

procedure FreeWideMultiSz(var Dest: PWideMultiSz);
begin
  JclWideStrings.FreeMultiSz(Dest);
end;

function WideMultiSzDup(const Source: PWideMultiSz): PWideMultiSz;
begin
  Result := JclWideStrings.MultiSzDup(Source);
end;
{$ENDIF ~CLR}

//=== TStrings Manipulation ==================================================

procedure StrToStrings(S, Sep: string; const List: TStrings; const AllowEmptyString: Boolean = True);
var
  I, L: Integer;
  Left: string;
begin
  Assert(List <> nil);
  List.BeginUpdate;
  try
    List.Clear;
    L := Length(Sep);
    I := Pos(Sep, S);
    while I > 0 do
    begin
      Left := StrLeft(S, I - 1);
      if (Left <> '') or AllowEmptyString then
        List.Add(Left);
      Delete(S, 1, I + L - 1);
      I := Pos(Sep, S);
    end;
    if S <> '' then
      List.Add(S);  // Ignore empty strings at the end.
  finally
    List.EndUpdate;
  end;
end;

procedure StrIToStrings(S, Sep: string; const List: TStrings; const AllowEmptyString: Boolean = True);
var
  I, L: Integer;
  LowerCaseStr: string;
  Left: string;
begin
  Assert(List <> nil);
  LowerCaseStr := StrLower(S);
  Sep := StrLower(Sep);
  L := Length(Sep);
  I := Pos(Sep, LowerCaseStr);
  List.BeginUpdate;
  try
    List.Clear;
    while I > 0 do
    begin
      Left := StrLeft(S, I - 1);
      if (Left <> '') or AllowEmptyString then
        List.Add(Left);
      Delete(S, 1, I + L - 1);
      Delete(LowerCaseStr, 1, I + L - 1);
      I := Pos(Sep, LowerCaseStr);
    end;
    if S <> '' then
      List.Add(S);  // Ignore empty strings at the end.
  finally
    List.EndUpdate;
  end;
end;

function StringsToStr(const List: TStrings; const Sep: string; const AllowEmptyString: Boolean): string;
var
  I, L: Integer;
begin
  Result := '';
  for I := 0 to List.Count - 1 do
  begin
    if (List[I] <> '') or AllowEmptyString then
    begin
      // don't combine these into one addition, somehow it hurts performance
      Result := Result + List[I];
      Result := Result + Sep;
    end;
  end;
  // remove terminating separator
  if List.Count <> 0 then
  begin
    L := Length(Sep);
    Delete(Result, Length(Result) - L + 1, L);
  end;
end;

procedure TrimStrings(const List: TStrings; DeleteIfEmpty: Boolean);
var
  I: Integer;
begin
  Assert(List <> nil);
  List.BeginUpdate;
  try
    for I := List.Count - 1 downto 0 do
    begin
      List[I] := Trim(List[I]);
      if (List[I] = '') and DeleteIfEmpty then
        List.Delete(I);
    end;
  finally
    List.EndUpdate;
  end;
end;

procedure TrimStringsRight(const List: TStrings; DeleteIfEmpty: Boolean);
var
  I: Integer;
begin
  Assert(List <> nil);
  List.BeginUpdate;
  try
    for I := List.Count - 1 downto 0 do
    begin
      List[I] := TrimRight(List[I]);
      if (List[I] = '') and DeleteIfEmpty then
        List.Delete(I);
    end;
  finally
    List.EndUpdate;
  end;
end;

procedure TrimStringsLeft(const List: TStrings; DeleteIfEmpty: Boolean);
var
  I: Integer;
begin
  Assert(List <> nil);
  List.BeginUpdate;
  try
    for I := List.Count - 1 downto 0 do
    begin
      List[I] := TrimLeft(List[I]);
      if (List[I] = '') and DeleteIfEmpty then
        List.Delete(I);
    end;
  finally
    List.EndUpdate;
  end;
end;

function AddStringToStrings(const S: string; Strings: TStrings; const Unique: Boolean): Boolean;
begin
  Assert(Strings <> nil);
  Result := Unique and (Strings.IndexOf(S) <> -1);
  if not Result then
    Result := Strings.Add(S) > -1;
end;

//=== Miscellaneous ==========================================================

{$IFDEF KEEP_DEPRECATED}
function BooleanToStr(B: Boolean): string;
const
  Bools: array [Boolean] of string = ('False', 'True');
begin
  Result := Bools[B];
end;
{$ENDIF KEEP_DEPRECATED}

function FileToString(const FileName: string): {$IFDEF COMPILER12_UP}RawByteString{$ELSE}AnsiString{$ENDIF};
var
  fs: TFileStream;
  Len: Integer;
  {$IFDEF CLR}
  Buf: array of Byte;
  {$ENDIF CLR}
begin
  fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    Len := fs.Size;
    SetLength(Result, Len);
    if Len > 0 then
    {$IFDEF CLR}
    begin
      SetLength(Buf, Len);
      fs.ReadBuffer(Buf, Len);
      Result := Buf;
    end;
    {$ELSE}
      fs.ReadBuffer(Result[1], Len);
    {$ENDIF CLR}
  finally
    fs.Free;
  end;
end;

procedure StringToFile(const FileName: string; const Contents: {$IFDEF COMPILER12_UP}RawByteString{$ELSE}AnsiString{$ENDIF};
  Append: Boolean);
var
  FS: TFileStream;
  Len: Integer;
begin
  if Append and FileExists(filename) then
    FS := TFileStream.Create(FileName, fmOpenReadWrite or fmShareDenyWrite)
  else
    FS := TFileStream.Create(FileName, fmCreate);
  try
    if Append then
      StreamSeek(FS, 0, soEnd);  // faster than .Position := .Size
    Len := Length(Contents);
    if Len > 0 then
      {$IFDEF CLR}
      FS.WriteBuffer(BytesOf(Contents), Len);
      {$ELSE}
      FS.WriteBuffer(Contents[1], Len);
      {$ENDIF CLR}
  finally
    FS.Free;
  end;
end;

function StrToken(var S: string; Separator: Char): string;
var
  I: Integer;
begin
  I := Pos(Separator, S);
  if I <> 0 then
  begin
    Result := Copy(S, 1, I - 1);
    Delete(S, 1, I);
  end
  else
  begin
    Result := S;
    S := '';
  end;
end;

{$IFDEF CLR}
procedure StrTokens(const S: string; const List: TStrings);
var
  Start: Integer;
  Token: string;
  Done: Boolean;
begin
  Assert(List <> nil);
  if List = nil then
    Exit;

  List.BeginUpdate;
  try
    List.Clear;
    Start := 0;
    repeat
      Done := StrWord(S, Start, Token);
      if Token <> '' then
        List.Add(Token);
    until Done;
  finally
    List.EndUpdate;
  end;
end;

function StrWord(const S: string; var Index: Integer; out Word: string): Boolean;
var
  Start: Integer;
  C: Char;
begin
  Word := '';
  if (S = nil) or (S = '') then
  begin
    Result := True;
    Exit;
  end;
  Start := Index;
  Result := False;
  while True do
  begin
    case S[Index] of
      #0:
        begin
          if Start <> 0 then
            Word := S.Substring(Start, Index - Start);
          Result := True;
          Exit;
        end;
      NativeSpace, NativeLineFeed, NativeCarriageReturn:
        begin
          if Start <> 0 then
          begin
            Word := S.Substring(Start, Index - Start);
            Exit;
          end
          else
          begin
            C := S[Index];
            while (C = NativeSpace) or (C = NativeLineFeed) or (C = NativeCarriageReturn) do
            begin
              Inc(Index);
              C := S[Index];
            end;
          end;

        end;
    else
      if Start = 0 then
        Start := Index;
      Inc(Index);
    end;
  end;
end;

{$ELSE}

procedure StrTokens(const S: string; const List: TStrings);
var
  Start: PChar;
  Token: string;
  Done:  Boolean;
begin
  Assert(List <> nil);
  if List = nil then
    Exit;

  List.BeginUpdate;
  try
    List.Clear;
    Start := Pointer(S);
    repeat
      Done := StrWord(Start, Token);
      if Token <> '' then
        List.Add(Token);
    until Done;
  finally
    List.EndUpdate;
  end;
end;

function StrWord(var S: PChar; out Word: string): Boolean;
var
  Start: PChar;
begin
  Word := '';
  if S = nil then
  begin
    Result := True;
    Exit;
  end;
  Start := nil;
  Result := False;
  while True do
  begin
    case S^ of
      #0:
      begin
        if Start <> nil then
          SetString(Word, Start, S - Start);
        Result := True;
        Exit;
      end;
      NativeSpace, NativeLineFeed, NativeCarriageReturn:
      begin
        if Start <> nil then
        begin
          SetString(Word, Start, S - Start);
          Exit;
        end
        else
          while CharIsWhiteSpace(S^) do
            Inc(S);
      end;
    else
      if Start = nil then
        Start := S;
      Inc(S);
    end;
  end;
end;
{$ENDIF ~CLR}

procedure StrTokenToStrings(S: string; Separator: Char; const List: TStrings);
var
  Token: string;
begin
  Assert(List <> nil);

  if List = nil then
    Exit;

  List.BeginUpdate;
  try
    List.Clear;
    while S <> '' do
    begin
      Token := StrToken(S, Separator);
      List.Add(Token);
    end;
  finally
    List.EndUpdate;
  end;
end;

function StrToFloatSafe(const S: string): Float;
var
  Temp: string;
  I, J, K: Integer;
  SwapSeparators, IsNegative: Boolean;
  DecSep, ThouSep, C: Char;
  {$IFDEF CLR}
  sb: StringBuilder;
  {$ENDIF CLR}
begin
  {$IFDEF CLR}
  DecSep := Char(DecimalSeparator[1]);
  ThouSep := Char(ThousandSeparator[1]);
  {$ELSE}
  DecSep := DecimalSeparator;
  ThouSep := ThousandSeparator;
  {$ENDIF CLR}
  Temp := S;
  SwapSeparators := False;

  IsNegative := False;
  J := 0;
  for I := 1 to Length(Temp) do
  begin
    C := Temp[I];
    if C = '-' then
      IsNegative := not IsNegative
    else
    if (C <> ' ') and (C <> '(') and (C <> '+') then
    begin
        // if it appears prior to any digit, it has to be a decimal separator
      SwapSeparators := Temp[I] = ThouSep;
      J := I;
      Break;
    end;
  end;

  if not SwapSeparators then
  begin
    K := CharPos(Temp, DecSep);
    SwapSeparators :=
      // if it appears prior to any digit, it has to be a decimal separator
      (K > J) and
      // if it appears multiple times, it has to be a thousand separator
      ((StrCharCount(Temp, DecSep) > 1) or
      // we assume (consistent with Windows Platform SDK documentation),
      // that thousand separators appear only to the left of the decimal
      (K < CharPos(Temp, ThouSep)));
  end;

  if SwapSeparators then
  begin
    // assume a numerical string from a different locale,
    // where DecimalSeparator and ThousandSeparator are exchanged
    {$IFDEF CLR}
    sb := StringBuilder.Create(Temp);
    for I := 0 to sb.Length - 1 do
      if sb[I] = DecimalSeparator then
        sb[I] := ThouSep
      else
      if sb[I] = ThousandSeparator then
        sb[I] := DecSep;
    Temp := sb.ToString;
    {$ELSE}
    for I := 1 to Length(Temp) do
      if Temp[I] = DecSep then
        Temp[I] := ThouSep
      else
      if Temp[I] = ThouSep then
        Temp[I] := DecSep;
    {$ENDIF CLR}
  end;

  Temp := StrKeepChars(Temp, CharIsNumber);

  if Length(Temp) > 0 then
  begin
    if Temp[1] = DecSep then
      Temp := '0' + Temp;
    if Temp[Length(Temp)] = DecSep then
      Temp := Temp + '0';
    Result := StrToFloat(Temp);
    if IsNegative then
      Result := -Result;
  end
  else
    Result := 0.0;
end;

function StrToIntSafe(const S: string): Integer;
begin
  Result := Trunc(StrToFloatSafe(S));
end;

procedure StrNormIndex(const StrLen: Integer; var Index: Integer; var Count: Integer); overload;
begin
  Index := Max(1, Min(Index, StrLen + 1));
  Count := Max(0, Min(Count, StrLen + 1 - Index));
end;

{$IFDEF CLR}
function ArrayOf(List: TStrings): TDynStringArray;
var
  I: Integer;
begin
  if List <> nil then
  begin
    SetLength(Result, List.Count);
    for I := 0 to List.Count - 1 do
      Result[I] := List[I];
  end
  else
    Result := nil;
end;
{$ENDIF CLR}

{$IFDEF COMPILER5} // missing Delphi 5 functions
function TryStrToInt(const S: string; out Value: Integer): Boolean;
var
  Err: Integer;
begin
  Val(S, Value, Err);
  Result := Err = 0;
end;

function TryStrToInt64(const S: string; out Value: Int64): Boolean;
var
  Err: Integer;
begin
  Val(S, Value, Err);
  Result := Err = 0;
end;

function TryStrToFloat(const S: string; out Value: Extended): Boolean;
begin
  Result := TextToFloat(PChar(S), Value, fvExtended);
end;

function TryStrToFloat(const S: string; out Value: Double): Boolean;
var
  F: Extended;
begin
  Result := TryStrToFloat(S, F);
  if Result then
    Value := F;
end;

function TryStrToFloat(const S: string; out Value: Single): Boolean;
var
  F: Extended;
begin
  Result := TryStrToFloat(S, F);
  if Result then
    Value := F;
end;

function TryStrToCurr(const S: string; out Value: Currency): Boolean;
begin
  Result := TextToFloat(PChar(S), Value, fvCurrency);
end;
{$ENDIF COMPILER5}

{$IFDEF CLR}

function DotNetFormat(const Fmt: string; const Args: array of System.Object): string;
begin
  Result := System.String.Format(Fmt, Args);
end;

function DotNetFormat(const Fmt: string; const Arg0: System.Object): string;
begin
  Result := System.String.Format(Fmt, Arg0);
end;

function DotNetFormat(const Fmt: string; const Arg0, Arg1: System.Object): string;
begin
  Result := System.String.Format(Fmt, Arg0, Arg1);
end;

function DotNetFormat(const Fmt: string; const Arg0, Arg1, Arg2: System.Object): string;
begin
  Result := System.String.Format(Fmt, Arg0, Arg1, Arg2);
end;

{$ELSE}

const
  BoolToStr: array [Boolean] of string = ('false', 'true');
  {$IFDEF COMPILER5}
  MaxCurrency: Currency = 922337203685477.5807;

  varShortInt = $0010; { vt_i1     16 }
  varWord     = $0012; { vt_ui2    18 }
  varLongWord = $0013; { vt_ui4    19 }
  varInt64    = $0014; { vt_i8     20 }
  {$ENDIF COMPILER5}

type
  TInterfacedObjectAccess = class(TInterfacedObject);

procedure MoveChar(const Source; var Dest; Count: Integer);
begin
  if Count > 0 then
    Move(Source, Dest, Count * SizeOf(Char));
end;

function DotNetFormat(const Fmt: string; const Arg0: Variant): string;
begin
  Result := DotNetFormat(Fmt, [Arg0]);
end;

function DotNetFormat(const Fmt: string; const Arg0, Arg1: Variant): string;
begin
  Result := DotNetFormat(Fmt, [Arg0, Arg1]);
end;

function DotNetFormat(const Fmt: string; const Arg0, Arg1, Arg2: Variant): string;
begin
  Result := DotNetFormat(Fmt, [Arg0, Arg1, Arg2]);
end;

function DotNetFormat(const Fmt: string; const Args: array of const): string;
var
  F, P: PChar;
  Len, Capacity, Count: Integer;
  Index, ErrorCode: Integer;
  S:    string;

  procedure Grow(Count: Integer);
  begin
    if Len + Count > Capacity then
    begin
      Capacity := Capacity * 5 div 3 + Count;
      SetLength(Result, Capacity);
    end;
  end;

  function InheritsFrom(AClass: TClass; const ClassName: string): Boolean;
  begin
    Result := True;
    while AClass <> nil do
    begin
      if CompareText(AClass.ClassName, ClassName) = 0 then
        Exit;
      AClass := AClass.ClassParent;
    end;
    Result := False;
  end;

  function GetStringOf(const V: TVarData; Index: Integer): string; overload;
  begin
    case V.VType of
      varEmpty, varNull:
        raise ArgumentNullException.CreateRes(@RsArgumentIsNull);
      varSmallInt:
        Result := IntToStr(V.VSmallInt);
      varInteger:
        Result := IntToStr(V.VInteger);
      varSingle:
        Result := FloatToStr(V.VSingle);
      varDouble:
        Result := FloatToStr(V.VDouble);
      varCurrency:
        Result := CurrToStr(V.VCurrency);
      varDate:
        Result := DateTimeToStr(V.VDate);
      varOleStr:
        Result := V.VOleStr;
      varBoolean:
        Result := BoolToStr[V.VBoolean <> False];
      varByte:
        Result := IntToStr(V.VByte);
      {$IFDEF COMPILER5}
      varWord:
        Result := IntToStr(Word(V.VSmallint));
      varShortInt:
        Result := IntToStr(ShortInt(V.VByte));
      varLongWord:
        Result := IntToStr(V.VError);
      {$ELSE}
      varWord:
        Result := IntToStr(V.VWord);
      varShortInt:
        Result := IntToStr(V.VShortInt);
      varLongWord:
        Result := IntToStr(V.VLongWord);
      varInt64:
        Result := IntToStr(V.VInt64);
      {$ENDIF COMPILER5}
      varString:
        Result := string(V.VString);

      {varArray,
      varDispatch,
      varError,
      varUnknown,
      varAny,
      varByRef:}
    else
      raise ArgumentNullException.CreateResFmt(@RsDotNetFormatArgumentNotSupported, [Index]);
    end;
  end;

  function GetStringOf(Index: Integer): string; overload;
  var
    V: TVarRec;
    Intf: IToString;
  begin
    V := Args[Index];
    if (V.VInteger = 0) and
      (V.VType in [vtExtended, vtString, vtObject, vtClass, vtCurrency,
      vtInterface, vtInt64]) then
      raise ArgumentNullException.CreateResFmt(@RsArgumentIsNull, [Index]);

    case V.VType of
      vtInteger:
        Result := IntToStr(V.VInteger);
      vtBoolean:
        Result := BoolToStr[V.VBoolean];
      vtChar:
        Result := string(AnsiString(V.VChar));
      vtExtended:
        Result := FloatToStr(V.VExtended^);
      vtString:
        Result := string(V.VString^);
      vtPointer:
        Result := IntToHex(DWORD_PTR(V.VPointer), 8);
      vtPChar:
        Result := string(AnsiString(V.VPChar));
      vtObject:
        if (V.VObject is TInterfacedObject) and V.VObject.GetInterface(IToString, Intf) then
        begin
          Result := Intf.ToString;
          Pointer(Intf) := nil; // do not release the object
          // undo the RefCount change
          Dec(TInterfacedObjectAccess(V.VObject).FRefCount);
        end
        else
        if InheritsFrom(V.VObject.ClassType, 'TComponent') and V.VObject.GetInterface(IToString, Intf) then
          Result := Intf.ToString
        else
          raise ArgumentNullException.CreateResFmt(@RsDotNetFormatArgumentNotSupported, [Index]);
      vtClass:
        Result := V.VClass.ClassName;
      vtWideChar:
        Result := V.VWideChar;
      vtPWideChar:
        Result := V.VPWideChar;
      vtAnsiString:
        Result := string(V.VAnsiString);
      vtCurrency:
        Result := CurrToStr(V.VCurrency^);
      vtVariant:
        Result := GetStringOf(TVarData(V.VVariant^), Index);
      vtInterface:
        if IInterface(V.VInterface).QueryInterface(IToString, Intf) = 0 then
          Result := IToString(Intf).ToString
        else
          raise ArgumentNullException.CreateResFmt(@RsDotNetFormatArgumentNotSupported, [Index]);
      vtWideString:
        Result := WideString(V.VWideString);
      vtInt64:
        Result := IntToStr(V.VInt64^);
      {$IFDEF SUPPORTS_UNICODE_STRING}
      vtUnicodeString:
        Result := UnicodeString(V.VUnicodeString);
      {$ENDIF SUPPORTS_UNICODE_STRING}
    else
      raise ArgumentNullException.CreateResFmt(@RsDotNetFormatArgumentNotSupported, [Index]);
    end;
  end;

begin
  if Length(Args) = 0 then
  begin
    Result := Fmt;
    Exit;
  end;
  Len := 0;
  Capacity := Length(Fmt);
  SetLength(Result, Capacity);
  if Capacity = 0 then
    raise ArgumentNullException.CreateRes(@RsDotNetFormatNullFormat);

  P := Pointer(Fmt);
  F := P;
  while True do
  begin
    if (P[0] = #0) or (P[0] = '{') then
    begin
      Count := P - F;
      Inc(P);
      if (P[-1] <> #0) and (P[0] = '{') then
        Inc(Count); // include '{'

      if Count > 0 then
      begin
        Grow(Count);
        MoveChar(F[0], Result[Len + 1], Count);
        Inc(Len, Count);
      end;

      if P[-1] = #0 then
        Break;

      if P[0] <> '{' then
      begin
        F := P;
        Inc(P);
        while (P[0] <> #0) and (P[0] <> '}') do
          Inc(P);
        SetString(S, F, P - F);
        Val(S, Index, ErrorCode);
        if ErrorCode <> 0 then
          raise FormatException.CreateRes(@RsFormatException);
        if (Index < 0) or (Index > High(Args)) then
          raise FormatException.CreateRes(@RsFormatException);
        S := GetStringOf(Index);
        if S <> '' then
        begin
          Grow(Length(S));
          MoveChar(S[1], Result[Len + 1], Length(S));
          Inc(Len, Length(S));
        end;

        if P[0] = #0 then
          Break;
      end;
      F := P + 1;
    end
    else
    if (P[0] = '}') and (P[1] = '}') then
    begin
      Count := P - F + 1;
      Inc(P); // skip next '}'

      Grow(Count);
      MoveChar(F[0], Result[Len + 1], Count);
      Inc(Len, Count);
      F := P + 1;
    end;

    Inc(P);
  end;

  SetLength(Result, Len);
end;

//=== { TJclStringBuilder } =====================================================

constructor TJclStringBuilder.Create(Capacity: Integer; MaxCapacity: Integer);
begin
  inherited Create;
  SetLength(FChars, Capacity);
  FMaxCapacity := MaxCapacity;
end;

constructor TJclStringBuilder.Create(const Value: string; Capacity: Integer);
begin
  Create(Capacity);
  Append(Value);
end;

constructor TJclStringBuilder.Create(const Value: string; StartIndex,
  Length, Capacity: Integer);
begin
  Create(Capacity);
  Append(Value, StartIndex + 1, Length);
end;

function TJclStringBuilder.ToString: string;
begin
  if FLength > 0 then
    SetString(Result, PChar(@FChars[0]), FLength)
  else
    Result := '';
end;

function TJclStringBuilder.EnsureCapacity(Capacity: Integer): Integer;
begin
  if System.Length(FChars) < Capacity then
    SetCapacity(Capacity);
  Result := System.Length(FChars);
end;

procedure TJclStringBuilder.SetCapacity(const Value: Integer);
begin
  if Value <> System.Length(FChars) then
  begin
    SetLength(FChars, Value);
    if Value < FLength then
      FLength := Value;
  end;
end;

function TJclStringBuilder.GetChars(Index: Integer): Char;
begin
  Result := FChars[Index];
end;

procedure TJclStringBuilder.SetChars(Index: Integer; const Value: Char);
begin
  FChars[Index] := Value;
end;

procedure TJclStringBuilder.Set_Length(const Value: Integer);
begin
  FLength := Value;
end;

function TJclStringBuilder.GetCapacity: Integer;
begin
  Result := System.Length(FChars);
end;

function TJclStringBuilder.AppendPChar(Value: PChar; Count: Integer; RepeatCount: Integer): TJclStringBuilder;
var
  Capacity: Integer;
begin
  if (Count > 0) and (RepeatCount > 0) then
  begin
    repeat
      Capacity := System.Length(FChars);
      if Capacity + Count > MaxCapacity then
        raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange);
      if Capacity < FLength + Count then
        SetLength(FChars, Capacity * 5 div 3 + Count);
      if Count = 1 then
        FChars[FLength] := Value[0]
      else
        MoveChar(Value[0], FChars[FLength], Count);
      Inc(FLength, Count);
      Dec(RepeatCount);
    until RepeatCount <= 0;
  end;
  Result := Self;
end;

function TJclStringBuilder.InsertPChar(Index: Integer; Value: PChar; Count,
  RepeatCount: Integer): TJclStringBuilder;
var
  Capacity: Integer;
begin
  if (Index < 0) or (Index > FLength) then
    raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange);

  if Index = FLength then
    AppendPChar(Value, Count, RepeatCount)
  else
  if (Count > 0) and (RepeatCount > 0) then
  begin
    repeat
      Capacity := System.Length(FChars);
      if Capacity + Count > MaxCapacity then
        raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange);
      if Capacity < FLength + Count then
        SetLength(FChars, Capacity * 5 div 3 + Count);
      MoveChar(FChars[Index], FChars[Index + Count], FLength - Index);
      if Count = 1 then
        FChars[Index] := Value[0]
      else
        MoveChar(Value[0], FChars[Index], Count);
      Inc(FLength, Count);

      Dec(RepeatCount);

      Inc(Index, Count); // little optimization
    until RepeatCount <= 0;
  end;
  Result := Self;
end;

function TJclStringBuilder.Append(const Value: array of Char): TJclStringBuilder;
var
  Len: Integer;
begin
  Len := System.Length(Value);
  if Len > 0 then
    AppendPChar(@Value[0], Len);
  Result := Self;
end;

function TJclStringBuilder.Append(const Value: array of Char; StartIndex, Length: Integer): TJclStringBuilder;
var
  Len: Integer;
begin
  Len := System.Length(Value);
  if (Length > 0) and (StartIndex < Len) then
  begin
    if StartIndex + Length > Len then
      Length := Len - StartIndex;
    AppendPChar(PChar(@Value[0]) + StartIndex, Length);
  end;
  Result := Self;
end;

function TJclStringBuilder.Append(Value: Char; RepeatCount: Integer = 1): TJclStringBuilder;
begin
  Result := AppendPChar(@Value, 1, RepeatCount);
end;

function TJclStringBuilder.Append(const Value: string): TJclStringBuilder;
var
  Len: Integer;
begin
  Len := System.Length(Value);
  if Len > 0 then
    AppendPChar(Pointer(Value), Len);
  Result := Self;
end;

function TJclStringBuilder.Append(const Value: string; StartIndex, Length: Integer): TJclStringBuilder;
var
  Len: Integer;
begin
  Len := System.Length(Value);
  if (Length > 0) and (StartIndex < Len) then
  begin
    if StartIndex + Length > Len then
      Length := Len - StartIndex;
    AppendPChar(PChar(Pointer(Value)) + StartIndex, Length);
  end;
  Result := Self;
end;

function TJclStringBuilder.Append(Value: Boolean): TJclStringBuilder;
begin
  Result := Append(BoolToStr[Value]);
end;

function TJclStringBuilder.Append(Value: Cardinal): TJclStringBuilder;
begin
  Result := Append(IntToStr(Value));
end;

function TJclStringBuilder.Append(Value: Integer): TJclStringBuilder;
begin
  Result := Append(IntToStr(Value));
end;

function TJclStringBuilder.Append(Value: Double): TJclStringBuilder;
begin
  Result := Append(FloatToStr(Value));
end;

function TJclStringBuilder.Append(Value: Int64): TJclStringBuilder;
begin
  Result := Append(IntToStr(Value));
end;

function TJclStringBuilder.Append(Obj: TObject): TJclStringBuilder;
begin
  Result := Append(DotNetFormat('{0}', [Obj]));
end;

function TJclStringBuilder.AppendFormat(const Fmt: string; Arg0: Variant): TJclStringBuilder;
begin
  Result := Append(DotNetFormat(Fmt, [Arg0]));
end;

function TJclStringBuilder.AppendFormat(const Fmt: string; Arg0, Arg1: Variant): TJclStringBuilder;
begin
  Result := Append(DotNetFormat(Fmt, [Arg0, Arg1]));
end;

function TJclStringBuilder.AppendFormat(const Fmt: string; Arg0, Arg1, Arg2: Variant): TJclStringBuilder;
begin
  Result := Append(DotNetFormat(Fmt, [Arg0, Arg1, Arg2]));
end;

function TJclStringBuilder.AppendFormat(const Fmt: string; const Args: array of const): TJclStringBuilder;
begin
  Result := Append(DotNetFormat(Fmt, Args));
end;

function TJclStringBuilder.Insert(Index: Integer; const Value: array of Char): TJclStringBuilder;
var
  Len: Integer;
begin
  Len := System.Length(Value);
  if Len > 0 then
    InsertPChar(Index, @Value[0], Len);
  Result := Self;
end;

function TJclStringBuilder.Insert(Index: Integer; const Value: string; Count: Integer): TJclStringBuilder;
var
  Len: Integer;
begin
  Len := System.Length(Value);
  if Len > 0 then
    InsertPChar(Index, Pointer(Value), Len, Count);
  Result := Self;
end;

function TJclStringBuilder.Insert(Index: Integer; Value: Boolean): TJclStringBuilder;
begin
  Result := Insert(Index, BoolToStr[Value]);
end;

function TJclStringBuilder.Insert(Index: Integer; const Value: array of Char;
  StartIndex, Length: Integer): TJclStringBuilder;
var
  Len: Integer;
begin
  Len := System.Length(Value);
  if (Length > 0) and (StartIndex < Len) then
  begin
    if StartIndex + Length > Len then
      Length := Len - StartIndex;
    InsertPChar(Index, PChar(@Value[0]) + StartIndex, Length);
  end;
  Result := Self;
end;

function TJclStringBuilder.Insert(Index: Integer; Value: Double): TJclStringBuilder;
begin
  Result := Insert(Index, FloatToStr(Value));
end;

function TJclStringBuilder.Insert(Index: Integer; Value: Int64): TJclStringBuilder;
begin
  Result := Insert(Index, IntToStr(Value));
end;

function TJclStringBuilder.Insert(Index: Integer; Value: Cardinal): TJclStringBuilder;
begin
  Result := Insert(Index, IntToStr(Value));
end;

function TJclStringBuilder.Insert(Index, Value: Integer): TJclStringBuilder;
begin
  Result := Insert(Index, IntToStr(Value));
end;

function TJclStringBuilder.Insert(Index: Integer; Obj: TObject): TJclStringBuilder;
begin
  Result := Insert(Index, Format('{0}', [Obj]));
end;

function TJclStringBuilder.Remove(StartIndex, Length: Integer): TJclStringBuilder;
begin
  if (StartIndex < 0) or (Length < 0) or (StartIndex + Length > FLength) then
    raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange);
  if Length > 0 then
  begin
    MoveChar(FChars[StartIndex + Length], FChars[StartIndex], Length);
    Dec(FLength, Length);
  end;
  Result := Self;
end;

function TJclStringBuilder.Replace(OldChar, NewChar: Char; StartIndex,
  Count: Integer): TJclStringBuilder;
var
  I: Integer;
begin
  if Count = -1 then
    Count := FLength;
  if (StartIndex < 0) or (Count < 0) or (StartIndex + Count > FLength) then
    raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange);
  if (Count > 0) and (OldChar <> NewChar) then
  begin
    for I := StartIndex to StartIndex + Length - 1 do
      if FChars[I] = OldChar then
        FChars[I] := NewChar;
  end;
  Result := Self;
end;

function TJclStringBuilder.Replace(OldValue, NewValue: string; StartIndex, Count: Integer): TJclStringBuilder;
var
  I: Integer;
  Offset: Integer;
  NewLen, OldLen, Capacity: Integer;
begin
  if Count = -1 then
    Count := FLength;
  if (StartIndex < 0) or (Count < 0) or (StartIndex + Count > FLength) then
    raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange);
  if OldValue = '' then
    raise ArgumentException.CreateResFmt(@RsArgumentIsNull, [0]);

  if (Count > 0) and (OldValue <> NewValue) then
  begin
    OldLen := System.Length(OldValue);
    NewLen := System.Length(NewValue);
    Offset := NewLen - OldLen;
    Capacity := System.Length(FChars);
    for I := StartIndex to StartIndex + Length - 1 do
      if FChars[I] = OldValue[1] then
      begin
        if OldLen > 1 then
          if StrLComp(@FChars[I + 1], PChar(OldValue) + 1, OldLen - 1) <> 0 then
            Continue;
        if Offset <> 0 then
        begin
          if FLength - OldLen + NewLen > MaxCurrency then
            raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange);
          if Capacity < FLength + Offset then
          begin
            Capacity := Capacity * 5 div 3 + Offset;
            SetLength(FChars, Capacity);
          end;
          if Offset < 0 then
            MoveChar(FChars[I - Offset], FChars[I], FLength - I)
          else
            MoveChar(FChars[I + OldLen], FChars[I + OldLen + Offset], FLength - OldLen - I);
          Inc(FLength, Offset);
        end;
        if NewLen > 0 then
        begin
          if (OldLen = 1) and (NewLen = 1) then
            FChars[I] := NewValue[1]
          else
            MoveChar(NewValue[1], FChars[I], NewLen);
        end;
      end;
  end;
  Result := Self;
end;
{$ENDIF CLR}

{$IFNDEF CLR}
function StrExpandTabs(S: string): string;
begin
  // use an empty tab set, which will default to a tab width of 2
  Result := TJclTabSet(nil).Expand(s);
end;

function StrExpandTabs(S: string; TabWidth: Integer): string;
var
  TabSet: TJclTabSet;
begin
  // create a tab set with no tab stops and the given tab width
  TabSet := TJclTabSet.Create(TabWidth);
  try
    Result := TabSet.Expand(S);
  finally
    TabSet.Free;
  end;
end;

function StrExpandTabs(S: string; TabSet: TJclTabSet): string;
begin
  // use the provided tab set to perform the expansion
  Result := TabSet.Expand(S);
end;

function StrOptimizeTabs(S: string): string;
begin
  // use an empty tab set, which will default to a tab width of 2
  Result := TJclTabSet(nil).Optimize(s);
end;

function StrOptimizeTabs(S: string; TabWidth: Integer): string;
var
  TabSet: TJclTabSet;
begin
  // create a tab set with no tab stops and the given tab width
  TabSet := TJclTabSet.Create(TabWidth);
  try
    Result := TabSet.Optimize(S);
  finally
    TabSet.Free;
  end;
end;

function StrOptimizeTabs(S: string; TabSet: TJclTabSet): string;
begin
  // use the provided tab set to perform the optimization
  Result := TabSet.Optimize(S);
end;

//=== { TJclTabSet } =====================================================

constructor TJclTabSet.Create;
begin
  // no tab stops, tab width set to auto
  Create([], True, 0);
end;

constructor TJclTabSet.Create(TabWidth: Integer);
begin
  // no tab stops, specified tab width
  Create([], True, TabWidth);
end;

constructor TJclTabSet.Create(const Tabstops: array of Integer; ZeroBased: Boolean);
begin
  // specified tab stops, tab width equal to distance between last two tab stops
  Create(Tabstops, ZeroBased, 0);
end;

constructor TJclTabSet.Create(const Tabstops: array of Integer; ZeroBased: Boolean; TabWidth: Integer);
var
  idx: Integer;
begin
  inherited Create;
  for idx := 0 to High(Tabstops) do
    Add(Tabstops[idx]);
  FWidth := TabWidth;
  FZeroBased := ZeroBased;
  CalcRealWidth;
end;

function TJclTabSet.Add(Column: Integer): Integer;
begin
  if Self = nil then
    raise NullReferenceException.Create;
  if Column < StartColumn then
    raise ArgumentOutOfRangeException.Create('Column');
  Result := FindStop(Column);
  if Result < 0 then
  begin
    // the column doesn't exist; invert the result of FindStop to get the correct index position
    Result := not Result;
    // increase the tab stop array
    SetLength(FStops, Length(FStops) + 1);
    // make room at the insert position
    MoveArray(FStops, Result, Result + 1, High(FStops) - Result);
    // add the tab stop at the correct location
    FStops[Result] := Column;
    CalcRealWidth;
  end
  else
  begin
    {$IFDEF CLR}
    raise EJclStringError.Create(RsTabs_DuplicatesNotAllowed);
    {$ELSE}
    raise EJclStringError.CreateRes(@RsTabs_DuplicatesNotAllowed);
    {$ENDIF}
  end;
end;

procedure TJclTabSet.CalcRealWidth;
begin
  if FWidth < 1 then
  begin
    if Length(FStops) > 1 then
      FRealWidth := FStops[High(FStops)] - FStops[Pred(High(FStops))]
    else
    if Length(FStops) = 1 then
      FRealWidth := FStops[0]
    else
      FRealWidth := 2;
  end
  else
    FRealWidth := FWidth;
end;

function TJclTabSet.Delete(Column: Integer): Integer;
begin
  Result := FindStop(Column);
  if Result >= 0 then
    RemoveAt(Result);
end;

function TJclTabSet.Expand(const S: string): string;
begin
  Result := Expand(s, StartColumn);
end;

function TJclTabSet.Expand(const S: string; Column: Integer): string;
var
  sb: TStringBuilder;
  head: PChar;
  cur: PChar;
begin
  if Column < StartColumn then
    raise ArgumentOutOfRangeException.Create('Column');
  sb := TStringBuilder.Create(Length(S));
  try
    cur := PChar(S);
    while cur^ <> #0 do
    begin
      head := cur;
      while (cur^ <> #0) and (cur^ <> #9) do
      begin
        if CharIsReturn(cur^) then
          Column := StartColumn
        else
          Inc(Column);
        Inc(cur);
      end;
      if cur > head then
        sb.Append(head, 0, cur - head);
      if cur^ = #9 then
      begin
        sb.Append(' ', TabFrom(Column) - Column);
        Column := TabFrom(Column);
        Inc(cur);
      end;
    end;
    Result := sb.ToString;
  finally
    sb.Free;
  end;
end;

function TJclTabSet.FindStop(Column: Integer): Integer;
begin
  if Self <> nil then
  begin
    Result := High(FStops);
    while (Result >= 0) and (FStops[Result] > Column) do
      Dec(Result);
    if (Result >= 0) and (FStops[Result] <> Column) then
      Result := not Succ(Result);
  end
  else
    Result := -1;
end;

class function TJclTabSet.FromString(const S: string): TJclTabSet;
var
  cur: PChar;

  procedure SkipWhiteSpace;
  begin
    while CharIsWhiteSpace(cur^) do
      Inc(cur);
  end;

  function ParseNumber: Integer;
  var
    head: PChar;
  begin
    SkipWhiteSpace;
    head := cur;
    while CharIsDigit(cur^) do
      Inc(cur);
    if (cur <= head) or not TryStrToInt(Copy(head, 1, cur - head), Result) then
      Result := -1;
  end;

  procedure ParseStops;
  var
    openBracket, hadComma: Boolean;
    num: Integer;
  begin
    SkipWhiteSpace;
    openBracket := cur^ = '[';
    hadComma := False;
    if openBracket then
      Inc(cur);
    repeat
      num := ParseNumber;
      if (num < 0) and hadComma then
        {$IFDEF CLR}
        raise EJclStringError.Create(RsTabs_StopExpected)
        {$ELSE}
        raise EJclStringError.CreateRes(@RsTabs_StopExpected)
        {$ENDIF}
      else
      if num >= 0 then
        Result.Add(num);
      SkipWhiteSpace;
      hadComma := cur^ = ',';
      if hadComma then
        Inc(cur);
    until (cur^ = #0) or (cur^ = '+') or (cur^ = ']');
    if hadComma then
      {$IFDEF CLR}
      raise EJclStringError.Create(RsTabs_StopExpected)
      {$ELSE}
      raise EJclStringError.CreateRes(@RsTabs_StopExpected)
      {$ENDIF}
    else
    if openBracket and (cur^ <> ']') then
      {$IFDEF CLR}
      raise EJclStringError.Create(RsTabs_CloseBracketExpected)
      {$ELSE}
      raise EJclStringError.CreateRes(@RsTabs_CloseBracketExpected);
      {$ENDIF}
  end;

  procedure ParseTabWidth;
  var
    num: Integer;
  begin
    SkipWhiteSpace;
    if cur^ = '+' then
    begin
      Inc(cur);
      SkipWhiteSpace;
      num := ParseNumber;
      if (num < 0) then
        {$IFDEF CLR}
        raise EJclStringError.Create(RsTabs_TabWidthExpected)
        {$ELSE}
        raise EJclStringError.CreateRes(@RsTabs_TabWidthExpected)
        {$ENDIF}
      else
        Result.TabWidth := num;
    end;
  end;

  procedure ParseZeroBasedFlag;
  begin
    SkipWhiteSpace;
    if cur^ = '0' then
    begin
      Inc(cur);
      if CharIsWhiteSpace(cur^) or (cur^ = #0) or (cur^ = '[') then
      begin
        Result.ZeroBased := True;
        SkipWhiteSpace;
      end
      else
        Dec(cur);
    end;
  end;

begin
  Result := TJclTabSet.Create;
  try
    Result.ZeroBased := False;
    cur := PChar(S);
    ParseZeroBasedFlag;
    ParseStops;
    ParseTabWidth;
  except
    // clean up the partially complete instance (to avoid memory leaks)...
    Result.Free;
    // ... and re-raise the exception
    raise;
  end;
end;

function TJclTabSet.GetCount: Integer;
begin
  if Self <> nil then
    Result := Length(FStops)
  else
    Result := 0;
end;

function TJclTabSet.GetStops(Index: Integer): Integer;
begin
  if Self <> nil then
  begin
    if (Index < 0) or (Index >= Length(FStops)) then
    begin
      {$IFDEF CLR}
      raise EJclStringError.Create(RsArgumentOutOfRange);
      {$ELSE}
      raise EJclStringError.CreateRes(@RsArgumentOutOfRange);
      {$ENDIF CLR}
    end
    else
      Result := FStops[Index];
  end
  else
  begin
    {$IFDEF CLR}
    raise EJclStringError.Create(RsArgumentOutOfRange);
    {$ELSE}
    raise EJclStringError.CreateRes(@RsArgumentOutOfRange);
    {$ENDIF CLR}
  end;
end;

function TJclTabSet.GetTabWidth: Integer;
begin
  if Self <> nil then
    Result := FWidth
  else
    Result := 0;
end;

function TJclTabSet.GetZeroBased: Boolean;
begin
  Result := (Self = nil) or FZeroBased;
end;

procedure TJclTabSet.OptimalFillInfo(StartColumn, TargetColumn: Integer; out TabsNeeded, SpacesNeeded: Integer);
var
  nextTab: Integer;
begin
  if StartColumn < Self.StartColumn then  // starting column less than 1 or 0 (depending on ZeroBased state)
    raise ArgumentOutOfRangeException.Create('StartColumn');
  if (TargetColumn < StartColumn) then    // target lies before the starting column
    raise ArgumentOutOfRangeException.Create('TargetColumn');
  TabsNeeded := 0;
  repeat
    nextTab := TabFrom(StartColumn);
    if nextTab <= TargetColumn then
    begin
      Inc(TabsNeeded);
      StartColumn := nextTab;
    end;
  until nextTab > TargetColumn;
  SpacesNeeded := TargetColumn - StartColumn;
end;

function TJclTabSet.Optimize(const S: string): string;
begin
  Result := Optimize(S, StartColumn);
end;

function TJclTabSet.Optimize(const S: string; Column: Integer): string;
var
  sb: TStringBuilder;
  head: PChar;
  cur: PChar;
  tgt: Integer;

  procedure AppendOptimalWhiteSpace(Target: Integer);
  var
    tabCount: Integer;
    spaceCount: Integer;
  begin
    if cur > head then
    begin
      OptimalFillInfo(Column, Target, tabCount, spaceCount);
      if tabCount > 0 then
        sb.Append(#9, tabCount);
      if spaceCount > 0 then
        sb.Append(' ', spaceCount);
    end;
  end;

begin
  if Column < StartColumn then
    raise ArgumentOutOfRangeException.Create('Column');
  sb := TStringBuilder.Create(Length(S));
  try
    cur := PChar(s);
    while cur^ <> #0 do
    begin
      // locate first whitespace character
      head := cur;
      while (cur^ <> #0) and not CharIsWhiteSpace(cur^) do
        Inc(cur);
      // output non whitespace characters
      if cur > head then
        sb.Append(head, 0, cur - head);
      // advance column
      Inc(Column, cur - head);
      // initialize target column indexer
      tgt := Column;
      // locate end of whitespace sequence
      while CharIsWhiteSpace(cur^) do
      begin
        if CharIsReturn(cur^) then
        begin
          // append optimized whitespace sequence...
          AppendOptimalWhiteSpace(tgt);
          // ...set the column back to the start of the line...
          Column := StartColumn;
          // ...reset target column indexer...
          tgt := Column;
          // ...add the line break character...
          sb.Append(cur^);
        end
        else
        if cur^ = #9 then
          tgt := TabFrom(tgt)       // expand the tab
        else
          Inc(tgt);                 // a normal whitespace; taking up 1 column
        Inc(cur);
      end;
      AppendOptimalWhiteSpace(tgt); // append optimized whitespace sequence...
      Column := tgt;                // ...and memorize the column for the next iteration
    end;
    Result := sb.ToString;          // convert result to a string
  finally
    sb.Free;
  end;
end;

procedure TJclTabSet.RemoveAt(Index: Integer);
begin
  if Self <> nil then
  begin
    MoveArray(FStops, Succ(Index), Index, High(FStops) - Index);
    SetLength(FStops, High(FStops));
    CalcRealWidth;
  end
  else
    raise NullReferenceException.Create;
end;

procedure TJclTabSet.SetStops(Index, Value: Integer);
var
  temp: Integer;
begin
  if Self <> nil then
  begin
    if (Index < 0) or (Index >= Length(FStops)) then
    begin
      {$IFDEF CLR}
      raise ArgumentOutOfRangeException.Create;
      {$ELSE}
      raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange);
      {$ENDIF CLR}
    end
    else
    begin
      temp := FindStop(Value);
      if temp < 0 then
      begin
        // remove existing tab stop...
        RemoveAt(Index);
        // now add the new tab stop
        Add(Value);
      end
      else
      if temp <> Index then
      begin
        // new tab stop already present at another index
        {$IFDEF CLR}
        raise EJclStringError.Create(RsTabs_DuplicatesNotAllowed);
        {$ELSE}
        raise EJclStringError.CreateRes(@RsTabs_DuplicatesNotAllowed);
        {$ENDIF}
      end;
    end;
  end
  else
    raise NullReferenceException.Create;
end;

procedure TJclTabSet.SetTabWidth(Value: Integer);
begin
  if Self <> nil then
  begin
    FWidth := Value;
    CalcRealWidth;
  end
  else
    raise NullReferenceException.Create;
end;

procedure TJclTabSet.SetZeroBased(Value: Boolean);
var
  shift: Integer;
  idx:   Integer;
begin
  if Self <> nil then
  begin
    if Value <> FZeroBased then
    begin
      FZeroBased := Value;
      if Value then
        shift := -1
      else
        shift := 1;
      for idx := 0 to High(FStops) do
        FStops[idx] := FStops[idx] + shift;
    end;
  end
  else
    raise NullReferenceException.Create;
end;

function TJclTabSet.InternalTabStops: TDynIntegerArray;
begin
  if Self <> nil then
    Result := FStops
  else
    Result := nil;
end;

function TJclTabSet.InternalTabWidth: Integer;
begin
  if Self <> nil then
    Result := FRealWidth
  else
    Result := 2;
end;

function TJclTabSet.StartColumn: Integer;
begin
  if GetZeroBased then
    Result := 0
  else
    Result := 1;
end;

function TJclTabSet.TabFrom(Column: Integer): Integer;
begin
  if Column < StartColumn then
    raise ArgumentOutOfRangeException.Create('Column');
  Result := FindStop(Column);
  if Result < 0 then
    Result := not Result
  else
    Inc(Result);
  if Result >= GetCount then
  begin
    if GetCount > 0 then
      Result := FStops[High(FStops)]
    else
      Result := StartColumn;
    while Result <= Column do
      Inc(Result, ActualTabWidth);
  end
  else
    Result := FStops[Result];
end;

function TJclTabSet.ToString: string;
begin
  Result := ToString(TabSetFormatting_Full);
end;

function TJclTabSet.ToString(FormattingOptions: Integer): string;
var
  sb: TStringBuilder;
  idx: Integer;

  function WantBrackets: Boolean;
  begin
    Result := (TabSetFormatting_SurroundStopsWithBrackets and FormattingOptions) <> 0;
  end;

  function EmptyBrackets: Boolean;
  begin
    Result := (TabSetFormatting_EmptyBracketsIfNoStops and FormattingOptions) <> 0;
  end;

  function IncludeAutoWidth: Boolean;
  begin
    Result := (TabSetFormatting_AutoTabWidth and FormattingOptions) <> 0;
  end;

  function IncludeTabWidth: Boolean;
  begin
    Result := (TabSetFormatting_NoTabWidth and FormattingOptions) = 0;
  end;

  function IncludeStops: Boolean;
  begin
    Result := (TabSetFormatting_NoTabStops and FormattingOptions) = 0;
  end;

begin
  sb := TStringBuilder.Create;
  try
    // output the fixed tabulation positions if requested...
    if IncludeStops then
    begin
      // output each individual tabulation position
      for idx := 0 to GetCount - 1 do
      begin
        sb.Append(TabStops[idx]);
        sb.Append(',');
      end;
      // remove the final comma if any tabulation positions where outputted
      if sb.Length <> 0 then
        sb.Remove(sb.Length - 1, 1);
      // bracket the tabulation positions if requested
      if WantBrackets and (EmptyBrackets or (sb.Length > 0)) then
      begin
        sb.Insert(0, '[');
        sb.Append(']');
      end;
    end;
    // output the tab width if requested....
    if IncludeTabWidth and (IncludeAutoWidth or (TabWidth > 0)) then
    begin
      // separate the tab width from any outputted tabulation positions with a whitespace
      if sb.Length > 0 then
        sb.Append(' ');
      // flag tab width
      sb.Append('+');
      // finally, output the tab width
      sb.Append(ActualTabWidth);
    end;
    // flag zero-based tabset by outputting a 0 (zero) as the first character.
    if ZeroBased then
      sb.Insert(0, string('0 '));
    Result := StrTrimCharRight(sb.ToString, ' ');
  finally
    sb.Free;
  end;
end;

function TJclTabSet.UpdatePosition(const S: string): Integer;
var
  lines: Integer;
begin
  Result := StartColumn;
  UpdatePosition(S, Result, lines);
end;

function TJclTabSet.UpdatePosition(const S: string; Column: Integer): Integer;
var
  lines: Integer;
begin
  if Column < StartColumn then
    raise ArgumentOutOfRangeException.Create('Column');
  Result := Column;
  UpdatePosition(S, Result, lines);
end;

function TJclTabSet.UpdatePosition(const S: string; var Column, Line: Integer): Integer;
var
  prevChar: Char;
  cur:      PChar;
begin
  if Column < StartColumn then
    raise ArgumentOutOfRangeException.Create('Column');
  // initialize loop
  cur := PChar(S);
  // iterate until end of string (the Null-character)
  while cur^ <> #0 do
  begin
    // check for line-breaking characters
    if CharIsReturn(cur^) then
    begin
      // Column moves back all the way to the left
      Column := StartColumn;
      // If this is the first line-break character or the same line-break character, increment the Line parameter
      Inc(Line);
      // check if it's the first of a two-character line-break
      prevChar := cur^;
      Inc(cur);
      // if it isn't a two-character line-break, undo the previous advancement
      if (cur^ = prevChar) or not CharIsReturn(cur^) then
        Dec(cur);
    end
    else // check for tab character and expand it
    if cur^ = #9 then
      Column := TabFrom(Column)
    else // a normal character; increment column
      Inc(Column);
    // advance pointer
    Inc(cur);
  end;
  // set the result to the newly calculated column
  Result := Column;
end;

//=== { NullReferenceException } =============================================

constructor NullReferenceException.Create;
begin
  CreateRes(@RsArg_NullReferenceException);
end;

{$ENDIF ~CLR}

function CompareNatural(const S1, S2: string; CaseInsensitive: Boolean): Integer;
var
  Cur1, Len1,
  Cur2, Len2: Integer;

  procedure NumberCompare;
  var
    IsReallyNumber: Boolean;
    FirstDiffBreaks: Boolean;
    Val1, Val2:     Integer;
  begin
    Result := 0;
    IsReallyNumber := False;
    // count leading spaces in S1
    while CharIsWhiteSpace(S1[Cur1]) do
    begin
      Dec(Result);
      Inc(Cur1);
    end;
    // count leading spaces in S2 (canceling them out against the ones in S1)
    while CharIsWhiteSpace(S2[Cur2]) do
    begin
      Inc(Result);
      Inc(Cur2);
    end;

    // if spaces match, or both strings are actually followed by a numeric character, continue the checks
    if (Result = 0) or (CharIsNumberChar(S1[Cur1])) and (CharIsNumberChar(S2[Cur2])) then
    begin
      // Check signed number
      if (S1[Cur1] = '-') and (S2[Cur2] <> '-') then
        Result := 1
      else
      if (S2[Cur2] = '-') and (S1[Cur1] <> '-') then
        Result := -1
      else
        Result := 0;

      if (S1[Cur1] = '-') or (S1[Cur1] = '+') then
        Inc(Cur1);
      if (S2[Cur2] = '-') or (S2[Cur2] = '+') then
        Inc(Cur2);

      FirstDiffBreaks := (S1[Cur1] = '0') or (S2[Cur2] = '0');
      while CharIsDigit(S1[Cur1]) and CharIsDigit(S2[Cur2]) do
      begin
        IsReallyNumber := True;
        Val1 := StrToInt(S1[Cur1]);
        Val2 := StrToInt(S2[Cur2]);

        if (Result = 0) and (Val1 < Val2) then
          Result := -1
        else
        if (Result = 0) and (Val1 > Val2) then
          Result := 1;
        if FirstDiffBreaks and (Result <> 0) then
          Break;
        Inc(Cur1);
        Inc(Cur2);
      end;

      if IsReallyNumber then
      begin
        if not FirstDiffBreaks then
        begin
          if CharIsDigit(S1[Cur1]) then
            Result := 1
          else
          if CharIsDigit(S2[Cur2]) then
            Result := -1;
        end;
      end;
    end;
  end;

begin
  Cur1 := 1;
  Len1 := Length(S1);
  Cur2 := 1;
  Len2 := Length(S2);
  Result := 0;

  while (Result = 0) do
  begin
    if (Cur1 = Len1) and (Cur2 = Len2) then
      Break
    else
    if (S1[Cur1] = '-') and CharIsNumberChar(S2[Cur2]) and (S2[Cur2] <> '-') then
      Result := -1
    else
    if (S2[Cur2] = '-') and CharIsNumberChar(S1[Cur1]) and (S1[Cur1] <> '-') then
      Result := 1
    else
    if CharIsNumberChar(S1[Cur1]) and CharIsNumberChar(S2[Cur2]) then
      NumberCompare
    else
    if (Cur1 = Len1) and (Cur2 < Len2) then
      Result := -1
    else
    if (Cur1 < Len1) and (Cur2 = Len2) then
      Result := 1
    else
    begin
      {$IFDEF CLR}
      Result := System.String.Compare(S1.Substring(Cur1 - 1),S2.Substring(Cur2 - 1),CaseInsensitive);
      {$ELSE ~CLR}
      if CaseInsensitive then
        Result := StrLIComp(PChar(@S1[Cur1]), PChar(@S2[Cur2]), 1)
      else
        Result := StrLComp(PChar(@S1[Cur1]), PChar(@S2[Cur2]), 1);
      {$ENDIF ~CLR}
      Inc(Cur1);
      Inc(Cur2);
    end;
  end;
end;

function CompareNaturalStr(const S1, S2: string): Integer; overload;
begin
  Result := CompareNatural(S1, S2, False);
end;

function CompareNaturalText(const S1, S2: string): Integer; overload;
begin
  Result := CompareNatural(S1, S2, True);
end;

{$IFDEF CLR}
{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);
{$ENDIF UNITVERSIONING}
{$ELSE}
initialization
  LoadCharTypes;  // this table first
  LoadCaseMap;    // or this function does not work
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}
{$ENDIF CLR}

{$IFDEF UNITVERSIONING}
finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.