Einzelnen Beitrag anzeigen

Benmik

Registriert seit: 11. Apr 2009
532 Beiträge
 
Delphi 11 Alexandria
 
#42

AW: Sortierte TObjectList - Einträge richtig einfügen

  Alt 24. Sep 2015, 13:10
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;

Geändert von Benmik (24. Sep 2015 um 19:07 Uhr) Grund: David Heffernan
  Mit Zitat antworten Zitat