// Mit diesem Code
kann man große Dateien verhältnismäßig schnell unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Gauges;
type
art = (encrypt, decrypt);
TForm1 = class(TForm)
OpenDialog1: TOpenDialog;
Button1: TButton;
Button2: TButton;
Gauge1: TGauge;
Button3: TButton;
Button4: TButton;
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private-Deklarationen }
public
function work(const Datei, Key: string; was: art;
gauge: TGauge; prf: boolean): byte;
procedure Crypt(const Key: string; was: art;
berechtigung: boolean = true);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
stopp: boolean;
procedure TForm1.FormCreate(Sender: TObject);
begin
Gauge1.progress := 0;
end;
function hash(const s: string): string;
var
x, z, i, erg: integer;
begin
erg := 1;
result := '';
for z := 2 to 11 do begin
for x := 1 to length(s) do
erg := (erg * 2 + ord(s[x]) * (z - ord(odd(x)) * (z - 1))) mod 97;
i := erg mod 10;
if (i = 0) or (i = 8) then inc(i);
result := result + chr(i);
end;
end;
function TForm1.work(const Datei, Key: string; was: art;
gauge: TGauge; prf: boolean): byte;
var
grss, x, buf, anz, hlp, u: Cardinal;
s, h, v, b, kennung, usr: string;
quelle, ziel: TMemoryStream;
schlssl: array of byte;
k, lg, lk, i: integer;
bq, bz: boolean;
p: pchar;
procedure ende;
begin
if bq then quelle.free;
if bz then ziel.free;
schlssl := nil;
screen.cursor := crdefault;
end;
begin
if not fileexists(Datei) then begin
result := 1;
exit;
end;
lg := length(key);
if (lg < 3) or (lg > 255) then begin
result := 2;
exit;
end;
screen.cursor := crhourglass;
lk := 10;
u := max_path;
getmem(p, u);
getusername(p, u);
usr := p;
freemem(p);
try
k := 0;
for x := 1 to lg do
k := k + ord(key[x]);
randseed := k shl 1;
lg := 500;
setlength(schlssl, lg);
for x := 0 to pred(lg) do
schlssl[x] := random(224) + 32;
bz := false;
bq := bz;
hlp := random(654321) or 123456789;
setlength(b, lk);
setlength(kennung, lk);
for x := 1 to 10 do begin
kennung[x] := chr(random(32) + 9);
b[x] := chr(random(222) + 9);
end;
try
quelle := TMemoryStream.create;
bq := true;
except
result := 3;
ende;
exit;
end;
try
quelle.loadfromfile(datei);
grss := quelle.size;
if grss = 0 then begin
result := 4;
ende;
exit;
end;
gauge.maxvalue := 4 + grss div 4;
except
result := 5;
ende;
exit;
end;
try
ziel := TMemorystream.create;
bz := true;
ziel.setsize(grss);
ziel.position := 0;
except
result := 6;
ende;
exit;
end;
try
quelle.position := 0;
i := 0;
if prf or (was = decrypt) then
h := hash(usr)
else h := b;
if was = encrypt then begin
ziel.WriteBuffer(kennung[1], lk);
ziel.writebuffer(h[1], lk);
ziel.WriteBuffer(grss, 4);
end else begin
setlength(s, lk);
setlength(v, lk);
quelle.Read(s[1], lk);
quelle.Read(v[1], lk);
quelle.Read(grss, 4);
if s <> kennung then begin
result := 7;
ende;
exit;
end;
if (h <> v) and (v <> b) then begin
result := 8;
ende;
exit;
end;
end;
for x := 0 to grss div 4 do begin
anz := quelle.read(buf, 4);
buf := buf xor (schlssl[i] or hlp);
ziel.write(buf, anz);
application.processmessages;
if stopp or application.terminated then begin
result := 9;
ende;
exit;
end;
inc(i);
if i = lg then i := 0;
gauge.progress := succ(gauge.progress);
end;
if was = decrypt then ziel.setsize(grss);
except
result := 10;
ende;
exit;
end;
try
quelle.free;
bq := false;
ziel.savetofile(datei); // Ausgangsdatei wird überschrieben
gauge.progress := gauge.MaxValue;
gauge.refresh;
sleep(200);
except
result := 11;
ende;
exit;
end;
result := 0;
except
result := 255;
end;
ende;
end;
procedure TForm1.Crypt(const Key: string; was: art;
berechtigung: boolean = true);
var
Meldung, s: string;
begin
if OpenDialog1.execute then begin
stopp := false;
if was = encrypt then s := 'Ver' else s := 'Ent';
case work(OpenDialog1.Filename, key, was, Gauge1, berechtigung) of
0: Meldung := 'Erfolgreich beendet';
1: Meldung := 'Datei nicht gefunden';
2: Meldung := 'Passwort muss eine Länge von 3 bis 255 Zeichen haben';
3: Meldung := 'Quellstream wurde nicht erstellt';
4: Meldung := 'Leere Dateien können nicht bearbeitet werden';
5: Meldung := 'Datei konnte nicht geladen werden';
6: Meldung := 'Fehler beim Erstellen des Zielstreams';
7: Meldung := 'Datei kann nicht entschlüsselt werden';
8: Meldung := 'Sie sind nicht berechtigt diese Datei zu entschlüsseln';
9: Meldung := 'Abbruch durch den Benutzer';
10: Meldung := 'Fehler beim ' + s + 'schlüsseln aufgetreten';
11: Meldung := 'Abspeichern fehlgeschlagen';
else
Meldung := 'Unerwarteter Fehler';
end;
if not application.terminated then begin
Gauge1.progress := 0;
showmessage(Meldung);
end;
end;
end;
// ---------- Beispielaufrufe ----------
// Verschlüsseln mit User-Berechtigung.
// Nur Sie selbst dürfen entschlüsseln.
procedure TForm1.Button1Click(Sender: TObject);
begin
crypt('MeinPasswort', encrypt);
end;
// Verschlüsseln ohne User-Berechtigung.
// Jeder, der das Passwort kennt, darf entschlüsseln.
procedure TForm1.Button2Click(Sender: TObject);
begin
crypt('MeinPasswort', encrypt, false);
end;
// Entschlüsseln
procedure TForm1.Button3Click(Sender: TObject);
begin
crypt('MeinPasswort', decrypt);
end;
// Vorgang (bei sehr großen Dateien) abbrechen
procedure TForm1.Button4Click(Sender: TObject);
begin
stopp := true;
end;
end.
|
