Sordie.co.uk

libsassy/libSassy.Strings.pas

Raw

{(
 )) libSassy.Strings
((    String helper object and functions
 ))
((  Copyright  Sordie Aranka Solomon-Smith 2015-2016
 ))
((  This work is made available under the terms of the Creative Commons
 )) Attribution-NonCommercial-ShareAlike 3.0 Unported license
((  http://creativecommons.org/licenses/by-nc-sa/3.0/
 )}

unit libSassy.Strings;

interface

uses
  Winapi.Windows,

  libSassy.Arrays,
  libSassy.Streams,
  libSassy.Random;

type
  TCharSet = set of AnsiChar;

  TMarkupCode = record
    Name:  String[10];
    Value: String[2];
  end;

  TSizeType = (stBinaryBytes, stMetricBytes, stFrequency, stMetric, stEmpty);

{$REGION 'TStringHelper'}
  TStringHelper = record helper for String
    const Whitespace    = #9#10#13#32;
    const BasicChars    = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
    const QuoteChars    = '"`''''';
    const SymbolChars   = '!$%^&*()_+-=[]{};@#~\/|,<>?';
    const NumberChars   = '0123456789';
    const Ident1Chars   = '_ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
    const Ident2Chars   = Ident1Chars + NumberChars;
    const Ident3Chars   = Ident2Chars + '!$%^&*-+:@#~\/|<>.,';
    const OperatorChars = '+-=|*/^&%<>';

    procedure Burn;

    function Ansi: AnsiString; inline;

    function Ptr(const Index: Integer = 1): PChar; inline;

    function Copy(const Index: Integer; const Count: Integer = -1): String;

    function Insert(const S: String; const Index: Integer): String; inline;
    function Delete(const Index, Count: Integer): String; inline;

    function Pos     (const S: String; const Start: Integer = 1; const IgnoreCase: Boolean = False; const OutOfQuotes: Boolean = False): Integer;
    function Contains(const S: String; const Start: Integer = 1; const IgnoreCase: Boolean = False; const OutOfQuotes: Boolean = False): Boolean; inline;

    function ValidChars(const S: String; const IgnoreCase: Boolean = False): Boolean;

    function Start(const Count: Integer): String; inline;
    function Starts(const S: String; const IgnoreCase: Boolean = False; const RemoveIfFound: Boolean = True): Boolean;
    function Ends  (const S: String; const IgnoreCase: Boolean = False; const RemoveIfFound: Boolean = True): Boolean;

    function FirstChar: Char; inline;
    function LastChar:  Char; inline;

    function  GetLength: Integer;         inline;
    procedure SetLength(Length: Integer); inline;

    property Length: Integer read GetLength write SetLength;

    function  GetSize: Integer;       inline;
    procedure SetSize(Size: Integer); inline;

    property Size: Integer read GetSize write SetSize;

    procedure Clear;

    function Empty: Boolean; inline;

    function AddSep(const S: String; const Sep: String = ' '): String;

    function Uppercase: String;
    function Lowercase: String;

    function LTrim: String;
    function RTrim: String;
    function Trim:  String; inline;

    function Tidy: String;

    function TidyNumeric: String;

    function LAlign(const Mask: String): String;
    function RAlign(const Mask: String): String;
    function CAlign(const Mask: String): String;

    function Compare(const S: String; const IgnoreCase: Boolean = False): Integer;

    function IndexOf(const S: array of String; const IgnoreCase: Boolean = False): Integer;

    function Replace(const FindStr, ReplaceStr: String; const Start: Integer = 1; const IgnoreCase: Boolean = False; const OutOfQuotes: Boolean = False): String;

    function Rep(const Times: Integer): String;

    function Split(const Delim: String = ' '; const Trim: Boolean = True; const OutOfQuotes: Boolean = False): String;
    function SplitToken(const Remove: Boolean = True): String;

    function Quoted(const QuoteChar: Char = '"'): String;
    function Unquote: String;

    function URLEncode: String;
    function URLDecode: String;

    const
      // As per ISO 8859-1 (plus some I added for convenience)
      MarkupCodes: array[0..104] of TMarkupCode = (
        (Name:'amp';    Value:'&'),  (Name:'quot';   Value:'"'), (Name:'apos';    Value:''''),
        (Name:'lt';     Value:'<'),  (Name:'gt';     Value:'>'), (Name:'copy';    Value:''),
        (Name:'reg';    Value:''),  (Name:'middot'; Value:''), (Name:'deg';     Value:''),
        (Name:'sup1';   Value:''),  (Name:'sup2';   Value:''), (Name:'sup3';    Value:''),
        (Name:'frac14'; Value:''),  (Name:'frac12'; Value:''), (Name:'frac34';  Value:''),
        (Name:'cent';   Value:''),  (Name:'pound';  Value:''), (Name:'yen';     Value:''),
        (Name:'cr';     Value:#13),  (Name:'lf';     Value:#10), (Name:'crlf';    Value:#13#10),
        (Name:'nbsp';   Value:#160), (Name:'iexcl';  Value:''), (Name:'curren';  Value:''),
        (Name:'brvbar'; Value:''),  (Name:'sect';   Value:''), (Name:'uml';     Value:''),
        (Name:'ordf';   Value:''),  (Name:'laquo';  Value:''), (Name:'raquo';   Value:''),
        (Name:'not';    Value:''),  (Name:'macr';   Value:''), (Name:'shy';     Value:#173),
        (Name:'plusmn'; Value:''),  (Name:'acute';  Value:''), (Name:'micro';   Value:''),
        (Name:'para';   Value:''),  (Name:'cedil';  Value:''), (Name:'ordm';    Value:''),
        (Name:'iquest'; Value:''),  (Name:'times';  Value:''), (Name:'divide';  Value:''),
        (Name:'Agrave'; Value:''),  (Name:'Aacute'; Value:''), (Name:'Acirc';   Value:''),
        (Name:'Atilde'; Value:''),  (Name:'Auml';   Value:''), (Name:'Aring';   Value:''),
        (Name:'AElig';  Value:''),  (Name:'Ccedil'; Value:''), (Name:'Egrave';  Value:''),
        (Name:'Eacute'; Value:''),  (Name:'Ecirc';  Value:''), (Name:'Euml';    Value:''),
        (Name:'Igrave'; Value:''),  (Name:'Iacute'; Value:''), (Name:'Icirc';   Value:''),
        (Name:'Iuml';   Value:''),  (Name:'ETH';    Value:''), (Name:'Ntilde';  Value:''),
        (Name:'Ograve'; Value:''),  (Name:'Oacute'; Value:''), (Name:'Ocirc';   Value:''),
        (Name:'Otilde'; Value:''),  (Name:'Ouml';   Value:''), (Name:'Oslash';  Value:''),
        (Name:'Ugrave'; Value:''),  (Name:'Uacute'; Value:''), (Name:'Ucirc';   Value:''),
        (Name:'Uuml';   Value:''),  (Name:'Yacute'; Value:''), (Name:'THORN';   Value:''),
        (Name:'szlig';  Value:''),  (Name:'agrave'; Value:''), (Name:'aacute';  Value:''),
        (Name:'acirc';  Value:''),  (Name:'atilde'; Value:''), (Name:'auml';    Value:''),
        (Name:'aring';  Value:''),  (Name:'aelig';  Value:''), (Name:'ccedil';  Value:''),
        (Name:'egrave'; Value:''),  (Name:'eacute'; Value:''), (Name:'ecirc';   Value:''),
        (Name:'euml';   Value:''),  (Name:'igrave'; Value:''), (Name:'iacute';  Value:''),
        (Name:'icirc';  Value:''),  (Name:'iuml';   Value:''), (Name:'eth';     Value:''),
        (Name:'ntilde'; Value:''),  (Name:'ograve'; Value:''), (Name:'oacute';  Value:''),
        (Name:'ocirc';  Value:''),  (Name:'otilde'; Value:''), (Name:'ouml';    Value:''),
        (Name:'oslash'; Value:''),  (Name:'ugrave'; Value:''), (Name:'uacute';  Value:''),
        (Name:'ucirc';  Value:''),  (Name:'uuml';   Value:''), (Name:'yacute';  Value:''),
        (Name:'thorn';  Value:''),  (Name:'yuml';   Value:''), (Name:'semicol'; Value:';')
      );

    function Markup  (const   CodeUnprintable: Boolean = False): String;
    function UnMarkup(const DecodeUnprintable: Boolean = False): String;

    function Rot13: String;
    function Cipher(const Key: Cardinal): String;

    function Hash(const Key: Cardinal = $5A17): Cardinal;

    function Match(const Mask: String; const IgnoreCase: Boolean = False): Boolean;

    function Soundex(const CodeLen: Integer = 4): String;
    function SoundsLike(const S: String; const CodeLen: Integer = 4): Boolean; inline;

    function Load(const Stream: TStream): Boolean;
    function Save(const Stream: TStream; const Unicode: Boolean = False): Boolean;

    function CopyToClipboard(const Unicode: Boolean = True): Boolean;
    function CopyFromClipboard: Boolean;

    type TBase = record
      Base:    Integer;
      Prefix:  String;
      Postfix: String;
    end;

    const Bases: array[0..6] of TBase = (
      (Base:16; Prefix:'0x'; Postfix:''), (Base:16; Prefix:'0'; Postfix:'h'), (Base:16; Prefix:'$'; PostFix:''),
      (Base: 8; Prefix:'0o'; Postfix:''), (Base: 8; Prefix:'0'; Postfix:'o'),
      (Base: 2; Prefix:'0b'; Postfix:''), (Base: 2; Prefix:'0'; Postfix:'b')
    );{Bases}

    class function Base(const I: Int64;  const ABase: Integer; MinSize: Integer = 0): String; overload; static;
    class function Base(const S: String; const ABase: Integer; Default: Integer = 0): Int64;  overload; static;

    class function Int(const I: Int64; const MinSize: Integer = 0): String; overload; inline; static;
    class function Dec(const I: Int64; const MinSize: Integer = 0): String; overload; inline; static;
    class function Hex(const I: Int64; const MinSize: Integer = 0): String; overload; inline; static;
    class function Oct(const I: Int64; const MinSize: Integer = 0): String; overload; inline; static;
    class function Bin(const I: Int64; const MinSize: Integer = 0): String; overload; inline; static;

    class function Int(const S: String; const Default: Int64 = 0): Int64; overload;         static;
    class function Dec(const S: String; const Default: Int64 = 0): Int64; overload; inline; static;
    class function Hex(const S: String; const Default: Int64 = 0): Int64; overload; inline; static;
    class function Oct(const S: String; const Default: Int64 = 0): Int64; overload; inline; static;
    class function Bin(const S: String; const Default: Int64 = 0): Int64; overload; inline; static;

    class function Float(const F: Extended; const Prec: Integer = 2): String;     overload; inline; static;
    class function Float(const S: String; const Default: Extended = 0): Extended; overload; inline; static;

    class function Bool(const B: Boolean; const T: String = 'True'; const F: String = 'False'): String; overload; inline; static;
    class function Bool(const S: String; const Default: Boolean = False): Boolean;                      overload;         static;

    class function Pointer(const P: Pointer): String; overload; inline; static;
    class function Pointer(const S: String): Pointer; overload; inline; static;

    class function Roman(const R: Int64): String; overload; static;
    class function Roman(const R: String): Int64; overload; static;

    function AsInteger(const Default: Int64    = 0):     Int64;    inline;
    function AsFloat  (const Default: Extended = 0):     Extended; inline;
    function AsBoolean(const Default: Boolean  = False): Boolean;  inline;
    function AsPointer(const Default: Pointer  = nil):   Pointer;  inline;

    class function CharInSet(const C: Char; const Chars: TCharSet): Boolean; inline; static;

    class function FromChars(const Chars: TCharSet): String; static;

    class function From(Any: array of const; const Delim: String = ''): String; overload; static;
    class function From(const Any: TVarRec):                            String; overload; static;

    class function Format(const Fmt: String; Params: array of const): String; overload; static;
    class function Format(const Fmt: String):                         String; overload; static; inline;

    class function Times(const S: String; const Times: Integer = 1): String; static; inline;

    class function Random(const Seed: Integer = 0): String; static;

    const
      ScaleStr: array[TSizeType, 0..8] of String = ((' bytes', 'KiB', 'MiB', 'GiB', 'TiB', 'PiB', 'EiB', 'ZiB', 'YiB'),
                                                    (' bytes', 'KB',  'MB',  'GB',  'TB',  'PB',  'EB',  'ZB',  'YB'),
                                                    ('Hz',     'KHz', 'MHz', 'GHz', 'THz', 'PHz', 'EHz', 'ZHz', 'YHz'),
                                                    ('',       'K',   'M',   'G',   'T',   'P',   'E',   'Z',   'Y'),
                                                    ('',       '',    '',    '',    '',    '',    '',    '',    ''));

      ScaleBase: array[TSizeType] of Integer = (1024, 1000, 1000, 1000, 1000);

    class function FromSize(Size: Int64; SizeType: TSizeType = stMetric; const BaseAdjust: Integer = 900): String; static;
  end;
{$ENDREGION}

{$REGION 'TStrings'}
  TStrings = class(TArray<String>)
  private
    fIgnoreCase: Boolean;

    function  GetText: String;
    procedure SetText(S: String);
  public
    function InternalCompareProc(const A, B): Integer; override;

    function Load(Stream: TStream): Boolean;
    function Save(Stream: TStream; const Unicode: Boolean = False): Boolean;

    function GetMatches(const Mask: String; const IgnoreCase: Boolean = False): TStrings;
    function GetSoundsLike(const S: String; const CodeLen: Integer = 4): TStrings;

    property Text: String read GetText write SetText;

    property IgnoreCase: Boolean read fIgnoreCase write fIgnoreCase;
  end;
{$ENDREGION}

{$REGION 'TStringStream'}
  TStringStream = class(TStream)
  private
    fPosition: Int64;
  public
    Str: String;

    function InternalRead (var   Data; const Size: Int64): Int64; override;
    function InternalWrite(const Data; const Size: Int64): Int64; override;

    function  GetSize: Int64;        override;
    procedure SetSize(Value: Int64); override;

    function Seek(const NewPos: Int64; const Origin: Integer): Int64; override;
  end;
{$ENDREGION}

implementation

{$REGION 'TStringHelper'}
procedure TStringHelper.Burn;
begin
  //FillChar(Ptr(1)^, Length * SizeOf(Char), $FF);
  FillChar(Ptr(1)^, Length * SizeOf(Char), $00);
  Self := '';
end;

function TStringHelper.Ansi;
begin
  Result := AnsiString(Self);
end;

function TStringHelper.Ptr;
begin
  Result := @Self[Index];
end;

function TStringHelper.Copy;
var
  C: Integer;
begin
  if Count = -1 then C := Length else C := Count;
  Result := System.Copy(Self, Index, C);
end;

function TStringHelper.Insert;
begin
  Result := Copy(1, Index) + S + Copy(Index + 1);
end;

function TStringHelper.Delete;
begin
  Result := Copy(1, Index - 1) + Copy(Index + Count);
end;

function TStringHelper.Pos;
var
  i: Integer;
  q: Char;
begin

  if OutOfQuotes then
  begin
    q := #0;

    for i := Start to Length do
      if q <> #0 then
      begin
        if Self[i] = q then q := #0;
      end
      else if System.Pos(Self[i], QuoteChars) > 0 then
        q  := Self[i]
      else if Copy(i, S.Length).Compare(S, IgnoreCase) = 0 then Exit(i);
  end
  else
    for i := Start to Length do
      if Copy(i, S.Length).Compare(S, IgnoreCase) = 0 then Exit(i);

  Result := 0;
end;

function TStringHelper.Contains;
begin
  Result := Pos(S, Start, IgnoreCase, OutOfQuotes) > 0;
end;

function TStringHelper.ValidChars;
var
  C: Char;
begin
  for C in Self do
    if S.Pos(String(C)) = 0 then Exit(False);

  Result := True;
end;

function TStringHelper.Start;
begin
  if Count < 0 then
    Result := Copy(1, Length + Count)
  else
    Result := Copy(1, Count);
end;

function TStringHelper.Starts;
begin
  Result := Copy(1, S.Length).Compare(S, IgnoreCase) = 0;

  if Result and RemoveIfFound then
    Self := Copy(S.Length + 1);
end;

function TStringHelper.Ends;
begin
  Result := Copy(1 + Length - S.Length, S.Length).Compare(S, IgnoreCase) = 0;

  if Result and RemoveIfFound then
    Self := Copy(1, Length - S.Length);
end;

function TStringHelper.FirstChar;
begin
  if Empty then exit(#0);

  Result := Self[1];
end;

function TStringHelper.LastChar;
begin
  if Empty then exit(#0);

  Result := Self[Self.Length];
end;

function TStringHelper.GetLength;
begin
  Result := System.Length(Self);
end;

procedure TStringHelper.SetLength;
begin
  System.SetLength(Self, Length);
end;

function TStringHelper.GetSize;
begin
  Result := Length * SizeOf(Char);
end;

procedure TStringHelper.SetSize;
begin
  Length := Size div SizeOf(Char);
end;

procedure TStringHelper.Clear;
var
  i: Integer;
begin
  for i := 1 to Length do
    Self[i] := #$FF;

  Self := '';
end;

function TStringHelper.Empty;
begin
  Result := Length = 0;
end;

function TStringHelper.AddSep;
begin
  Result := Self;

  if not Result.Empty then
    if not Result.Ends(Sep, False, False) then
      Result := Result + Sep;

  Result := Result + S;
end;

function TStringHelper.Uppercase;
begin
  Result := Self;
  if Result.Empty then exit;

  CharUpperBuff(@Result[1], Result.Length);
end;

function TStringHelper.Lowercase;
begin
  Result := Self;
  if Result.Empty then exit;

  CharLowerBuff(@Result[1], Result.Length);
end;

function TStringHelper.LTrim;
var
  i: Integer;
begin
  for i := 1 to Length do
    if Whitespace.Pos(Self[i]) = 0 then break;

  Result := Copy(i);
end;

function TStringHelper.RTrim;
var
  i: Integer;
begin
  for i := Length downto 1 do
    if Whitespace.Pos(Self[i]) = 0 then break;

  Result := Copy(1, i);
end;

function TStringHelper.Trim;
begin
  Result := Self.LTrim.RTrim;
end;

function TStringHelper.Tidy;
var
  i:    Integer;
  c, q: Char;
  w:    Boolean;

  function SkipWhitespace: Boolean;
  begin
    Result := Whitespace.Contains(c);
    if not Result then exit;

    while (i <= Length) and Whitespace.Contains(Self[i]) do inc(i);

    i := i - 1;
  end;
begin
  Result := '';
  if Empty then exit;

  i := 1; q := #0;

  repeat
    c := Self[i];

    if q <> #0 then
    begin
      if c = q then q := #0;

      Result := Result + c;
    end
    else
    begin
      w := SkipWhitespace;

      if i > Length then break;

      if w then c := Self[i];

      if QuoteChars.Contains(c) then q := c;
      if Whitespace.Contains(c) then c := #32;

      Result := Result + c;
    end;

    inc(i);
  until i > Length;

  Result := Result.Trim;
end;

function TStringHelper.TidyNumeric;
var
  i: Integer;
begin
  Result := Trim;

  if Result.Pos('.') > 0 then
  begin
    while Result.LastChar = '0' do
      Result := Result.Copy(1, Result.Length - 1);

    if Result.LastChar = '.' then
      Result := Result.Copy(1, Result.Length - 1);
  end;

  while (not Result.Empty) and (Result.FirstChar = '0') do
    Result := Result.Copy(2);

  i := Result.Pos('.') - 1;
  if i < 1 then i := Result.Length;

  repeat
    i := i - 3;
    if i < 1 then break;

    Result := Result.Insert(',', i);
  until False;

  if Result.Empty or (Result.FirstChar = '.') then
    Result := '0' + Result;
end;

function TStringHelper.LAlign;
var
  i: Integer;
begin
  Result := Mask;

  for i := 1 to Length do
    if i > Result.Length then exit else Result[i] := Self[i];
end;

function TStringHelper.RAlign;
var
  i, j: Integer;
begin
  Result := Mask;

  for i := 1 to Length do
  begin
    j := Result.Length - i + 1;

    if j < 1 then exit;

    Result[j] := Self[Length - i + 1];
  end;
end;

function TStringHelper.CAlign;
var
  i, j: Integer;
begin
  Result := Mask;

  for i := 1 to Length do
  begin
    j := ((Mask.Length shr 1) - (Length shr 1) + i);

    if j < 1 then continue else if j > Result.Length then exit;

    Result[j] := Self[i];
  end;
end;

function TStringHelper.Compare;
var
  Flags: Cardinal;
begin
  if IgnoreCase then Flags := NORM_IGNORECASE else Flags := 0;
  Result := CompareString(LOCALE_USER_DEFAULT, Flags, Ptr, Length, S.Ptr, S.Length) - 2
end;

function TStringHelper.IndexOf;
var
  i: Integer;
begin
  for i := Low(S) to High(S) do
    if Compare(S[i], IgnoreCase) = 0 then Exit((i - Low(S)) + 1);

  Result := 0;
end;

function TStringHelper.Replace;
var
  i: Integer;
  p: Integer;
begin
  Result := Self; p := Start;

  i := Result.Pos(FindStr, p, IgnoreCase, OutOfQuotes);

  while i > 0 do
  begin
    Result := Result.Copy(1, i - 1) + ReplaceStr + Result.Copy(i + FindStr.Length);

    p := p + ReplaceStr.Length;
    i := Result.Pos(FindStr, p, IgnoreCase, OutOfQuotes);
  end;
end;

function TStringHelper.Rep;
var
  i: Integer;
begin
  Result := '';

  for i := 1 to Times do
    Result := Result + Self;
end;

function TStringHelper.Split;
  function IfTrim(S: String): String;
  begin
    if Trim then Result := S.Trim else Result := S;
  end;
var
  i: Integer;
begin
  Self := IfTrim(Self);

  i := Pos(Delim, 1, False, OutOfQuotes);

  if i = 0 then
  begin
    Result := Self;
    Self   := '';
  end
  else
  begin
    Result := IfTrim(Copy(1, i - 1));
    Self   := IfTrim(Copy(i + Delim.Length));
  end;
end;

function TStringHelper.SplitToken;
const
  DblTokens: array[0..9] of String[2] = ('<>', '==', '!=', '<=', '>=', '<<', '>>', '&&', '||', '^^');
var
  i, j: Integer;
  c:    Char;
  f:    Boolean;
begin
  Result := '';
  if Empty then exit;

  i := 1;

  if Whitespace.Contains(Self[i]) then
    while (i < Length) and Whitespace.Contains(Self[i]) do inc(i);

  if i > Length then exit;

  c := Self[i];

  if QuoteChars.Contains(c) then
  begin
    repeat
      Result := Result + Self[i];

      inc(i);

      if Self[i] = c then
      begin
        inc(i);
        break;
      end;
    until i > Length;

    if Result[Result.Length] <> c then Result := Result + c;
  end

  else if NumberChars.Contains(c) then
  begin
    f := False;

    repeat
      Result := Result + Self[i];

      inc(i);
      if i > Length then break;

      if (not f) and (Self[i] = '.') then
      begin
        Result := Result + '.';
        f      := True;

        inc(i);
      end
    until (i > Length) or (not NumberChars.Contains(Self[i]))
  end

  else if Ident1Chars.Contains(c) then
    repeat
      Result := Result + Self[i];

      inc(i);
    until (i > Length) or (not (Ident2Chars + '.').Contains(Self[i]))
  else
  begin
    Result := c;
    inc(i);

    if i < Length then
      for j := low(DblTokens) to high(DblTokens) do
        if (String(DblTokens[j])[1] = c) and (String(DblTokens[j])[2] = Self[i]) then
        begin
          Result := Result + Self[i];
          inc(i);
          break;
        end;
  end;

  if Remove then Self := Copy(i).Trim;
end;

function TStringHelper.Quoted;
begin
  Result := Trim;

  if Result.Empty then exit(QuoteChar + QuoteChar);

  if Result[1]             <> QuoteChar then Result := QuoteChar + Result;
  if Result[Result.Length] <> QuoteChar then Result := Result + QuoteChar;
end;

function TStringHelper.Unquote;
var
  QuoteChar: Char;
begin
  Result := Trim;
  if Result.Empty then exit;

  QuoteChar := Result[1];

  if QuoteChars.Contains(QuoteChar) then
  begin
    Result := Result.Copy(2);
    if Result.Empty then exit;

    if Result[Result.Length] = QuoteChar then
      Result := Result.Copy(1, Result.Length - 1);
  end;
end;

function TStringHelper.URLEncode;
const
  ValidChars = '_abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789.';
var
  c: Char;
begin
  Result := '';

  for c in Self do
    if ValidChars.Contains(c) then
      Result := Result + c
    else
      Result := Result + '%' + Hex(Ord(c), 2);
end;

function TStringHelper.URLDecode;
const
  HexChars = '0123456789ABCDEF';
var
  i: Integer;
  c: String;
begin
  Result := '';

  i := 1;

  while i <= Length do
  begin
    if Self[i] = '%' then
    begin
      c := Copy(i + 1, 2) + '  ';
      if (HexChars.Pos(c[1]) = 0)
      or (HexChars.Pos(c[2]) = 0) then
        Result := Result + Self[i]
      else
      begin
        c := c.Copy(1, 2);
        Result := Result + Char(Hex(c));
        inc(i, 2);
      end
    end
    else Result := Result + Self[i];

    inc(i);
  end;
end;

function TStringHelper.Markup;
const
  ValidChars = '_abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789.';
var
  Markup: TMarkupCode;
  Coded:  String;
  c:      Char;
begin
  Result := Self;

  for Markup in MarkupCodes do
    Result := Result.Replace(String(Markup.Value), '&' + String(Markup.Name) + ';');

  if CodeUnprintable then
  begin
    Coded := '';

    for c in Result do
      if ValidChars.Contains(c) then
        Coded := Coded + c
      else
        Coded := Coded + '&' + Int(Ord(c)) + ';';

    Result := Coded;
  end;
end;

function TStringHelper.UnMarkup;
var
  Markup:   TMarkupCode;
  i:        Integer;
begin
  Result := Self;

  for Markup in MarkupCodes do
    Result := Result.Replace('&' + String(Markup.Name) + ';', String(Markup.Value));

  if DecodeUnprintable then
    for i := 0 to 255 do
      Result := Result.Replace('&' + Int(i) + ';', Char(i));
end;

function TStringHelper.Rot13;
const
  Alpha = 'abcdefghijklmnopqrstuvwxyz' +
          'abcdefghijklmnopqrstuvwxyz' +
          'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
          'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
var
  i, j: Integer;
begin
  Result := Self;

  for i := 1 to Result.Length do
  begin
    j := Alpha.Pos(Result[i]);
    if j > 0 then Result[i] := Alpha[j + 13];
  end;
end;

function TStringHelper.Cipher;
var
  i: Integer;
  r: TRandom;
begin
  r.Seed := Key;
  Result := Self;

  for i := 1 to Result.Length do
    Result[i] := Char(ord(Result[i]) xor Byte(r.Next($FF)));
end;

function TStringHelper.Hash;
const
  Pow: array[0..7] of Integer = (1, 2, 4, 8, 16, 32, 64, 128);
var
  i: Integer;
  c: Char;
  t: Boolean;
begin
  Result := 0;

  for c in Self do
    for i := 7 downto 0 do
    begin
      t := ((Result and 32768) = 32768) xor ((Ord(c) and Pow[i]) = Pow[i]);
      Result := ((Result and 32767) * 2);
      if t then Result := Result xor Key;
    end;
end;

function TStringHelper.Match;
var
  mStr, cStr: String;

  function Comp(MaskI, StrI: Integer): Boolean;
  var
    m: Char;
  begin
    if MaskI > mStr.Length then exit(StrI = cStr.Length + 1);
    if StrI  > cStr.Length then exit(False);

    m := mStr[MaskI];

    if m = '*' then
      Result := Comp(succ(MaskI), succ(StrI)) or Comp(MaskI, succ(StrI))
    else if (m = '?') or (m = cStr[StrI]) then
      Result := Comp(succ(MaskI), succ(StrI))
    else
      Result := False;
  end;
begin
  if Mask.Copy(1, 1) = '!' then
    Result := Contains(Mask.Copy(2), 1, IgnoreCase)
  else
  begin
    if IgnoreCase then
    begin
      cStr := Self.Lowercase;
      mStr := Mask.Lowercase;
    end
    else
    begin
      cStr := Self;
      mStr := Mask;
    end;

    Result := Comp(1, 1);
  end;
end;

function TStringHelper.Soundex;
const
  SoundexTable: array[65..122] of Integer = (0, 1, 2, 3, 0, 1, 2, -1, 0, 2, 2,
   4, 5, 5, 0, 1, 2, 6, 2, 3, 0, 1, -1, 2, 0, 2, 0, 0, 0, 0, 0, 0, 0, 1, 2, 3,
   0, 1, 2, -1, 0, 2, 2, 4, 5, 5, 0, 1, 2, 6, 2, 3, 0, 1, -1, 2, 0, 2);

  function Score(AChar: Integer): Integer; inline;
  begin
    if (AChar >= Low(SoundexTable)) and (AChar <= High(SoundexTable)) then
      Result := SoundexTable[AChar]
    else
      Result := 0;
  end;
var
  i, j, k: Integer;
  p:       PChar;
begin
  Result := '';

  if Empty then Exit;

  p      := PChar(@Self[2]);
  Result := String(Self[1]).Uppercase;
  k      := Score(Integer(Self[1]));

  for i := 2 to Length do
  begin
    j := Score(Integer(p^));

    if (j > 0) and (j <> k) then
    begin
      Result := Result + String.Int(j);
      if Result.Length = CodeLen then Break;
    end;

    if j <> -1 then k := j;

    Inc(p);
  end;

  if Result.Length < CodeLen then
    Result := Result.LAlign(String.Times('0', CodeLen));
end;

function TStringHelper.SoundsLike;
begin
  Result := Soundex(CodeLen) = S.Soundex(CodeLen);
end;

function TStringHelper.Load;
var
  Pos, Len:  Int64;
  Encoding:  Word;
  EncodeLen: Integer;

  A: AnsiString;
  W: WideString;

  P: PWideChar;
begin
  Self := '';

  if Stream = nil then Exit(False);

  try
    Pos := Stream.Position;
    Len := Stream.Size - Pos;

    EncodeLen := Stream.Read(Encoding, 2);

    if (EncodeLen = 2) and ((Encoding = $FEFF) or (Encoding = $FFFE)) then
    begin
      dec(Len, 2);

      System.SetLength(W, Len div SizeOf(WideChar));
      Result := Stream.Read(W[1], Len) = Len;

      if not Result then exit;

      if Encoding = $FFFE then
      begin
        W := W + #0;
        P := @W[1];

        while P^ <> #0 do
        begin
          P^ := WideChar(Swap(Word(P^)));
          inc(P);
        end;

        W := System.Copy(W, 1, System.Length(W) - 1);
      end;

      Self := String(W);
    end
    else
    begin
      System.SetLength(A, Len div SizeOf(AnsiChar));

      if EncodeLen = 1 then
        A[1] := AnsiChar(Encoding and $FF)
      else if EncodeLen = 2 then
      begin
        A[1] := AnsiChar( Encoding        and $FF);
        A[2] := AnsiChar((Encoding shr 8) and $FF);
      end;

      Result := Stream.Read(A[EncodeLen + 1], Len - EncodeLen) = Len - EncodeLen;

      if not Result then Exit;

      Self := String(A);
    end;
  finally
    if Stream.FreeAfterOp then
      Stream.Free;
  end;
end;

function TStringHelper.Save;
const
  UnicodeMarker: Word = $FEFF;
var
  L: Int64;
  A: AnsiString;
  W: WideString;
begin
  if Stream = nil then Exit(False);

  try
    if Unicode then
    begin
      if Stream.Write(UnicodeMarker, 2) <> 2 then Exit(False);

      W := WideString(Self);
      L := System.Length(W) * SizeOf(WideChar);
      Result := Stream.Write(W[1], L) = L;
    end
    else
    begin
      A := AnsiString(Self);
      L := System.Length(A) * SizeOf(AnsiChar);
      Result := Stream.Write(A[1], L) = L;
    end;
  finally
    if Stream.FreeAfterOp then
      Stream.Free;
  end;
end;

function TStringHelper.CopyToClipboard(const Unicode: Boolean = True): Boolean;
var
  h:  THandle;
  sw: String;
  sa: AnsiString;
  l:  Integer;
  f:  Cardinal;
begin
  if Unicode then
  begin
    sw := Self + #0;
    l  := (sw.Length + 1) * 2;
    f  := CF_UNICODETEXT;
  end
  else
  begin
    sa := AnsiString(Self) + AnsiChar(#0);
    l  := System.Length(sa) + 1;
    f  := CF_TEXT;
  end;

  h := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, l);
  if h = 0 then exit(False);

  try
    if not OpenClipboard(0) then exit(False);

    try
      if Unicode then
        Move(sw[1], GlobalLock(h)^, l)
      else
        Move(sa[1], GlobalLock(h)^, l);

      EmptyClipboard;
      Result := SetClipboardData(f, h) <> 0;
    finally
      GlobalUnlock(h);
      CloseClipboard;
    end;
  finally
    GlobalFree(h);
  end;
end;

function TStringHelper.CopyFromClipboard;
var
  h: THandle;
  s: AnsiString;
begin
  if not OpenClipboard(0) then exit(False);

  try
    Result := True;

    if IsClipboardFormatAvailable(CF_UNICODETEXT) then
    begin
      h := GetClipboardData(CF_UNICODETEXT);
      if h = 0 then exit(False);

      Self := PChar(GlobalLock(h));
      GlobalUnlock(h);
    end
    else if IsClipboardFormatAvailable(CF_TEXT) then
    begin
      h := GetClipboardData(CF_TEXT);
      if h = 0 then exit(False);

      s := PAnsiChar(GlobalLock(h));
      GlobalUnlock(h);

      Self := String(s);
    end
    else
      Result := False;
  finally
    CloseClipboard;
  end;
end;

class function TStringHelper.Base(const I: Int64; const ABase: Integer; MinSize: Integer = 0): String;
var
  Val: Int64;
  Neg: Boolean;
begin
  Result := '';
  if ABase > BasicChars.Length then exit;

  Neg := I < 0;
  Val := abs(I);

  if Val = 0 then
    Result := BasicChars[1]
  else
    while Val > 0 do
    begin
      Result := BasicChars[(Val mod Cardinal(ABase)) + 1] + Result;
      Val := Val div Int64(ABase);
    end;

  if MinSize > 0 then
    while Result.Length < MinSize do
      Result := BasicChars[1] + Result;

  if Neg then Result := '-' + Result;
end;

class function TStringHelper.Base(const S: String; const ABase: Integer; Default: Integer = 0): Int64;
var
  i, j:  Integer;
  Valid: String;
begin
  if (ABase = 0) or (ABase > BasicChars.Length) or S.Empty then exit(Default);

  Valid := BasicChars.Copy(1, ABase);

  Result := 0;

  for i := 1 to S.Length do
  begin
    j := Valid.Pos(S[i]);
    if j = 0 then exit(Default);

    Result := Result * ABase + (j - 1);
  end;
end;

class function TStringHelper.Int(const I: Int64; const MinSize: Integer = 0): String;
begin
  Result := Dec(I, MinSize);
end;

class function TStringHelper.Dec(const I: Int64; const MinSize: Integer = 0): String;
var
  S: ShortString;
begin
  System.Str(I, S);
  Result := String(S);

  if MinSize > 0 then
    while Result.Length < MinSize do
      Result := BasicChars[1] + Result;
end;

class function TStringHelper.Hex(const I: Int64; const MinSize: Integer = 0): String;
begin
  Result := Base(I, 16, MinSize);
end;

class function TStringHelper.Oct(const I: Int64; const MinSize: Integer = 0): String;
begin
  Result := Base(I, 8, MinSize);
end;

class function TStringHelper.Bin(const I: Int64; const MinSize: Integer = 0): String;
begin
  Result := Base(I, 2, MinSize);
end;

class function TStringHelper.Int(const S: String; const Default: Int64 = 0): Int64;
var
  i:   Integer;
  Neg: Boolean;
  V:   String;
begin
  Result := Default;

  V := S.Trim;
  if V.Empty then exit;

  Neg := V[1] = '-';
  if Neg then
  begin
    V := V.Copy(2);

    if V.Empty then exit;
  end;

  try
    for i := 0 to System.Length(Bases) - 1 do
      with Bases[i] do
        if (V.Copy(1, Prefix.Length) = Prefix) and (V.Copy(V.Length - Postfix.Length + 1, Postfix.Length) = Postfix) then
          exit(String.Base(V.Copy(Prefix.Length + 1, V.Length - Prefix.Length - Postfix.Length), Base, Default));

    Result := Dec(V, Default);
  finally
    if Neg and (Result > 0) then Result := -Result;
  end;
end;

class function TStringHelper.Dec(const S: String; const Default: Int64 = 0): Int64;
begin
  Result := Base(S, 10, Default);
end;

class function TStringHelper.Hex(const S: String; const Default: Int64 = 0): Int64;
begin
  Result := Base(S, 16, Default);
end;

class function TStringHelper.Oct(const S: String; const Default: Int64 = 0): Int64;
begin
  Result := Base(S, 8, Default);
end;

class function TStringHelper.Bin(const S: String; const Default: Int64 = 0): Int64;
begin
  Result := Base(S, 2, Default);
end;

class function TStringHelper.Float(const F: Extended; const Prec: Integer = 2): String;
var
  s: ShortString;
begin
  System.Str(F:Prec:Prec, s);
  Result := String(s);
end;

class function TStringHelper.Float(const S: String; const Default: Extended = 0): Extended;
var
  Code: Integer;
begin
  Val(S, Result, Code);
  if Code <> 0 then Result := Default;
end;

class function TStringHelper.Bool(const B: Boolean; const T: String = 'True'; const F: String = 'False'): String;
begin
  if B then Result := T else Result := F;
end;

class function TStringHelper.Bool(const S: String; const Default: Boolean = False): Boolean;
var
  t: String;
begin
  if S.Empty then exit(Default);

  t := S.Copy(1, 2).Lowercase;

  if (t = 'ok') or (t = 'on') or (AnsiChar(S[1]) in ['Y', 'y', 'T', 't', #1]) then Result := True

  else Result := Int(S, 0) <> 0;
end;

class function TStringHelper.Pointer(const P: Pointer): String;
begin
  Result := Hex(Int64(P), 8);
end;

class function TStringHelper.Pointer(const S: String): Pointer;
begin
  Result := System.Pointer(Int(S));
end;

class function TStringHelper.Roman(const R: Int64): String;
type
  TRomanSections = (rs1000, rs900, rs400, rs500, rs100, rs90, rs40, rs50, rs10, rs9, rs4, rs5, rs1, rsEnd, rsNone);
  TRomanSection = record
    Value:  Integer;
    Prefix: String[2];
    Jump:   TRomanSections;
    Next:   TRomanSections;
  end;
const
  RomanSections: array[TRomanSections] of TRomanSection = (
    (Value:1000; Prefix:'M';  Jump:rsNone; Next:rs900),
    (Value:0900; Prefix:'CM'; Jump:rs500;  Next:rs90),
    (Value:0400; Prefix:'CD'; Jump:rs100;  Next:rs90),
    (Value:0500; Prefix:'D';  Jump:rs400;  Next:rs100),
    (Value:0100; Prefix:'C';  Jump:rsNone; Next:rs90),
    (Value:0090; Prefix:'XC'; Jump:rs50;   Next:rs9),
    (Value:0040; Prefix:'XL'; Jump:rs10;   Next:rs9),
    (Value:0050; Prefix:'L';  Jump:rs40;   Next:rs10),
    (Value:0010; Prefix:'X';  Jump:rsNone; Next:rs9),
    (Value:0009; Prefix:'IX'; Jump:rs5;    Next:rsEnd),
    (Value:0004; Prefix:'IV'; Jump:rs1;    Next:rsEnd),
    (Value:0005; Prefix:'V';  Jump:rs4;    Next:rs1),
    (Value:0001; Prefix:'I';  Jump:rsNone; Next:rsEnd),
    (Value:0000; Prefix:'';   Jump:rsNone; Next:rsEnd),
    (Value:0000; Prefix:'';   Jump:rsNone; Next:rsEnd)
  );
var
  Work:    Integer;
  Section: TRomanSections;
begin
  Result  := '';
  Work    := R;
  Section := rs1000;

  repeat
    with RomanSections[Section] do
    begin
      if (Jump <> rsNone) and (Work < Value) then
        Section := Jump
      else
      begin
        while Work >= Value do
        begin
          dec(Work, Value);

          Result := Result + String(Prefix);

          if Jump <> rsNone then break;
        end;

        if Next = rsEnd then exit;

        Section := Next;
      end;
    end;
  until False;
end;

class function TStringHelper.Roman(const R: String): Int64;
const
  // Quick lut for the characters (messay but fast)
  RomanChars = ['C', 'D', 'I', 'L', 'M', 'V', 'X']; {Do not localize}
  RomanValues: array['C'..'X'] of Word =
    (100, 500, 0, 0, 0, 0, 1, 0, 0, 50, 1000, 0, 0, 0, 0, 0, 0, 0, 0, 5, 0, 10);
var
  c, n: Char;
  i:    Integer;
  Neg:  Boolean;
begin
  Result := 0;

  Neg := (R.Length > 0) and (R.FirstChar = '-');
  if Neg then i := 1 else i := 0;

  while (i < R.Length) do
  begin
    Inc(i);

    c := R.Uppercase[i];

    if CharInSet(c, RomanChars) then
    begin
      if Succ(i) <= R.Length then n := r.Uppercase[i + 1] else n := #0;

      if CharInSet(n, RomanChars) and (RomanValues[c] < RomanValues[n]) then
      begin
        inc(Result, RomanValues[n]);
        dec(Result, RomanValues[c]);

        inc(i);
      end
      else
        inc(Result, RomanValues[c]);
    end
    else
      Exit(0);
  end;

  if Neg then Result := -Result;
end;

function TStringHelper.AsInteger;
begin
  Result := String.Int(Self, Default);
end;

function TStringHelper.AsFloat;
begin
  Result := String.Float(Self, Default);
end;

function TStringHelper.AsBoolean;
begin
  Result := String.Bool(Self, Default);
end;

function TStringHelper.AsPointer;
begin
  Result := String.Pointer(Self);
end;

class function TStringHelper.CharInSet;
begin
{$WARNINGS OFF}
  Result := C in Chars;
{$WARNINGS ON}
end;

class function TStringHelper.FromChars;
var
  C: AnsiChar;
begin
  Result := '';

  for C in Chars do
    Result := Result + String(C);
end;

class function TStringHelper.From(Any: array of const; const Delim: String = ''): String;
var
  i: Integer;
begin
  Result := '';

  for i := low(Any) to high(Any) do
  begin
    Result := Result + From(Any[i]);
    if i < high(Any) then Result := Result + Delim;
  end;
end;

class function TStringHelper.From(const Any: TVarRec): String;
begin
  with TVarRec(Any) do
    case VType of
      vtInteger:       Result := Int(VInteger);
      vtBoolean:       Result := Bool(VBoolean);
      vtChar:          Result := String(VChar);
      vtWideChar:      Result := String(VWideChar);
      vtExtended:      Result := Float(VExtended^);
      vtString:        Result := String(VString);
      vtPointer:       Result := Pointer(VPointer);
      vtPChar:         Result := String(VPChar);
      vtObject:        Result := VObject.ClassName + '(' + Pointer(@VObject) + ')';
      vtClass:         Result := VClass.ClassName;
      vtPWideChar:     Result := VPWideChar;
      vtWideString:    Result := String(WideString(VWideString));
      vtInt64:         Result := Int(VInt64^);
      vtUnicodeString: Result := String(UnicodeString(VUnicodeString));
      vtAnsiString:    Result := String(AnsiString(VAnsiString));
    else
      Result := 'Unk(' + Int(VType) + ')';
    end;
end;

class function TStringHelper.Format(const Fmt: String; Params: array of const): String;
var
  i: Integer;
begin
  Result := Fmt;

  if Result.Contains('%*') then
    Result := Result.Replace('%*', From(Params, ' '));

  for i := high(Params) downto low(Params) do
    if Result.Contains('%' + Int(i - low(Params) + 1)) then
      Result := Result.Replace('%' + Int(i - low(Params) + 1), From(Params[i]));

  Result := Result.UnMarkup(True);
end;

class function TStringHelper.Format(const Fmt: String): String;
begin
  Result := Format(Fmt, []);
end;

class function TStringHelper.Times;
begin
  Result := S.Rep(Times);
end;

class function TStringHelper.Random;
const
  a: array[0..7]  of String = ('a', 'e', 'i', 'o', 'u', 'ae', 'au', 'eo');
  b: array[0..52] of String = ('b', 'b', 'b', 'c', 'd', 'd', 'd', 'f', 'g', 'g', 'h', 'j', 'k', 'l', 'l', 'm', 'n', 'p', 'p', 'p', 'qu', 'r', 'r', 's', 's', 's', 's', 't', 't', 't', 't', 'v', 'w', 'x', 'z', 'th', 'ck', 'tt', 'll', 'nn', 'pp', 'b', 'b', 'b', 's', 's', 's', 't', 't', 't', 'd', 'd', 'd');
  c: array[0..10] of String = ('ton', 'le', 'am', 'ery', 'ed', 'le', 'el', 'ly', 'tion', 'ing', 'dom');
var
  r: TRandom;
  i: Integer;

  function RandFrom(a: array of String): String;
  begin
    Result := a[r.Next(high(a) + 1)];
  end;
begin
  if Seed <> 0 then
    r.Seed := Seed
  else
    r.Randomize;

  Result := RandFrom(b);

  for i := 1 to 2 + r.Next(1) do
  begin
    Result := Result + RandFrom(a);
    Result := Result + RandFrom(b);
  end;

  if r.Next(100) > 40 then Result := Result + RandFrom(c);
end;

class function TStringHelper.FromSize;
var
  j:  Integer;
  k:  Extended;
begin
  j := 0; k := Size;

  while k > BaseAdjust do
  begin
    k := k / ScaleBase[SizeType];

    inc(j); if j = high(ScaleStr[SizeType]) then break;
  end;

  Result := String.Float(k, 2).TidyNumeric + ScaleStr[SizeType, j];
end;
{$ENDREGION}

{$REGION 'TStrings'}
function TStrings.GetText;
var
  i: Integer;
begin
  Result := '';

  for i := 0 to Count - 1 do
    Result := Result + Item[i].RTrim + #13#10;
end;

procedure TStrings.SetText(S: String);
begin
  Clear;

  while not S.Empty do
  begin
    Add(S.Split(#13, False).RTrim);

    if S.Copy(1, 1) = #10 then
      S := S.Copy(2);
  end;
end;

function TStrings.InternalCompareProc;
begin
  Result := String(A).Compare(String(B), fIgnoreCase);
end;

function TStrings.Load;
var
  S: String;
begin
  Clear;

  Result := S.Load(Stream);
  if not Result then exit;

  Text := S;
end;

function TStrings.Save;
var
  S: String;
begin
  S := Text;

  Result := S.Save(Stream, Unicode);
end;

function TStrings.GetMatches;
var
  i: String;
begin
  Result := TStrings.Create;

  for i in Self do
    if i.Match(Mask, IgnoreCase) then Result.Add(i);
end;

function TStrings.GetSoundsLike;
var
  i: String;
begin
  Result := TStrings.Create;

  for i in Self do
    if i.SoundsLike(S, CodeLen) then Result.Add(i);
end;
{$ENDREGION}

{$REGION 'TStringStream'}
function TStringStream.InternalRead;
begin
  if (fPosition + Size) > Str.Size then
    Result := Str.Size - fPosition
  else
    Result := Size;

  Move(Str[fPosition], Data, Result);

  fPosition := fPosition + Result;
  if fPosition > Str.Size then fPosition := Str.Size;
end;

function TStringStream.InternalWrite;
var
  Buf: String;
begin
  Buf.Size := Size;
  Move(Data, Buf[1], Buf.Size);

  Str := Str.Insert(Buf, fPosition);

  Result := Buf.Size;

  fPosition := fPosition + Result;
  if fPosition > Str.Size then fPosition := Str.Size;
end;

function TStringStream.GetSize;
begin
  Result := Str.Size;
end;

procedure TStringStream.SetSize;
begin
  Str.Size := Value;
end;

function TStringStream.Seek;
begin
  case Origin of
    STREAM_SEEK_SET: fPosition := NewPos;
    STREAM_SEEK_CUR: fPosition := fPosition + NewPos;
    STREAM_SEEK_END: fPosition := Str.Size - NewPos;
  else
    exit(STG_E_INVALIDFUNCTION);
  end;

  if fPosition < 1 then
    fPosition := 1
  else if fPosition > Str.Size then
    fPosition := Str.Size;

  Result := fPosition;
end;
{$ENDREGION}

end.