Sortierte TObjectList - Einträge richtig einfügen

[Sir Rufo]

Oder mit einer von diesen Routinen
http://docwiki.embarcadero.com/RADSt...leichsroutinen

[Benmik]

Da ich doch eine ganze Weile gebraucht habe, um mir einen zufriedenstellenden Code mit diversen Funktionalitäten zusammenzubasteln, stelle ich hier mal für alle Google-Ankömmlinge das Gerüst des Codes ein. Ich bin immer sehr dankbar für solche fertigen Codeteile bei Themen, bei denen ich Neuland betrete (hat ja auch schon unsere Kanzlerin bemerkt...).
Folgende zusätzliche Funktionalitäten habe ich benötigt und daher eingebaut:
- Ist ein gesuchter Wert mehrfach in der Liste vorhanden, gehe zum ersten
- Speichere und lade die Werte in einer / aus einer Datei
- Verschlüssele die Datei, falls gewünscht
- Stelle vor einer binären Suche sicher, dass die Liste (richtig) sortiert ist
Nochmal: Es handelt sich um ein Gerüst! Für Verbesserungen bin ich natürlich dankbar.
Ach, und noch was: Natürlich weiß ich, dass der Code style sowas von pfui ist. Seit ich aber mitbekommen habe, dass der allwissende Zuchtmeister David Heffernan (stackoverflow) ebenfalls nicht im Traum daran denkt, sich an die von oben aufoktroyierten Regeln zu halten, bin ich da doch freier geworden.

Delphi-Quellcode:

uses Classes,Generics.Defaults,Generics.Collections,SysUtils,Dialogs,Math,
     SynCrypto; // Synopse framework. Copyright (C) 2012 Arnaud Bouchez, http://synopse.info

type
  TSortArt    = (soNone,soByString,soByInteger);

type
  TQuelle = class(TObject)
    ValString  : String;
    ValInt     : Integer;

  end;

  TQuellListe = class(TObjectList<TQuelle>)
  private
    FSortierung : TSortArt;
    function CompInteger(const L,R: TQuelle) : Integer;
    function CompString(const L,R: TQuelle) : Integer;
  public
    constructor Create(OwnsObjects:Boolean = True);
    procedure Sort(SortArt:TSortArt);
    function  FindString(const Str:string;var P:Integer):Boolean;
    function  FindInt(const I:integer;var P:Integer):Boolean;
    function  AddSortedStr(const Ziel:TQuelle):Boolean;
    procedure SaveToFile(Dateiname:string;PW:string = '');
    procedure ReadFromFile(Dateiname:string;PW:string = '');
  end;


implementation

constructor TQuellListe.Create(OwnsObjects:Boolean = True);
begin
  inherited Create(TComparer<TQuelle>.Construct(CompString),OwnsObjects);
  FSortierung := soNone;
end;

function    TQuellListe.CompInteger(const L, R: TQuelle): Integer;
begin
  Result := TComparer<integer>.Default.Compare(L.ValInt,R.ValInt);
  // Schneller: Result := L.ValInt - R.ValInt;
end;

function    TQuellListe.CompString(const L, R: TQuelle): Integer;
begin
  Result := TComparer<string>.Default.Compare(L.ValString,R.ValString);
  // Oder: System.SysUtils.AnsiCompareStr, System.SysUtils.AnsiCompareText, ...
end;

procedure   TQuellListe.Sort(SortArt: TSortArt);
begin
  If Assigned(Self) and (Self.Count > 0) then begin
    Case SortArt of
      soByString   : inherited Sort(TComparer<TQuelle>.Construct(Self.CompString));
      soByInteger  : inherited Sort(TComparer<TQuelle>.Construct(Self.CompInteger));
    end;
    FSortierung := SortArt;
  end;
end;

function    TQuellListe.FindString(const Str: string; var P: Integer): Boolean;
var L:TQuelle;
begin
  Result := (FSortierung = soByString);
  p      := -1;
  If not Result then begin
    Showmessage('Liste ist nicht oder falsch sortiert!  ');   // Nur zum Testen
  end else begin
    Result := Assigned(Self) and (Self.Count > 0);
    If Result then begin
      L            := TQuelle.Create;
      L.ValString  := Str;
      try
        Result := BinarySearch(L, p,
          TComparer<TQuelle>.Construct(function (const L, R: TQuelle): Integer begin Result := AnsiCompareText(L.ValString,R.ValString); end));
        While Result and (p > 0) and (Self[p - 1].ValString = Str) do  // falls Str mehrfach vorhanden - in case of more than one occurence of Str
          Dec(p);
      Finally
        L.Free;
      end;
    end;
  end;
end;

function    TQuellListe.FindInt(const I: integer; var P: Integer): Boolean;
var L:TQuelle;
begin
  Result := (FSortierung = soByInteger);
  p    := -1;
  If not Result then begin
    Showmessage('Liste ist nicht oder falsch sortiert!  ');   // Nur zum Testen
  end else begin
    Result := Assigned(Self) and (Self.Count > 0);
    If Result then begin
      L        := TQuelle.Create;
      L.ValInt := I;
      try
        Result := BinarySearch(L, p,
        TComparer<TQuelle>.Construct(function (const L, R: TQuelle): Integer begin Result := CompareValue(L.ValInt,R.ValInt); end));
        While Result and (p > 0) and (Self[p - 1].ValInt = I) do
          Dec(p);
       Finally
         L.Free;
      end;
    end;
  end;
end;

procedure   TQuellListe.ReadFromFile(Dateiname: string;PW:string = '');
var Reader: TReader; Stream,VStream:TMemoryStream; Ziel:TQuelle; Digest: TSHA256Digest;
begin
  Stream := TMemoryStream.Create;
  If PW <> '' then begin
    VStream := TMemoryStream.Create;
    VStream.LoadFromFile(Dateiname);
    SHA256Weak(PW, Digest);
    VStream.Position := 0;
    SynCrypto.AESFull(Digest, 256, VStream.Memory, VStream.Size, Stream, False);
  end else begin
    Stream.LoadFromFile(Dateiname);
  end;
  Stream.Position := 0;
  Reader := TReader.Create(Stream, 4096);
  Try
    Self.Clear;
    Reader.ReadListBegin;
    While not Reader.EndOfList do begin
      Ziel             := TQuelle.Create;
      Ziel.ValInt      := Reader.ReadInteger;
      Ziel.ValString   := Reader.ReadString;

      Self.Add(Ziel);
    end;
    Reader.ReadListEnd;
  Except
    Showmessage(IntToStr(Self.Count));   // Nur zum Testen
    Reader.Free;
    Stream.Free;
    exit;
  End;
  Reader.Free;
  Stream.Free;
end;

procedure   TQuellListe.SaveToFile(Dateiname:string;PW:string = '');
var Writer: TWriter; Stream,VStream:TMemoryStream; i:integer; Digest: TSHA256Digest;
begin
  Stream := TMemoryStream.Create;
  Writer:= TWriter.Create(Stream, 4096);
  Try
    Writer.WriteListBegin;
    For i := 0 to Self.Count - 1 do begin
      Writer.WriteInteger(Self[i].ValInt);
      Writer.WriteString(Self[i].ValString);
    end;
    Writer.WriteListEnd;
    Writer.FlushBuffer;
    If PW <> '' then begin
      VStream := TMemoryStream.Create;
      SHA256Weak(PW, Digest);
      Stream.Position := 0;
      SynCrypto.AESFull(Digest, 256, Stream.Memory, Stream.Size, VStream, True);
      VStream.SaveToFile(Dateiname);
      VStream.Free;
    end else begin
      Stream.SaveToFile(Dateiname);
    end;
  Except
    Writer.Free;
    Stream.Free;
  End;
  Writer.Free;
  Stream.Free;
end;

function    TQuellListe.AddSortedStr(const Ziel: TQuelle): Boolean;
var P: Integer;
begin
  Result := Assigned(Ziel) and (Ziel.ValString <> '') and (FSortierung = soByString);
  If Result then begin
    FindString(Ziel.ValString,p);
    Result := (p > -1);
    If Result
      then Self.Insert(p,Ziel);
  end else if FSortierung <> soByString then begin
    Showmessage('Liste ist nicht oder falsch sortiert!  ');   // Nur zum Testen
  end;
end;

[Stevie]

Nur eine Anregung: Das Laden und Speichern nicht in die Listenklasse direkt implementieren - ja ich weiß, das ist so toll, direkt nen list.ReadFromFile zu machen.
Warum? Trennung von Zuständigkeiten - das eine ist eine Liste, die kümmert sich um das Verwalten von Objekten und das andere ist ein Speicher/Lade Mechanismus (zzgl Encryption).

Kann man alleine an den Uses schon sehen - eine Encryption Unit in einer Listenklasse Unit. Kann dir aus eigener Erfahrung berichten, dass sowas schnell ungeahnte Ausmaße annimmt.

Willst nur kurz ne kleine Anwendung schreiben, brauchst ne Liste und bumm ziehst dir dein halbes Code Repo mit rein, weil die alle miteinander verdrahtet sind (und am Ende am besten noch ne Abhängigkeit auf eine DLL, weil in irgendeiner Unit Funktionen daraus statisch importiert werden - alles schon gehabt)

[Benmik]

Eine Überlegung dazu: Ich vermute mal, dass TList und TObjectlist deswegen keine ReadFromFile/SaveToFile haben, weil keine Informationen über die Objekte vorliegen. Bei TStringList, wo dies bekannt ist, gibt es diese Funktionen, und TStringList ist ja auch nichts anderes als eine spezialisierte TList. Wenn man eine Liste mit selbst typisierten Objekten hat, dann finde ich es passend, auch die spezialisierte Routine in die Klasse zu geben.

Aber eigentlich ging es mir nur darum zu zeigen, wie es geht, denn die Kombination von TObjectlist, Stream, TWriter/TReader und dann auch noch Verschlüsselung war Neuland für mich. Das Cryptomodul war dabei echt nur eine Zugabe, aber doch eine nützliche, finde ich.

[Stevie]

Zitat von Benmik:

Eine Überlegung dazu: Ich vermute mal, dass TList und TObjectlist deswegen keine ReadFromFile/SaveToFile haben, weil keine Informationen über die Objekte vorliegen. Bei TStringList, wo dies bekannt ist, gibt es diese Funktionen, und TStringList ist ja auch nichts anderes als eine spezialisierte TList. Wenn man eine Liste mit selbst typisierten Objekten hat, dann finde ich es passend, auch die spezialisierte Routine in die Klasse zu geben.

Ja, so harmlos fängt das meist an Und dann sagt der eine, ich hätt das gern aber als csv, der nächste will xml, ein anderer json und wieder einer in irgendeinem wahnsinnigen Binärformat. Und dann haste am ende drölfzig Load/Read Methoden und/oder ne Horde an Parametern für irgendwelche Optionen. Und weil wir gerade dabei sind wär das noch toll, wenn die Liste ihre Objekte noch ausdrucken, in die Datenbank speichern und in die Cloud schicken könnte - und ja, auch hier berichte ich (zugegebenermaßen ein bisschen ausgeschmückt) aus der grausamen Realität.

[Benmik]

Lass mich raten: War ein harter Tag heute, Stevie, was?
Meine Klasse tut nichts Böses, die will nur spielen.

[Stevie]

Zitat von Benmik:

Lass mich raten: War ein harter Tag heute, Stevie, was?
Meine Klasse tut nichts Böses, die will nur spielen.

Nö, war eigentlich ziemlich gut heute - unter anderem zusammen mit unserem Azubi aus einer Komponente ca 20% des Codes rausgeworfen und nebenbei einige Bugs gefixt und neue Funktionalitäten hinzugefügt

Deshalb wollte ich nur ein bisschen sensibilisieren - denn ich seh das oft: hier noch was drangeflanscht und da noch was kurz reingetüftelt und dann kommt eines Tages jemand weinend an, weil er den Überblick verloren hat und nen winziger Fix ein Riesenrefaktoring nach sich zieht. Was jeder draus macht, ist ihm überlassen - ich bin nicht DH.

[Benmik]

Zitat von Stevie:

...nebenbei neue Funktionalitäten hinzugefügt...
...hier noch was drangeflanscht und da noch was kurz reingetüftelt und dann kommt eines Tages jemand weinend an, weil er den Überblick verloren hat...

Ist natürlich eine heiße Kombination

[Stevie]

Zitat von Benmik:

Zitat von Stevie:

...nebenbei neue Funktionalitäten hinzugefügt...
...hier noch was drangeflanscht und da noch was kurz reingetüftelt und dann kommt eines Tages jemand weinend an, weil er den Überblick verloren hat...

Ist natürlich eine heiße Kombination

Ok, zugegeben, das kann man nun fehlinterpretieren - die waren alle von der Kategorie UX Kinkerlitzchen