{**************************************************************************************************}
{                                                                                                  }
{ 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 NewStringListUnit.pas.                                                      }
{                                                                                                  }
{ The Initial Developer of the Original Code is Romullo Sousa.                                     }
{ Portions created by Romullo Sousa are Copyright (C) Romullo Sousa. All rights reserved.          }
{                                                                                                  }
{ Contributor(s):                                                                                  }
{     Romullo Sousa (romullobr)                                                                    }
{     Leo Simas (Leh_U)                                                                            }
{                                                                                                  }
{**************************************************************************************************}

// Last modified: $Date: 2006-12-30 10:04:59 +0100 (Sa, 30 Dez 2006) $

unit JclStringLists;

{$I jcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF MSWINDOWS}
  {$IFDEF HAS_UNIT_VARIANTS}
  Variants,
  {$ENDIF HAS_UNIT_VARIANTS}
  Classes, SysUtils,
  JclBase;

type
  IJclStringList = interface;

  TJclStringListObjectsMode = (omNone, omObjects, omVariants, omInterfaces);

  TJclStringListSortCompare = function(List: IJclStringList; Index1, Index2: Integer): Integer;

  IJclStringList = interface(IInterface)
    ['{8DC5B71C-4756-404D-8636-7872CD299796}']
    { From TStrings/TStringList }
    function Add(const S: string): Integer; overload;
    function AddObject(const S: string; AObject: TObject): Integer;
    function Get(Index: Integer): string;
    function GetCapacity: Integer;
    function GetCount: Integer;
    function GetObjects(Index: Integer): TObject;
    function GetTextStr: string;
    function GetValue(const Name: string): string;
    function Find(const S: string; var Index: Integer): Boolean;
    function IndexOf(const S: string): Integer;
    {$IFDEF COMPILER6_UP}
    function GetCaseSensitive: Boolean;
    {$ENDIF COMPILER6_UP}
    function GetDuplicates: TDuplicates;
    function GetOnChange: TNotifyEvent;
    function GetOnChanging: TNotifyEvent;
    function GetSorted: Boolean;
    function Equals(Strings: TStrings): Boolean;
    function IndexOfName(const Name: string): Integer;
    function IndexOfObject(AObject: TObject): Integer; 
    function LoadFromFile(const FileName: string): IJclStringList;
    function LoadFromStream(Stream: TStream): IJclStringList;
    function SaveToFile(const FileName: string): IJclStringList;
    function SaveToStream(Stream: TStream): IJclStringList;
    function GetCommaText: string;
    {$IFDEF COMPILER6_UP}
    function GetDelimitedText: string;
    function GetDelimiter: Char;
    {$ENDIF COMPILER6_UP}
    function GetName(Index: Integer): string;
    {$IFDEF COMPILER7_UP}
    function GetNameValueSeparator: Char;
    function GetValueFromIndex(Index: Integer): string;
    {$ENDIF COMPILER7_UP}
    {$IFDEF COMPILER6_UP}
    function GetQuoteChar: Char;
    {$ENDIF COMPILER6_UP}
    procedure SetCommaText(const Value: string);
    {$IFDEF COMPILER6_UP}
    procedure SetDelimitedText(const Value: string);
    procedure SetDelimiter(const Value: Char);
    {$ENDIF COMPILER6_UP}
    {$IFDEF COMPILER7_UP}
    procedure SetNameValueSeparator(const Value: Char);
    procedure SetValueFromIndex(Index: Integer; const Value: string);
    {$ENDIF COMPILER7_UP}
    {$IFDEF COMPILER6_UP}
    procedure SetQuoteChar(const Value: Char);
    {$ENDIF COMPILER6_UP}
    procedure AddStrings(Strings: TStrings); overload;
    procedure SetObjects(Index: Integer; const Value: TObject);
    procedure Put(Index: Integer; const S: string);
    procedure SetCapacity(NewCapacity: Integer);
    procedure SetTextStr(const Value: string);
    procedure SetValue(const Name, Value: string);
    {$IFDEF COMPILER6_UP}
    procedure SetCaseSensitive(const Value: Boolean);
    {$ENDIF COMPILER6_UP}
    procedure SetDuplicates(const Value: TDuplicates);
    procedure SetOnChange(const Value: TNotifyEvent);
    procedure SetOnChanging(const Value: TNotifyEvent);
    procedure SetSorted(const Value: Boolean);
    property Count: Integer read GetCount;
    property Strings[Index: Integer]: string read Get write Put; default;
    property Text: string read GetTextStr write SetTextStr;
    property Objects[Index: Integer]: TObject read GetObjects write SetObjects;
    property Capacity: Integer read GetCapacity write SetCapacity;
    property Values[const Name: string]: string read GetValue write SetValue;
    property Duplicates: TDuplicates read GetDuplicates write SetDuplicates;
    property Sorted: Boolean read GetSorted write SetSorted;
    {$IFDEF COMPILER6_UP}
    property CaseSensitive: Boolean read GetCaseSensitive write SetCaseSensitive;
    {$ENDIF COMPILER6_UP}
    property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
    property OnChanging: TNotifyEvent read GetOnChanging write SetOnChanging;
    {$IFDEF COMPILER6_UP}
    property DelimitedText: string read GetDelimitedText write SetDelimitedText;
    property Delimiter: Char read GetDelimiter write SetDelimiter;
    {$ENDIF COMPILER6_UP}
    property Names[Index: Integer]: string read GetName;
    {$IFDEF COMPILER6_UP}
    property QuoteChar: Char read GetQuoteChar write SetQuoteChar;
    {$ENDIF COMPILER6_UP}
    property CommaText: string read GetCommaText write SetCommaText;
    {$IFDEF COMPILER7_UP}
    property ValueFromIndex[Index: Integer]: string read GetValueFromIndex write SetValueFromIndex;
    property NameValueSeparator: Char read GetNameValueSeparator write SetNameValueSeparator;
    {$ENDIF COMPILER7_UP}
    { New }
    function Assign(Source: TPersistent): IJclStringList;
    function LoadExeParams: IJclStringList;
    function Exists(const S: string): Boolean;
    function ExistsName(const S: string): Boolean;
    function DeleteBlanks: IJclStringList;
    function KeepIntegers: IJclStringList;
    function DeleteIntegers: IJclStringList;
    function ReleaseInterfaces: IJclStringList;
    function FreeObjects(AFreeAndNil: Boolean = False): IJclStringList;
    function Clone: IJclStringList;
    function Insert(Index: Integer; const S: string): IJclStringList;
    function InsertObject(Index: Integer; const S: string; AObject: TObject): IJclStringList;
    function Sort(ACompareFunction: TJclStringListSortCompare = nil): IJclStringList;
    function SortAsInteger: IJclStringList;
    function SortByName: IJclStringList;
    function Delete(AIndex: Integer): IJclStringList; overload;
    function Delete(const AString: string): IJclStringList; overload;
    function Exchange(Index1, Index2: Integer): IJclStringList;
    function Add(const A: array of const): IJclStringList; overload;
    function AddStrings(const A: array of string): IJclStringList; overload;
    function BeginUpdate: IJclStringList;
    function EndUpdate: IJclStringList;
    function Trim: IJclStringList;
    function Join(const ASeparator: string = ''): string;
    function Split(const AText, ASeparator: string; AClearBeforeAdd: Boolean = True): IJclStringList;
    function ExtractWords(const AText: string; const ADelims: TSetOfChar = [#0..' ']; AClearBeforeAdd: Boolean = True): IJclStringList;
    function Last: string;
    function First: string;
    function LastIndex: Integer;
    function Clear: IJclStringList;
    function DeleteRegEx(const APattern: string): IJclStringList;
    function KeepRegEx(const APattern: string): IJclStringList;
    function Files(const APattern: string = '*'; ARecursive: Boolean = False; const ARegExPattern: string = ''): IJclStringList;
    function Directories(const APattern: string = '*'; ARecursive: Boolean = False; const ARegExPattern: string = ''): IJclStringList;
    function GetStringsRef: TStrings;
    function ConfigAsSet: IJclStringList;
    function Delimit(const ADelimiter: string): IJclStringList;
    function GetInterfaceByIndex(Index: Integer): IInterface;
    function GetLists(Index: Integer): IJclStringList;
    function GetVariants(AIndex: Integer): Variant;
    function GetKeyInterface(const AKey: string): IInterface;
    function GetKeyObject(const AKey: string): TObject;
    function GetKeyVariant(const AKey: string): Variant;
    function GetKeyList(const AKey: string): IJclStringList;
    function GetObjectsMode: TJclStringListObjectsMode;
    procedure SetInterfaceByIndex(Index: Integer; const Value: IInterface);
    procedure SetLists(Index: Integer; const Value: IJclStringList);
    procedure SetVariants(Index: Integer; const Value: Variant);
    procedure SetKeyInterface(const AKey: string; const Value: IInterface);
    procedure SetKeyObject(const AKey: string; const Value: TObject);
    procedure SetKeyVariant(const AKey: string; const Value: Variant);
    procedure SetKeyList(const AKey: string; const Value: IJclStringList);
    property Interfaces[Index: Integer]: IInterface read GetInterfaceByIndex write SetInterfaceByIndex;
    property Lists[Index: Integer]: IJclStringList read GetLists write SetLists;
    property Variants[Index: Integer]: Variant read GetVariants write SetVariants;
    property KeyList[const AKey: string]: IJclStringList read GetKeyList write SetKeyList;
    property KeyObject[const AKey: string]: TObject read GetKeyObject write SetKeyObject;
    property KeyInterface[const AKey: string]: IInterface read GetKeyInterface write SetKeyInterface;
    property KeyVariant[const AKey: string]: Variant read GetKeyVariant write SetKeyVariant;
    property ObjectsMode: TJclStringListObjectsMode read GetObjectsMode;
  end;

function JclStringList: IJclStringList; overload;
function JclStringListStrings(AStrings: TStrings): IJclStringList; overload;
function JclStringListStrings(const A: array of string): IJclStringList; overload;
function JclStringList(const A: array of const): IJclStringList; overload;
function JclStringList(const AText: string): IJclStringList; overload;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL: https://svn.sourceforge.net:443/svnroot/jcl/trunk/jcl/source/common/JclStringLists.pas $';
    Revision: '$Revision: 1856 $';
    Date: '$Date: 2006-12-30 10:04:59 +0100 (Sa, 30 Dez 2006) $';
    LogPath: 'JCL\source\common'
    );
{$ENDIF UNITVERSIONING}

implementation

uses
  TypInfo,
  JclFileUtils, JclPCRE, JclStrings;

type
  TUpdateControl = class(TObject, IInterface)
  private
    FStrings: TStrings;
  protected
    function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  public
    constructor Create(AStrings: TStrings);
  end;

  TVariantWrapper = class(TObject)
  private
    FValue: Variant;
  end;

  TInterfaceWrapper = class(TObject)
  private
    FValue: IInterface;
  end;

  TJclStringListImpl = class(TStringList, IJclStringList)
  private
    FObjectsMode: TJclStringListObjectsMode;
    FSelfAsInterface: IJclStringList;
    FLastRegExPattern: string;
    FRegEx: TJclAnsiRegEx;
    FUpdateControl: TUpdateControl;
    function AutoUpdateControl: IInterface;
    function CanFreeObjects: Boolean;
    function MatchRegEx(const S, APattern: string): Boolean;
    function GetLists(Index: Integer): IJclStringList;
    function GetKeyInterface(const AKey: string): IInterface;
    function GetKeyObject(const AKey: string): TObject;
    function GetKeyVariant(const AKey: string): Variant;
    function GetValue(const Name: string): string;
    function GetVariants(AIndex: Integer): Variant;
    function GetKeyList(const AKey: string): IJclStringList;
    {$IFDEF COMPILER6_UP}
    function GetCaseSensitive: Boolean;
    {$ENDIF COMPILER6_UP}
    function GetDuplicates: TDuplicates;
    function GetOnChange: TNotifyEvent;
    function GetOnChanging: TNotifyEvent;
    function GetSorted: Boolean;
    function GetCommaText: string;
    {$IFDEF COMPILER6_UP}
    function GetDelimitedText: string;
    function GetDelimiter: Char;
    {$ENDIF COMPILER6_UP}
    function GetName(Index: Integer): string;
    {$IFDEF COMPILER7_UP}
    function GetNameValueSeparator: Char;
    function GetValueFromIndex(Index: Integer): string;
    {$ENDIF COMPILER7_UP}
    {$IFDEF COMPILER6_UP}
    function GetQuoteChar: Char;
    {$ENDIF COMPILER6_UP}
    function GetInterfaceByIndex(AIndex: Integer): IInterface;
    function GetObjects(Index: Integer): TObject;
    procedure SetValue(const Name, Value: string);
    procedure SetKeyList(const AKey: string; const Value: IJclStringList);
    procedure SetKeyInterface(const AKey: string; const Value: IInterface);
    procedure SetKeyObject(const AKey: string; const Value: TObject);
    procedure SetKeyVariant(const AKey: string; const Value: Variant);
    procedure SetLists(Index: Integer; const Value: IJclStringList);
    procedure SetVariants(Index: Integer; const Value: Variant);
    {$IFDEF COMPILER6_UP}
    procedure SetCaseSensitive(const Value: Boolean);
    {$ENDIF COMPILER6_UP}
    procedure SetDuplicates(const Value: TDuplicates);
    procedure SetOnChange(const Value: TNotifyEvent);
    procedure SetOnChanging(const Value: TNotifyEvent);
    procedure SetSorted(const Value: Boolean);
    procedure SetCommaText(const Value: string);
    {$IFDEF COMPILER6_UP}
    procedure SetDelimitedText(const Value: string);
    procedure SetDelimiter(const Value: Char);
    {$ENDIF COMPILER6_UP}
    {$IFDEF COMPILER7_UP}
    procedure SetNameValueSeparator(const Value: Char);
    procedure SetValueFromIndex(Index: Integer; const Value: string);
    {$ENDIF COMPILER7_UP}
    {$IFDEF COMPILER6_UP}
    procedure SetQuoteChar(const Value: Char);
    {$ENDIF COMPILER6_UP}
    procedure SetInterfaceByIndex(Index: Integer; const Value: IInterface);
    procedure SetObjects(Index: Integer; const Value: TObject);
    procedure EnsureObjectsMode(AMode: TJclStringListObjectsMode);
    function GetObjectsMode: TJclStringListObjectsMode;
  protected
    FRefCount: Integer;
    function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    {$IFDEF COMPILER5}
    function CompareStrings(const S1, S2: string): Integer; virtual;
    {$ENDIF COMPILER5}
  public
    constructor Create;
    destructor Destroy; override;
    function LoadExeParams: IJclStringList;
    function Exists(const S: string): Boolean;
    function ExistsName(const S: string): Boolean;
    function DeleteBlanks: IJclStringList;
    function KeepIntegers: IJclStringList;
    function DeleteIntegers: IJclStringList;
    function ReleaseInterfaces: IJclStringList;
    function FreeObjects(AFreeAndNil: Boolean = False): IJclStringList;
    function Clone: IJclStringList;
    function Add(const A: array of const): IJclStringList; reintroduce; overload;
    function AddStrings(const A: array of string): IJclStringList; reintroduce; overload;
    function BeginUpdate: IJclStringList;
    function EndUpdate: IJclStringList;
    function Trim: IJclStringList;
    function Delimit(const ADelimiter: string): IJclStringList;
    function Join(const ASeparator: string = ''): string;
    function Split(const AText, ASeparator: string; AClearBeforeAdd: Boolean = True): IJclStringList;
    function ExtractWords(const AText: string; const ADelims: TSetOfChar = [#0..' '];
      AClearBeforeAdd: Boolean = True): IJclStringList;
    function Last: string;
    function First: string;
    function LastIndex: Integer;
    function Clear: IJclStringList; reintroduce;
    function DeleteRegEx(const APattern: string): IJclStringList;
    function KeepRegEx(const APattern: string): IJclStringList;
    function Files(const APattern: string = '*'; ARecursive: Boolean = False;
      const ARegExPattern: string = ''): IJclStringList;
    function Directories(const APattern: string = '*'; ARecursive: Boolean = False;
      const ARegExPattern: string = ''): IJclStringList;
    function GetStringsRef: TStrings;
    function ConfigAsSet: IJclStringList;
    function Delete(AIndex: Integer): IJclStringList; reintroduce; overload;
    function Delete(const AString: string): IJclStringList; reintroduce; overload;
    function Exchange(Index1, Index2: Integer): IJclStringList; reintroduce;
    function Sort(ACompareFunction: TJclStringListSortCompare = nil): IJclStringList; reintroduce;
    function SortAsInteger: IJclStringList;
    function SortByName: IJclStringList;
    function Insert(Index: Integer; const S: string): IJclStringList; reintroduce;
    function InsertObject(Index: Integer; const S: string; AObject: TObject): IJclStringList; reintroduce;
    function LoadFromFile(const FileName: string): IJclStringList; reintroduce;
    function LoadFromStream(Stream: TStream): IJclStringList; reintroduce;
    function SaveToFile(const FileName: string): IJclStringList; reintroduce;
    function SaveToStream(Stream: TStream): IJclStringList; reintroduce;
    function Assign(Source: TPersistent): IJclStringList; reintroduce;
    { From TStrings/TStringList }
    property Values[const Name: string]: string read GetValue write SetValue;
    {$IFDEF COMPILER6_UP}
    property DelimitedText: string read GetDelimitedText write SetDelimitedText;
    property Delimiter: Char read GetDelimiter write SetDelimiter;
    {$ENDIF COMPILER6_UP}
    property Names[Index: Integer]: string read GetName;
    {$IFDEF COMPILER6_UP}
    property QuoteChar: Char read GetQuoteChar write SetQuoteChar;
    {$ENDIF COMPILER6_UP}
    property CommaText: string read GetCommaText write SetCommaText;
    {$IFDEF COMPILER7_UP}
    property ValueFromIndex[Index: Integer]: string read GetValueFromIndex write SetValueFromIndex;
    property NameValueSeparator: Char read GetNameValueSeparator write SetNameValueSeparator;
    {$ENDIF COMPILER7_UP}
    property Duplicates: TDuplicates read GetDuplicates write SetDuplicates;
    property Sorted: Boolean read GetSorted write SetSorted;
    {$IFDEF COMPILER6_UP}
    property CaseSensitive: Boolean read GetCaseSensitive write SetCaseSensitive;
    {$ENDIF COMPILER6_UP}
    property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
    property OnChanging: TNotifyEvent read GetOnChanging write SetOnChanging;
    { New }
    property Objects[Index: Integer]: TObject read GetObjects write SetObjects;
    property Interfaces[Index: Integer]: IInterface read GetInterfaceByIndex write SetInterfaceByIndex;
    property Lists[Index: Integer]: IJclStringList read GetLists write SetLists;
    property Variants[Index: Integer]: Variant read GetVariants write SetVariants;
    property KeyList[const AKey: string]: IJclStringList read GetKeyList write SetKeyList;
    property KeyObject[const AKey: string]: TObject read GetKeyObject write SetKeyObject;
    property KeyInterface[const AKey: string]: IInterface read GetKeyInterface write SetKeyInterface;
    property KeyVariant[const AKey: string]: Variant read GetKeyVariant write SetKeyVariant;
    property ObjectsMode: TJclStringListObjectsMode read GetObjectsMode;
  end;

function JclStringList: IJclStringList;
begin
  Result := TJclStringListImpl.Create;
end;

function JclStringList(const AText: string): IJclStringList; overload;
begin
  Result := JclStringList;
  Result.Text := AText;
end;

function JclStringListStrings(AStrings: TStrings): IJclStringList; overload;
begin
  Result := JclStringList;
  Result.AddStrings(AStrings);
end;

function JclStringListStrings(const A: array of string): IJclStringList;
begin
  Result := JclStringList.AddStrings(A);
end;

function JclStringList(const A: array of const): IJclStringList;
begin
  Result := JclStringList.Add(A);
end;

//=== { TJclStringListImpl } =================================================

function TJclStringListImpl.Add(const A: array of const): IJclStringList;
const
  BoolToStr: array [Boolean] of string[5] = ('false', 'true');
var
  I: Integer;
begin
  AutoUpdateControl;
  for I := Low(A) to High(A) do
    with A[I] do
      case VType of
        vtInteger:
          Add(IntToStr(VInteger));
        vtBoolean:
          Add(BoolToStr[VBoolean]);
        vtChar:
          Add(VChar);
        vtExtended:
          Add(FloatToStr(VExtended^));
        vtString:
          Add(VString^);
        vtPChar:
          Add(VPChar);
        vtObject:
          Add(VObject.ClassName);
        vtClass:
          Add(VClass.ClassName);
        vtAnsiString:
          Add(string(VAnsiString));
        vtCurrency:
          Add(CurrToStr(VCurrency^));
        vtVariant:
          Add(string(VVariant^));
        vtInt64:
          Add(IntToStr(VInt64^));
      end;
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.AddStrings(const A: array of string): IJclStringList;
var
  I: Integer;
begin
  AutoUpdateControl;
  for I := Low(A) to High(A) do
    Add(A[I]);
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.BeginUpdate: IJclStringList;
begin
  inherited BeginUpdate;
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.AutoUpdateControl: IInterface;
begin
  Result := FUpdateControl as IInterface;
end;

function TJclStringListImpl.Clear: IJclStringList;
begin
  if CanFreeObjects then
    FreeObjects(False);
  inherited Clear;
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.EndUpdate: IJclStringList;
begin
  inherited EndUpdate;
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.ExtractWords(const AText: string; const ADelims: TSetOfChar;
  AClearBeforeAdd: Boolean): IJclStringList;
var
  L, I, X: Integer;
begin
  AutoUpdateControl;
  if AClearBeforeAdd then
    Clear;
  I := 1;
  L := Length(AText);
  while I <= L do
  begin
    while (I <= L) and (AText[I] in ADelims) do
      Inc(I);
    X := I;
    while (I <= L) and not (AText[I] in ADelims) do
      Inc(I);
    if X <> I then
      Add(Copy(AText, X, I - X));
  end;
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.First: string;
begin
  Result := Strings[0];
end;

function TJclStringListImpl.Join(const ASeparator: string): string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to LastIndex - 1 do
    Result := Result + Strings[I] + ASeparator;
  if Count > 0 then
    Result := Result + Last;
end;

function TJclStringListImpl.Last: string;
begin
  Result := Strings[LastIndex];
end;

function TJclStringListImpl.QueryInterface(const IID: TGUID; out Obj): HRESULT;
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

function TJclStringListImpl.Split(const AText, ASeparator: string;
  AClearBeforeAdd: Boolean = True): IJclStringList;
var
  LStartIndex, LEndIndex: Integer;
  LLengthSeparator: Integer;
begin
  if AText <> '' then
  begin
    AutoUpdateControl;
    if AClearBeforeAdd then
      Clear;
    LLengthSeparator := Length(ASeparator);
    LStartIndex := 1;
    LEndIndex := StrSearch(ASeparator, AText, LStartIndex);
    while LEndIndex > 0 do
    begin
      Add(Copy(AText, LStartIndex, LEndIndex - LStartIndex));
      LStartIndex := LEndIndex + LLengthSeparator;
      LEndIndex := StrSearch(ASeparator, AText, LStartIndex);
    end;
    Add(Copy(AText, LStartIndex, MaxInt));
  end;
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.Trim: IJclStringList;
var
  I: Integer;
begin
  AutoUpdateControl;
  for I := 0 to LastIndex do
    Strings[I] := SysUtils.Trim(Strings[I]);
  Result := FSelfAsInterface;
end;

function TJclStringListImpl._AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TJclStringListImpl._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  if Result = 1 then
  begin
    // When there is only one reference, it is the internal reference,
    // so we release it. The compiler will call _Release again and
    // the object will be destroyed.
    FSelfAsInterface := nil;
  end
  else
  if Result = 0 then
    Destroy;
end;

function TJclStringListImpl.DeleteRegEx(const APattern: string): IJclStringList;
var
  I: Integer;
begin
  AutoUpdateControl;
  for I := LastIndex downto 0 do
    if MatchRegEx(Strings[I], APattern) then
      Delete(I);
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.KeepRegEx(const APattern: string): IJclStringList;
var
  I: Integer;
begin
  AutoUpdateControl;
  for I := LastIndex downto 0 do
    if not MatchRegEx(Strings[I], APattern) then
      Delete(I);
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.MatchRegEx(const S, APattern: string): Boolean;
begin
  if FRegEx = nil then
    FRegEx := TJclAnsiRegEx.Create;
  if FLastRegExPattern <> APattern then
  begin
    {$IFDEF COMPILER6_UP}
    if CaseSensitive then
      FRegEx.Options := FRegEx.Options - [roIgnoreCase]
    else
      FRegEx.Options := FRegEx.Options + [roIgnoreCase];
    {$ENDIF COMPILER6_UP}
    FRegEx.Compile(APattern, False, True);
    FLastRegExPattern := APattern;
  end;
  Result := FRegEx.Match(S);
end;

destructor TJclStringListImpl.Destroy;
begin
  if CanFreeObjects then
    FreeObjects(False);
  FreeAndNil(FUpdateControl);
  FreeAndNil(FRegEx);
  inherited Destroy;
end;

function TJclStringListImpl.Directories(const APattern: string = '*';
  ARecursive: Boolean = False; const ARegExPattern: string = ''): IJclStringList;

  procedure DoDirectories(const APattern: string);
  var
    LSearchRec: TSearchRec;
    LFullName: string;
    LPath: string;
  begin
    LPath := ExtractFilePath(APattern);
    if FindFirst(APattern, faAnyFile, LSearchRec) = 0 then
      try
        repeat
          if (LSearchRec.Attr and faDirectory = 0) or
             (LSearchRec.Name = '.') or (LSearchRec.Name = '..') then
            Continue;
          LFullName := LPath + LSearchRec.Name;
          if (ARegExPattern = '') or MatchRegEx(LFullName, ARegExPattern) then
            Add(LFullName);
          if ARecursive then
            DoDirectories(PathAddSeparator(LFullName) + ExtractFileName(APattern));
        until FindNext(LSearchRec) <> 0;
      finally
        FindClose(LSearchRec);
      end;
  end;

begin
  AutoUpdateControl;
  if DirectoryExists(APattern) then
    DoDirectories(PathAddSeparator(APattern) + '*')
  else
    DoDirectories(APattern);
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.Files(const APattern: string = '*';
  ARecursive: Boolean = False; const ARegExPattern: string = ''): IJclStringList;

  procedure DoFiles(const APattern: string);
  var
    LSearchRec: TSearchRec;
    LFullName: string;
    LDirectories: IJclStringList;
    LPath: string;
    I: Integer;
  begin
    LPath := ExtractFilePath(APattern);
    if FindFirst(APattern, faAnyFile and not faDirectory, LSearchRec) = 0 then
    begin
      try
        repeat
          if (LSearchRec.Attr and faDirectory <> 0) or
             (LSearchRec.Name = '.') or (LSearchRec.Name = '..') then
            Continue;
          LFullName := LPath + LSearchRec.Name;
          if (ARegExPattern = '') or MatchRegEx(LFullName, ARegExPattern) then
            Add(LFullName);
        until FindNext(LSearchRec) <> 0;
      finally
        FindClose(LSearchRec);
      end;
    end;
    if ARecursive then
    begin
      LDirectories := JclStringList.Directories(LPath + '*', False);
      for I := 0 to LDirectories.LastIndex do
        DoFiles(PathAddSeparator(LDirectories[I]) + ExtractFileName(APattern));
    end;
  end;

begin
  AutoUpdateControl;
  if DirectoryExists(APattern) then
    DoFiles(PathAddSeparator(APattern) + '*')
  else
    DoFiles(APattern);
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.LastIndex: Integer;
begin
  { The code bellow is more optimized than "Result := Count - 1". }
  Result := Count;
  Dec(Result);
end;

constructor TJclStringListImpl.Create;
begin
  inherited Create;
  FUpdateControl := TUpdateControl.Create(Self);
  if QueryInterface(IJclStringList, FSelfAsInterface) <> 0 then
    {$IFDEF COMPILER5}
    RunError(228 { reIntfCastError });
    {$ELSE}
    System.Error(reIntfCastError);
    {$ENDIF COMPILER5}
end;

function TJclStringListImpl.GetLists(Index: Integer): IJclStringList;
begin
  Result := Interfaces[Index] as IJclStringList;
  if Result = nil then
  begin
    Result := JclStringList;
    Interfaces[Index] := Result;
  end;
end;

procedure TJclStringListImpl.SetLists(Index: Integer; const Value: IJclStringList);
begin
  Interfaces[Index] := Value;
end;

function TJclStringListImpl.GetStringsRef: TStrings;
begin
  Result := Self;
end;

function TJclStringListImpl.GetKeyInterface(const AKey: string): IInterface;
var
  I: Integer;
begin
  I := IndexOf(AKey);
  if I >= 0 then
    Result := Interfaces[I]
  else
    Result := nil;
end;

function TJclStringListImpl.GetKeyObject(const AKey: string): TObject;
var
  I: Integer;
begin
  I := IndexOf(AKey);
  if I >= 0 then
    Result := Objects[I]
  else
    Result := nil;
end;

procedure TJclStringListImpl.SetKeyInterface(const AKey: string; const Value: IInterface);
var
  I: Integer;
begin
  I := IndexOf(AKey);
  if I < 0 then
    I := Add(AKey);
  Interfaces[I] := Value
end;

procedure TJclStringListImpl.SetKeyObject(const AKey: string; const Value: TObject);
var
  I: Integer;
begin
  I := IndexOf(AKey);
  if I < 0 then
    AddObject(AKey, Value)
  else
    Objects[I] := Value;
end;

function TJclStringListImpl.ConfigAsSet: IJclStringList;
begin
  Sorted := True;
  Duplicates := dupIgnore;
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.GetKeyVariant(const AKey: string): Variant;
var
  I: Integer;
begin
  I := IndexOf(AKey);
  if I >= 0 then
    Result := Variants[I]
  else
    Result := Unassigned;
end;

procedure TJclStringListImpl.SetKeyVariant(const AKey: string; const Value: Variant);
var
  I: Integer;
begin
  I := IndexOf(AKey);
  if I < 0 then
    I := Add(AKey);
  Variants[I] := Value
end;

function TJclStringListImpl.GetValue(const Name: string): string;
begin
  Result := inherited Values[Name];
end;

procedure TJclStringListImpl.SetValue(const Name, Value: string);
begin
  inherited Values[Name] := Value;
end;

function TJclStringListImpl.GetInterfaceByIndex(AIndex: Integer): IInterface;
var
  V: TInterfaceWrapper;
begin
  if FObjectsMode <> omInterfaces then
    EnsureObjectsMode(omInterfaces);
  V := TInterfaceWrapper(inherited Objects[AIndex]);
  if V = nil then
    Result := nil
  else
    Result := V.FValue;
end;

procedure TJclStringListImpl.SetInterfaceByIndex(Index: Integer; const Value: IInterface);
var
  V: TInterfaceWrapper;
begin
  if FObjectsMode <> omInterfaces then
    EnsureObjectsMode(omInterfaces);
  V := TInterfaceWrapper(inherited Objects[Index]);
  if V = nil then
  begin
    V := TInterfaceWrapper.Create;
    inherited Objects[Index] := V;
  end;
  V.FValue := Value;
end;

function TJclStringListImpl.GetObjects(Index: Integer): TObject;
begin
  if FObjectsMode <> omObjects then
    EnsureObjectsMode(omObjects);
  Result := inherited Objects[Index];
end;

procedure TJclStringListImpl.SetObjects(Index: Integer; const Value: TObject);
begin
  if FObjectsMode <> omObjects then
    EnsureObjectsMode(omObjects);
  inherited Objects[Index] := Value;
end;

function TJclStringListImpl.GetVariants(AIndex: Integer): Variant;
var
  V: TVariantWrapper;
begin
  if FObjectsMode <> omVariants then
    EnsureObjectsMode(omVariants);
  V := TVariantWrapper(inherited Objects[AIndex]);
  if V = nil then
    Result := Unassigned
  else
    Result := V.FValue;
end;

procedure TJclStringListImpl.SetVariants(Index: Integer; const Value: Variant);
var
  V: TVariantWrapper;
begin
  if FObjectsMode <> omVariants then
    EnsureObjectsMode(omVariants);
  V := TVariantWrapper(inherited Objects[Index]);
  if V = nil then
  begin
    V := TVariantWrapper.Create;
    inherited Objects[Index] := V;
  end;
  V.FValue := Value;
end;

procedure TJclStringListImpl.EnsureObjectsMode(AMode: TJclStringListObjectsMode);
begin
  if FObjectsMode <> AMode then
  begin
    if FObjectsMode <> omNone then
    begin
      raise Exception.CreateFmt('Objects cannot be used as "%s" because it has been used as "%s".',
        [GetEnumName(TypeInfo(TJclStringListObjectsMode), Ord(AMode)),
        GetEnumName(TypeInfo(TJclStringListObjectsMode), Ord(FObjectsMode))]);
    end;
    FObjectsMode := AMode;
  end;
end;

function TJclStringListImpl.GetKeyList(const AKey: string): IJclStringList;
begin
  Result := KeyInterface[AKey] as IJclStringList;
  if Result = nil then
  begin
    Result := JclStringList;
    KeyInterface[AKey] := Result;
  end;
end;

procedure TJclStringListImpl.SetKeyList(const AKey: string; const Value: IJclStringList);
begin
  KeyInterface[AKey] := Value;
end;

function TJclStringListImpl.Delete(AIndex: Integer): IJclStringList;
begin
  if CanFreeObjects then
    inherited Objects[AIndex].Free;
  inherited Delete(AIndex);
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.Delete(const AString: string): IJclStringList;
begin
  Result := Delete(IndexOf(AString));
end;

function TJclStringListImpl.Exchange(Index1, Index2: Integer): IJclStringList;
begin
  inherited Exchange(Index1, Index2);
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.Sort(ACompareFunction: TJclStringListSortCompare = nil): IJclStringList;

  function LocalSort(List: TStringList; Index1, Index2: Integer): Integer;
  begin
    Result := ACompareFunction(FSelfAsInterface, Index1, Index2);
  end;

begin
  if not Assigned(ACompareFunction) then
    inherited Sort
  else
    inherited CustomSort(@LocalSort);
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.SortAsInteger: IJclStringList;

  function LocalSortAsInteger(List: TStringList; Index1, Index2: Integer): Integer;
  begin
    Result := StrToInt(List[Index1]) - StrToInt(List[Index2]);
  end;

begin
  inherited CustomSort(@LocalSortAsInteger);
  Result := FSelfAsInterface;
end;

{$IFDEF COMPILER5}
function TJclStringListImpl.CompareStrings(const S1, S2: string): Integer;
begin
  Result := AnsiCompareText(S1, S2);
end;
{$ENDIF COMPILER5}

function TJclStringListImpl.SortByName: IJclStringList;

  function LocalSortByName(List: TStringList; Index1, Index2: Integer): Integer;
  begin
    Result := TJclStringListImpl(List).CompareStrings(List.Names[Index1], List.Names[Index2]);
  end;

begin
  inherited CustomSort(@LocalSortByName);
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.Insert(Index: Integer; const S: string): IJclStringList;
begin
  inherited Insert(Index, S);
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.InsertObject(Index: Integer; const S: string; AObject: TObject): IJclStringList;
begin
  inherited InsertObject(Index, S, AObject);
  Result := FSelfAsInterface;
end;

{$IFDEF COMPILER6_UP}
function TJclStringListImpl.GetCaseSensitive: Boolean;
begin
  Result := inherited CaseSensitive;
end;
{$ENDIF COMPILER6_UP}

function TJclStringListImpl.GetDuplicates: TDuplicates;
begin
  Result := inherited Duplicates;
end;

function TJclStringListImpl.GetOnChange: TNotifyEvent;
begin
  Result := inherited OnChange;
end;

function TJclStringListImpl.GetOnChanging: TNotifyEvent;
begin
  Result := inherited OnChanging;
end;

function TJclStringListImpl.GetSorted: Boolean;
begin
  Result := inherited Sorted;
end;

{$IFDEF COMPILER6_UP}
procedure TJclStringListImpl.SetCaseSensitive(const Value: Boolean);
begin
  inherited CaseSensitive := Value;
end;
{$ENDIF COMPILER6_UP}

procedure TJclStringListImpl.SetDuplicates(const Value: TDuplicates);
begin
  inherited Duplicates := Value;
end;

procedure TJclStringListImpl.SetOnChange(const Value: TNotifyEvent);
begin
  inherited OnChange := Value;
end;

procedure TJclStringListImpl.SetOnChanging(const Value: TNotifyEvent);
begin
  inherited OnChanging := Value;
end;

procedure TJclStringListImpl.SetSorted(const Value: Boolean);
begin
  inherited Sorted := Value;
end;

function TJclStringListImpl.LoadFromFile(const FileName: string): IJclStringList;
begin
  inherited LoadFromFile(FileName);
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.LoadFromStream(Stream: TStream): IJclStringList;
begin
  inherited LoadFromStream(Stream);
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.SaveToFile(const FileName: string): IJclStringList;
begin
  inherited SaveToFile(FileName);
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.SaveToStream(Stream: TStream): IJclStringList;
begin
  inherited SaveToStream(Stream);
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.GetCommaText: string;
begin
  Result := inherited CommaText;
end;

{$IFDEF COMPILER6_UP}

function TJclStringListImpl.GetDelimitedText: string;
begin
  Result := inherited DelimitedText;
end;

function TJclStringListImpl.GetDelimiter: Char;
begin
  Result := inherited Delimiter;
end;

{$ENDIF COMPILER6_UP}

function TJclStringListImpl.GetName(Index: Integer): string;
begin
  Result := inherited Names[Index];
end;

{$IFDEF COMPILER7_UP}

function TJclStringListImpl.GetNameValueSeparator: Char;
begin
  Result := inherited NameValueSeparator;
end;

function TJclStringListImpl.GetValueFromIndex(Index: Integer): string;
begin
  Result := inherited ValueFromIndex[Index];
end;

{$ENDIF COMPILER7_UP}

{$IFDEF COMPILER6_UP}
function TJclStringListImpl.GetQuoteChar: Char;
begin
  Result := inherited QuoteChar;
end;
{$ENDIF COMPILER6_UP}

procedure TJclStringListImpl.SetCommaText(const Value: string);
begin
  inherited CommaText := Value;
end;

{$IFDEF COMPILER6_UP}

procedure TJclStringListImpl.SetDelimitedText(const Value: string);
begin
  inherited DelimitedText := Value;
end;

procedure TJclStringListImpl.SetDelimiter(const Value: Char);
begin
  inherited Delimiter := Value;
end;

{$ENDIF COMPILER6_UP}

{$IFDEF COMPILER7_UP}

procedure TJclStringListImpl.SetNameValueSeparator(const Value: Char);
begin
  inherited NameValueSeparator := Value;
end;

procedure TJclStringListImpl.SetValueFromIndex(Index: Integer; const Value: string);
begin
  inherited ValueFromIndex[Index] := Value;
end;

{$ENDIF COMPILER7_UP}

{$IFDEF COMPILER6_UP}
procedure TJclStringListImpl.SetQuoteChar(const Value: Char);
begin
  inherited QuoteChar := Value;
end;
{$ENDIF COMPILER6_UP}

function TJclStringListImpl.Delimit(const ADelimiter: string): IJclStringList;
var
  I: Integer;
begin
  AutoUpdateControl;
  for I := 0 to LastIndex do
    Strings[I] := ADelimiter + Strings[I] + ADelimiter;
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.LoadExeParams: IJclStringList;
var
  I: Integer;
  S: string;
begin
  AutoUpdateControl;
  Clear;
  for I := 1 to ParamCount do
  begin
    S := ParamStr(I);
    if S[1] in ['-', '/'] then
      System.Delete(S, 1, 1);
    Add(S);
  end;
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.Exists(const S: string): Boolean;
begin
  Result := IndexOf(S) >= 0;
end;

function TJclStringListImpl.ExistsName(const S: string): Boolean;
begin
  Result := IndexOfName(S) >= 0;
end;

function TJclStringListImpl.DeleteBlanks: IJclStringList;
var
  I: Integer;
begin
  AutoUpdateControl;
  for I := LastIndex downto 0 do
    if SysUtils.Trim(Strings[I]) = '' then
      Delete(I);
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.KeepIntegers: IJclStringList;
var
  I, X: Integer;
begin
  AutoUpdateControl;
  for I := LastIndex downto 0 do
    if not TryStrToInt(Strings[I], X) then
      Delete(I);
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.DeleteIntegers: IJclStringList;
var
  I, X: Integer;
begin
  AutoUpdateControl;
  for I := LastIndex downto 0 do
    if TryStrToInt(Strings[I], X) then
      Delete(I);
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.FreeObjects(AFreeAndNil: Boolean = False): IJclStringList;
var
  I: Integer;
begin
  if AFreeAndNil then
    AutoUpdateControl;
  for I := 0 to LastIndex do
  begin
    inherited Objects[I].Free;
    if AFreeAndNil then
      inherited Objects[I] := nil;
  end;
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.ReleaseInterfaces: IJclStringList;
var
  I: Integer;
begin
  AutoUpdateControl;
  for I := 0 to LastIndex do
    Interfaces[I] := nil;
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.Clone: IJclStringList;
begin
  Result := JclStringList.Assign(Self);
end;

function TJclStringListImpl.Assign(Source: TPersistent): IJclStringList;
var
  L: TJclStringListImpl;
  I: Integer;
begin
  inherited Assign(Source);
  if Source is TJclStringListImpl then
  begin
    L := TJclStringListImpl(Source);
    FObjectsMode := L.FObjectsMode;
    if not (FObjectsMode in [omNone, omObjects]) then
    begin
      AutoUpdateControl;
      for I := 0 to LastIndex do
      begin
        inherited Objects[I] := nil;
        case FObjectsMode of
          omVariants:
            Variants[I] := L.Variants[I];
          omInterfaces:
            Interfaces[I] := L.Interfaces[I];
        end;
      end;
    end;
  end;
  Result := FSelfAsInterface;
end;

function TJclStringListImpl.CanFreeObjects: Boolean;
begin
  Result := not (FObjectsMode in [omNone, omObjects]);
end;

function TJclStringListImpl.GetObjectsMode: TJclStringListObjectsMode;
begin
  Result := FObjectsMode;
end;

//=== { TUpdateControl } =====================================================

constructor TUpdateControl.Create(AStrings: TStrings);
begin
  inherited Create;
  FStrings := AStrings;
end;

function TUpdateControl._AddRef: Integer;
begin
  FStrings.BeginUpdate;
  Result := 0;
end;

function TUpdateControl._Release: Integer;
begin
  FStrings.EndUpdate;
  Result := 0;
end;

function TUpdateControl.QueryInterface(const IID: TGUID; out Obj): HRESULT;
begin
  if GetInterface(IID, Obj) then
    Result := S_OK
  else
    Result := E_NOINTERFACE;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.