TStringList ignoriert doppelte Einträge nicht

[himitsu]

Auch wenn der Code, bei einer unsortierten Liste extrem langsam werden kann, was sich Aufgrund des Listentypes nicht ändern lößt.
Eine HashListe oder ein Suchindex in Form eines binären Baums oder einer weiteren Hashliste wäre besser.

Ich würde die OH ändern, vor den langsameren Einfügeoperationen waren und dann den Code so ändern:

Delphi-Quellcode:

procedure TStringList.Put(Index: Integer; const S: string);
begin
  if Cardinal(Index) >= Cardinal(FCount) then
    Error(@SListIndexError, Index);
  if (Duplicates <> dupIgnore) and (FList^[Index].FString <> S) and (IndexOf(S) >= 0) then
    case Duplicates of
      dupIgnore: begin
        Delete(Index);
        Exit;
      end;
      dupError: Error(@SDuplicateString, 0);
    end;
  Changing;
  FList^[Index].FString := S;
  Changed;
end;

function TStringList.AddObject(const S: string; AObject: TObject): Integer;
begin
  if not Sorted then
  begin
    if (Duplicates <> dupIgnore) and (IndexOf(S) >= 0) then
      case Duplicates of
        dupIgnore: Exit;
        dupError: Error(@SDuplicateString, 0);
      end;
    Result := FCount;
  end
  else
    if Find(S, Result) then
      case Duplicates of
        dupIgnore: Exit;
        dupError: Error(@SDuplicateString, 0);
      end;
  InsertItem(Result, S, AObject);
end;

procedure TStringList.InsertObject(Index: Integer; const S: string; AObject: TObject);
begin
  if Sorted then Error(@SSortedListError, 0);
  if (Index < 0) or (Index > FCount) then Error(@SListIndexError, Index);
  if (Duplicates <> dupIgnore) and (IndexOf(S) >= 0) then
    case Duplicates of
      dupIgnore: Exit;
      dupError: Error(@SDuplicateString, 0);
    end;
  InsertItem(Index, S, AObject);
end;

als neue Komponente ergibt das:

Delphi-Quellcode:

uses
  RTLConsts;

type
  TDupStringList = class(TStringList)
  protected
    procedure Put(Index: Integer; const S: string); override;
  public
    function AddObject(const S: String; AObject: TObject): Integer; override;
    procedure InsertObject(Index: Integer; const S: String; AObject: TObject); override;
  end;

procedure TDupStringList.Put(Index: Integer; const S: string);
begin
  if Cardinal(Index) >= Cardinal(Count) then
    Error(@SListIndexError, Index);
  if (Duplicates <> dupIgnore) and (Strings[Index] <> S) and (IndexOf(S) >= 0) then
    case Duplicates of
      dupIgnore: begin
        Delete(Index);
        Exit;
      end;
      dupError: Error(@SDuplicateString, 0);
    end;
  Inherited;
end;

function TDupStringList.AddObject(const S: string; AObject: TObject): Integer;
begin
  if not Sorted then
  begin
    if (Duplicates <> dupIgnore) and (IndexOf(S) >= 0) then
      case Duplicates of
        dupIgnore: Exit;
        dupError: Error(@SDuplicateString, 0);
      end;
    Result := Count;
  end
  else
    if Find(S, Result) then
      case Duplicates of
        dupIgnore: Exit;
        dupError: Error(@SDuplicateString, 0);
      end;
  InsertItem(Result, S, AObject);
end;

procedure TDupStringList.InsertObject(Index: Integer; const S: string; AObject: TObject);
begin
  if Sorted then Error(@SSortedListError, 0);
  if (Index < 0) or (Index > Count) then Error(@SListIndexError, Index);
  if (Duplicates <> dupIgnore) and (IndexOf(S) >= 0) then
    case Duplicates of
      dupIgnore: Exit;
      dupError: Error(@SDuplicateString, 0);
    end;
  InsertItem(Index, S, AObject);
end;

Code ungetestet, da einfach so dahingetippt, aber er sollte funktionieren.