Entweder mache ich Grundlegend etwas verkehrt oder irgendwo in meinem Kode ist mir ein Fehler unterlaufen.
Ich schaffe es partout nicht das ich mehr als einmal etwas verschlüsseln und entschlüsseln kann.
Wo ist mein Fehler, was mache ich falsch? *Hände über Kopf werf...*
Code: Alles auswählen
unit uMain;
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
// Demo done by KodeZwerg
// it utilized BlowFish encryption, LZMA compression,
// automatic base64 de/encode for displaying
// fully exposed (de-)compression methods based on TStream
// fully exposed (de-)crypted TStream methods
// (compression is included / activated by default)
// SHA1 hash protection against wrong password or corrupted data
// no external resources needed
// needed packages:
// fcl-base, hash, exCompress
interface
uses
Base64, BlowFish, Sha1, ULZMAEncoder, ULZMADecoder, ULZMACommon,
Classes , SysUtils , Forms , Controls , Graphics , Dialogs , ExtCtrls ,
StdCtrls ;
type
{ TfrmMain }
TfrmMain = class(TForm)
btnEncrypt: TButton;
btnDecrypt: TButton;
btnSave: TButton;
btnLoad: TButton;
cbEncrypted: TCheckBox;
edtPassword: TEdit;
lblBase64: TLabel;
lblCompressed: TLabel;
lblUncompressed: TLabel;
lblOriginal: TLabel;
lblPassword: TLabel;
lblEncrypted: TLabel;
lblDecrypted: TLabel;
mmoOriginal: TMemo;
mmoEncrypted: TMemo;
mmoDecrypted: TMemo;
pnlEncrypt: TPanel;
pnlAll: TPanel;
pnlMemos: TPanel;
pnlButtons: TPanel;
pnlOriginal: TPanel;
pnlPassword: TPanel;
pnlEncrypted: TPanel;
pnlDecrypted: TPanel;
pnlIsSame: TPanel;
rgIsSame: TRadioGroup;
procedure btnDecryptClick(Sender: TObject);
procedure btnEncryptClick(Sender: TObject);
procedure btnLoadClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
procedure cbEncryptedChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
strict private
private
public
end;
var
frmMain: TfrmMain;
implementation
{$R *.lfm}
{ TfrmMain }
function EncodeLZMA(const AInput: TStream; var AOutput: TStream): Boolean;
var
lzma: TLZMAEncoder;
i: Integer;
begin
Result := False;
if (AOutput <> nil) then
FreeAndNil(AOutput);
AOutput := TStringStream.Create('');
try
lzma := TLZMAEncoder.Create;
try
lzma.SetAlgorithm(2);
lzma.SetDictionarySize(28);
lzma.SetMatchFinder(2);
lzma.SeNumFastBytes(273);
lzma.SetLcLpPb(3, 0, 2);
lzma.SetEndMarkerMode(True);
lzma.WriteCoderProperties(AOutput);
for i := 0 to 7 do
WriteByte(AOutput,(-1 shr (8 * i)) and $FF);
AInput.Position := 0;
try
lzma.Code(AInput, AOutput, -1, -1);
except
end;
finally
lzma.Free;
end;
finally
Result := (AOutput.Size > 0);
end;
end;
function DecodeLZMA(const AInput: TStream; var AOutput: TStream): Boolean;
const
CPropertiesSize = 5;
var
lzma: TLZMADecoder;
i: Integer;
properties: array[0..4] of Byte;
v: Byte;
outSize: Int64;
begin
Result := False;
if (AOutput <> nil) then
FreeAndNil(AOutput);
AOutput := TStringStream.Create('');
try
lzma := TLZMADecoder.Create;
try
AInput.Position := 0;
AInput.Read(properties{%H-}, CPropertiesSize);
lzma.SetDecoderProperties(properties);
outSize := 0;
for i := 0 to 7 do
begin
v := {shortint}(ReadByte(AInput));
outSize := outSize or v shl (8 * i);
end;
try
lzma.Code(AInput, AOutput, outSize);
except
end;
finally
lzma.Free;
end;
finally
Result := (AOutput.Size > 0);
end;
end;
function EncryptBlowfish(const AInput: TStream; var AOutput: TStream; const APassword: string): Boolean;
var
LS: TStream;
bf: TBlowfishEncryptStream;
shaPassword, shaData: String;
i: Integer;
begin
Result := False;
if (AInput.Size > 0) then
begin
if (AOutput <> nil) then
FreeAndNil(AOutput);
try
try
EncodeLZMA(AInput, AOutput);
except
end;
shaPassword := SHA1Print(SHA1String(APassword));
shaData := SHA1Print(SHA1String(TStringStream(AOutput).DataString));
frmMain.LblUncompressed.Caption := 'Uncompressed:' + LineEnding + IntToStr(AInput.Size);
frmMain.LblCompressed.Caption := 'Compressed:' + LineEnding + IntToStr(AOutput.Size);
LS := TStringStream.Create('');
try
AOutput.Position := 0;
LS.CopyFrom(AOutput, AOutput.Size);
AOutput.Free;
AOutput := TStringStream.Create('');
LS.Position := 0;
AOutput.Position := 0;
bf := TBlowfishEncryptStream.Create(APassword, AOutput);
try
try
bf.CopyFrom(LS, LS.size);
except
end;
AOutput.Position := AOutput.Size;
AOutput.Write(shaPassword[1], Length(shaPassword));
AOutput.Write(shaData[1], Length(shaData));
AOutput.Position := 0;
finally
bf.free;
end;
finally
LS.Free;
end;
finally
Result := (AOutput.Size > 0);
end;
end;
end;
function DecryptBlowfish(const AInput: TStream; var AOutput: TStream; const APassword: string): Boolean;
var
LS: TStream;
bf: TBlowfishDecryptStream;
shaPassword, shaData: String;
WrongPW, Corrupted: Boolean;
begin
Result := False;
try
if (AInput.Size > 0) then
begin
if (AOutput <> nil) then
FreeAndNil(AOutput);
AOutput := TStringStream.Create('');
try
shaPassword := SHA1Print(SHA1String(APassword));
AInput.Position := AInput.Size - 80;
SetLength(shaData, 40);
AInput.Read(shaData[1], 40);
frmMain.mmoEncrypted.Lines.Add('shaPassword: ' + shaPassword);
frmMain.mmoEncrypted.Lines.Add('intPassword: ' + shaData);
WrongPW := (shaPassword <> shaData);
AInput.Position := AInput.Size - 40;
AInput.Read(shaData[1], 40);
AInput.Position := 0;
try
try
if (not WrongPW) then
bf := TBlowfishDecryptStream.Create(APassword, AInput);
if (not WrongPW) then
AOutput.CopyFrom(bf, AInput.Size);
except
end;
finally
end;
finally
if (not WrongPW) then
bf.free;
end;
if (not WrongPW) then
begin
LS := TStringStream.Create('');
try
AOutput.Position := 0;
LS.CopyFrom(AOutput, AOutput.Size - 80);
try
DecodeLZMA(LS, AOutput);
AOutput.Position := 0;
LS.Position := 0;
frmMain.mmoEncrypted.Lines.Add('shaData: ' + shaData);
frmMain.mmoEncrypted.Lines.Add('intData: ' + SHA1Print(SHA1String(TStringStream(LS).DataString)));
frmMain.mmoEncrypted.Lines.Add('intData: ' + SHA1Print(SHA1String(TStringStream(AOutput).DataString)));
Corrupted := (SHA1Print(SHA1String(TStringStream(LS).DataString)) <> shaData);
Corrupted := False; // override to see at least something...
if Corrupted then
begin
AOutput.Free;
AOutput := TStringStream.Create('');
end;
except
end;
finally
LS.Free;
end;
end;
end;
finally
Result := (AOutput.Size > 0);
end;
end;
procedure TfrmMain.btnEncryptClick(Sender: TObject);
var
I, o: TStream;
begin
I := TStringStream.Create(mmoOriginal.Text);
try
o := TStringStream.Create('');
try
if EncryptBlowfish(I, o, edtPassword.Text) then
begin
try
mmoEncrypted.Text := EncodeStringBase64(TStringStream(o).DataString);
except
end;
end
else
mmoEncrypted.Text := 'Encryption Error!';
lblBase64.Caption := 'Base64 Size:' + LineEnding + IntToStr(Length(mmoEncrypted.Text));
finally
o.Free;
end;
finally
I.Free;
end;
end;
procedure TfrmMain.cbEncryptedChange(Sender: TObject);
begin
mmoEncrypted.ReadOnly := (not (Sender as TCheckBox).Checked);
end;
procedure TfrmMain.btnDecryptClick(Sender: TObject);
var
I, o: TStream;
chk: Boolean;
begin
chk := False;
try
I := TStringStream.Create(DecodeStringBase64(mmoEncrypted.Text));
except
chk := True;
I.Free;
end;
if (not chk) then
begin
try
o := TStringStream.Create('');
try
if DecryptBlowfish(I, o, edtPassword.Text) then
mmoDecrypted.Text := (TStringStream(o).DataString)
else
mmoDecrypted.Text := 'Decryption Error!';
if (mmoOriginal.Text = mmoDecrypted.Text) then
rgIsSame.ItemIndex := 0
else
rgIsSame.ItemIndex := 1;
finally
o.Free;
end;
finally
I.Free;
end;
end
else
mmoDecrypted.Text := 'Decryption Error!';
end;
procedure TfrmMain.btnSaveClick(Sender: TObject);
var
ss, fs: TStream;
fn: string;
chk: Boolean;
begin
chk := False;
try
ss := TStringStream.Create(DecodeStringBase64(mmoEncrypted.Text));
except
chk := True;
ss.Free;
end;
if (not chk) then
begin
fn := ChangeFileExt(ParamStr(0), '.bin');
fs := TFileStream.Create(fn, fmCreate);
try
fs.CopyFrom(ss, ss.Size);
finally
fs.Free;
end;
end;
end;
procedure TfrmMain.btnLoadClick(Sender: TObject);
var
ss, fs: TStream;
fn: string;
chk: Boolean;
begin
fn := ChangeFileExt(ParamStr(0), '.bin');
chk := FileExists(fn);
if (not chk) then
Exit;
fs := TFileStream.Create(fn, fmOpenRead);
try
try
ss := TStringStream.Create('');
ss.CopyFrom(fs, fs.Size);
mmoEncrypted.Text := EncodeStringBase64(TStringStream(ss).DataString);
btnDecryptClick(Sender);
except
chk := True;
end;
finally
fs.Free;
ss.Free;
end;
if (not chk) then
begin
fn := ChangeFileExt(ParamStr(0), '.bin');
fs := TFileStream.Create(fn, fmCreate);
try
fs.CopyFrom(ss, ss.Size);
finally
fs.Free;
end;
end;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
btnEncryptClick(Sender);
btnDecryptClick(Sender);
rgIsSame.ItemIndex := 0;
end;
end.
(nur für Debug Zwecke hab ich hier desöfteren "Lines.Add()" enthalten.)
Ich hoffe jemand sieht meinen Fehler und kann mir weiterhelfen.