unit RCStreamDeco;
// written by maximov 19.02.2005
// Die TRC?StreamDecorator Klassen machen es möglich, die Funktionalitat jedes
// beliebigen Streams, um eine RC4 oder RCx (ein RC4 derivat von Hagen)
// Verschlüsselung (siehe hagEnCode.pas und RCx.pas) zu
// erweitern. Wobei die Erweiterung der Funktionalitat nicht durch eine starre
// Ableitung realisiert wird, sondern durch das Dekorierer-Entwurfsmuster,
// dh. der Dekorierer verpackt (wrappen) einen beliebigen Stream und delegiert
// alle Aufrufe an ihn weiter, oder modifiziert sie (lesen, schreiben).
// Die Lese-und Schreibaufrufe werden abgefangen und die Kodierung durchgefuhrt.
// Wobei die Schnittstelle nach außsen die gleiche bleibt, damit der Dekorierer wie
// ein ganz normaler Stream behandelt werden kann.
// Allgemeine informationen zum Prinzip des Dekorierers:
// [url]http://de.wikipedia.org/wiki/Dekorierer[/url]
// In diesen Stromverschlüsselungen, ist ein Springen im Strom nicht moglich,
// da sonst der aktuelle Kontext nicht mehr stimmen würde und somit der Output
// unbrauchbar ware. Dh. bei expliziten Seek aufrufen wird die Exception
// ERCSeekNotAllowed geschmissen!
// Die RC4 Kodierung von Hagen Redmann kann man hier einsehen -> HagEnCode.pas
// [url]http://www.delphipraxis.net/topic30830_rc4verschluesselung.html[/url]
// 20.02.2005 - Veröffentlichung!
// 21.02.2005 - Seek Exception, um im richtigen Kontext zu bleiben.
// 21.02.2005 - Temp-Buffer in Read entfernt.
// 25.02.2005 - Abstrakte Oberklasse geschaffen.
// 25.02.2005 - Hangens RC4 derivat RCx integriert.
interface
uses classes, hagEnCode, RCx, sysUtils;
type
ERCSeekNotAllowed =
class(
Exception);
EInvalidDecryption =
class(
Exception);
TEncodeMode = (emEncodeWriting, emEncodeReading);
TRCStreamDecorator =
class(TStream)
private
FStream:TStream;
FOwnsStream:boolean;
FEncodeMode:TEncodeMode;
protected
function GetSize: Int64;
override;
procedure SetSize(
const NewSize: Int64);
overload;
override;
procedure SetSize(NewSize: Longint);
overload;
override;
procedure Encode(
const source;
var dest; Count:integer);
virtual;
abstract;
procedure Decode(
const source;
var dest; Count:integer);
virtual;
abstract;
procedure SetPassword(
const Value:
string);
virtual;
abstract;
public
constructor Create(aStream:TStream; OwnsStream:boolean = true);
overload;
constructor Create(aStream:TStream; OwnsStream:boolean;
const aPassword:
string; theEncodeMode:TEncodeMode = emEncodeWriting);
overload;
destructor Destroy;
override;
function Write(
const Buffer; Count: Integer): Integer;
override;
function Read(
var Buffer; Count: Integer): Integer;
override;
function Seek(Offset: Integer; Origin: Word): Integer;
overload;
override;
function Seek(
const Offset: Int64; Origin: TSeekOrigin): Int64;
overload;
override;
property Password:
string write SetPassword;
property EncodeMode:TEncodeMode
read FEncodeMode
write FEncodeMode;
end;
TRC4StreamDecorator =
class(TRCStreamDecorator)
private
FRC4:TRC4Context;
procedure SetSandbox(
const Value: TRC4Context);
protected
procedure Encode(
const source;
var dest; Count: Integer);
override;
procedure Decode(
const source;
var dest; Count: Integer);
override;
procedure SetPassword(
const Value:
String);
override;
public
destructor Destroy;
override;
property Sandbox:TRC4Context
write SetSandbox;
end;
TRCxStreamDecorator =
class(TRCStreamDecorator)
private
FRCx:TRCxContext;
procedure SetSandbox(
const Value: TRCxContext);
protected
procedure Encode(
const source;
var dest; Count: Integer);
override;
procedure Decode(
const source;
var dest; Count: Integer);
override;
procedure SetPassword(
const Value:
String);
override;
public
destructor Destroy;
override;
procedure WriteSalt(Size: Byte = 16);
procedure ReadSalt;
property Sandbox:TRCxContext
write SetSandbox;
end;
implementation
procedure ProtectString(
var Value:
String);
begin
FillChar(Pointer(Value)^, Length(Value), 0);
end;
function Checksum(
const Value:
String): Byte;
var
I: Integer;
begin
Result := 0;
for I := 1
to Length(Value)
do
Inc(Result, Result
xor Ord(Value[I]));
end;
{ TRCStreamDecorator }
constructor TRCStreamDecorator.Create(aStream: TStream; OwnsStream:boolean;
const aPassword:
string; theEncodeMode:TEncodeMode = emEncodeWriting);
begin
Create(aStream, OwnsStream);
Password := aPassword;
EncodeMode := theEncodeMode;
end;
constructor TRCStreamDecorator.Create(aStream: TStream;
OwnsStream: boolean);
begin
Assert(assigned(aStream),'
The decorated stream is not assigned');
FStream := aStream;
FOwnsStream := OwnsStream;
FEncodeMode := emEncodeWriting;
end;
destructor TRCStreamDecorator.Destroy;
begin
if FOwnsStream
then
FStream.Free;
FStream :=
nil;
inherited;
end;
function TRCStreamDecorator.
Read(
var Buffer; Count: Integer): Integer;
begin
result := FStream.
Read(Buffer, count);
case EncodeMode
of
emEncodeWriting: Decode(Buffer, Buffer, Result);
// abstrakter aufruf
emEncodeReading: Encode(Buffer, Buffer, Result);
// abstrakter aufruf
end;
end;
function TRCStreamDecorator.
Write(
const Buffer; Count: Integer): Integer;
var
temp:pointer;
begin
GetMem(temp, count);
case EncodeMode
of
emEncodeWriting: Encode(Buffer, temp^, Count);
// abstrakter aufruf
emEncodeReading: Decode(Buffer, temp^, Count);
// abstrakter aufruf
end;
result := FStream.
Write(temp^, count);
FreeMem(temp, count);
end;
function TRCStreamDecorator.GetSize: Int64;
begin
result := FStream.Size;
end;
procedure TRCStreamDecorator.SetSize(
const NewSize: Int64);
begin
FStream.Size := NewSize;
end;
procedure TRCStreamDecorator.SetSize(NewSize: Integer);
begin
FStream.Size := NewSize;
end;
function TRCStreamDecorator.Seek(Offset: Integer; Origin: Word): Integer;
begin
result := Seek(Int64(Offset), TSeekOrigin(Origin));
end;
function TRCStreamDecorator.Seek(
const Offset: Int64;
Origin: TSeekOrigin): Int64;
begin
if (Origin = soCurrent)
and (Offset = 0)
then
Result := FStream.Seek(Offset, Origin)
else
raise ERCSeekNotAllowed.Create('
Seeking is not allowed');
end;
{ TRC4StreamDecorator }
destructor TRC4StreamDecorator.Destroy;
begin
RC4Done(FRC4);
inherited;
end;
procedure TRC4StreamDecorator.Encode(
const source;
var dest; Count: Integer);
begin
RC4Code(FRC4, source, dest, Count);
end;
procedure TRC4StreamDecorator.Decode(
const source;
var dest; Count: Integer);
begin
RC4Code(FRC4, source, dest, Count);
end;
procedure TRC4StreamDecorator.SetPassword(
const Value:
String);
begin
RC4Init(FRC4,Value);
end;
procedure TRC4StreamDecorator.SetSandbox(
const Value: TRC4Context);
begin
FRC4 := Value;
end;
{ TRCxStreamDecorator }
destructor TRCxStreamDecorator.Destroy;
begin
RCxDone(FRCx);
inherited;
end;
procedure TRCxStreamDecorator.Encode(
const source;
var dest; Count: Integer);
begin
RCxEncode(FRCx, source, dest, Count);
end;
procedure TRCxStreamDecorator.Decode(
const source;
var dest; Count: Integer);
begin
RCxDecode(FRCx, source, dest, Count);
end;
procedure TRCxStreamDecorator.SetPassword(
const Value:
String);
begin
RCxInit(FRCx, Value);
end;
procedure TRCxStreamDecorator.SetSandbox(
const Value: TRCxContext);
begin
FRCx := Value;
end;
procedure TRCxStreamDecorator.WriteSalt(Size: Byte = 16);
var
Salt:
String;
CRC: Byte;
begin
Salt := RCxRandomString(Size);
try
WriteBuffer(Size, SizeOf(Size));
WriteBuffer(Pointer(Salt)^, Size);
CRC := Checksum(Salt);
WriteBuffer(CRC, SizeOf(CRC));
finally
ProtectString(Salt);
end;
end;
procedure TRCxStreamDecorator.ReadSalt;
var
Salt:
String;
CRC,Size: Byte;
begin
ReadBuffer(Size, SizeOf(Size));
SetLength(Salt, Size);
try
ReadBuffer(Pointer(Salt)^, Size);
ReadBuffer(CRC, SizeOf(CRC));
if CRC <> Checksum(Salt)
then
raise EInvalidDecryption.Create('
Invalid decryption');
finally
ProtectString(Salt);
end;
end;
end.