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;