VerschlüsselungsProgramm

[papillon03]

Für Fetischisten der Objectorientierung habe ich versucht, das ganze mal in zwei Klassen zu Kapseln:

Delphi-Quellcode:

unit rc4;

// Code written by Hagen ([url]http://www.delphipraxis.net/topic12881,15.html[/url])
// unit created by maximov 29.07.2004
// Encapsulation in Class papillon03 5.11.2004

interface

type

TCryptBytes = array[Byte] of Byte;

TtrRC4Crypt = class(TObject)
private
  FcBytes: TCryptBytes;
  FcI, FcJ: Byte;
public
  constructor Create;
  destructor Destroy; override;
  procedure Init(const Key: string);
  procedure CodeBytes(const Source; var Dest; Count: Integer);
  function  Code(const Value: string): string;
  function  CodeOnce(const Value, Password: String): string;
  procedure SelfEncryptByteArray;
  procedure Clear;
  property CryptBytes: TCryptBytes read FcBytes;
end;

TtrRC4Random = class(TObject)
private
  Frc4crypt: TtrRC4Crypt;
public
  constructor Create;
  destructor Destroy; override;
  function Random: Cardinal;
end;


implementation

type
  PByteArray = ^TByteArray;
  TByteArray = array[0..($FFFF shr 1)-1] of byte;

function TtrRC4Crypt.Code(const Value: string): string;
var
  Count: Integer;
begin
  Count := Length(Value);
  SetLength(Result, Count);
  CodeBytes(Value[1], Result[1], Count);
end;

function TtrRC4Crypt.CodeOnce(const Value, Password: string): string;
begin
  Init(Password);
  try
    Result := Code(Value);
  finally
    Clear;
  end;
end;


procedure TtrRC4Crypt.Init(const Key: String);
var
  r,s,t,k: Byte;
  u,l: Integer;
begin
  l := Length(Key);
  FcI := 0;
  FcJ := 0;
  for s := 0 to 255 do FcBytes[s] := s;
  r := 0;
  u := 0;
  for s := 0 to 255 do
  begin
    if u < l then k := PByteArray(Key)[u] else k := 0;
    Inc(u);
    if u >= l then u := 0;

    Inc(r, FcBytes[s] + k);
    t := FcBytes[s];
    FcBytes[s] := FcBytes[r];
    FcBytes[r] := t;
  end;
end;

procedure TtrRC4Crypt.CodeBytes(const Source; var Dest; Count: Integer);
var
  s: Integer;
  t: Byte;
begin
  for s := 0 to Count -1 do
  begin
    Inc(FcI);
    t := FcBytes[FcI];
    Inc(FcJ, t);
    FcBytes[FcI] := FcBytes[FcJ];
    FcBytes[FcJ] := t;
    Inc(t, FcBytes[FcI]);
    TByteArray(Dest)[s] := TByteArray(Source)[s] xor FcBytes[t];
  end;
end;

procedure TtrRC4Crypt.Clear;
begin
  FillChar(FcBytes, SizeOf(FcBytes), 0);
  FcI := 0;
  FcJ := 0;
end;

constructor TtrRC4Crypt.Create;
begin
end;

destructor TtrRC4Crypt.Destroy;
begin
  Clear;
  inherited;
end;

procedure TtrRC4Crypt.SelfEncryptByteArray;
begin
  CodeBytes(FcBytes, FcBytes, SizeOf(FcBytes));
end;

constructor TtrRC4Random.Create;
begin
  inherited;
  Frc4crypt := TtrRC4Crypt.Create;
  with Frc4crypt do begin
    Init('5C103319-9C6F-4F88-BBDC-752779958047');
  end;
end;

destructor TtrRC4Random.Destroy;
begin
  Frc4crypt.Free;
  inherited;
end;

function TtrRC4Random.Random: Cardinal;
type
  PRC4Cast = ^TRC4Cast;
  TRC4Cast = record
    FirstSBOX: Cardinal;
  end;

begin
// verschlüssele die dynamsiche SBOX von RC4Random.D mit sich selber und gebe die 4 ersten Bytes
// als Zufallswert zurück !!
  with Frc4crypt do begin
    SelfEncryptByteArray;
    Result := PRC4Cast(@CryptBytes).FirstSBOX;
  end;
end;

end.

Natürlich ergibt sich dadurch ein gewisser Overhead, ich hoffe aber trotzdem was beigetragen zu haben. Insbesondere bei Random wäre super, wenn jemand die Gleichwertigkeit verifizieren könnte.

Ciao Papillon03