RCx-Verschlüsselung

[himitsu]

Zitat von negaH:

PS: der Kommentar im Source das es RC5 wäre stammt nicht von mir !

Hab's mal auf RC4 geändert ... sollte wohl besser passen.

@Shark99: Es kann sein, daß Delphi5 in Bezug auf das Überladen (overload) noch einige Kinderkrankheiten aufweist.

Wenn ich mich jetzt nicht vertippt hab, dann sollte dieses eine Version ohne Overloading sein,
allerdings mußt du da vermutlich deinen Code etwas anpassen, da hier über den Funktionsnamen und nicht mehr über Parameter unterschieden wird.

Delphi-Quellcode:

{
Copyright:      2002 Hagen Reddmann
Author:         Hagen Reddmann, HaReddmann bei T-Online punkt de
Remarks:        All rights reserved
Version:        open source, developed on D5
Description:    derivate of RC4 stream cipher with internal cipher feedback and stronger keysetup
                includes secure one way pseudo random number generator
}

unit RCx;
{$A+,B-,C-,D-,E-,F-,G+,H+,I-,J+,K-,L-,M-,N+,O+,P+,Q-,R-,S-,T-,U+,V+,W-,X+,Y-,Z1}

interface

type
  TRCxContext = record
    D: array[Byte] of Byte;
    I,J,F: Byte;
  end;

procedure RCxInit   (var RCx: TRCxContext; const Key; KeySize: Integer);
procedure RCxInitA  (var RCx: TRCxContext; const Key: AnsiString);
procedure RCxInitW  (var RCx: TRCxContext; const Key: WideString);
procedure RCxEncode (var RCx: TRCxContext; const Source; var Dest; Count: Integer);
function  RCxEncodeA(var RCx: TRCxContext; const Value: AnsiString): AnsiString;
function  RCxEncodeW(var RCx: TRCxContext; const Value: WideString): WideString;
procedure RCxDecode (var RCx: TRCxContext; const Source; var Dest; Count: Integer);
function  RCxDecodeA(var RCx: TRCxContext; const Value: AnsiString): AnsiString;
function  RCxDecodeW(var RCx: TRCxContext; const Value: WideString): WideString;
procedure RCxDone   (var RCx: TRCxContext);

// all in one encode/decode
function  RCxEncode_A(const Value, Password: AnsiString): AnsiString;
function  RCxEncode_W(const Value, Password: WideString): WideString;
function  RCxDecode_A(const Value, Password: AnsiString): AnsiString;
function  RCxDecode_W(const Value, Password: WideString): WideString;

// random number generator based on RCx
procedure RCxSeed (const Seed; SeedSize: Integer);
procedure RCxSeedA(const Seed: AnsiString);
procedure RCxSeedW(const Seed: WideString);
procedure RCxRandomize;
function  RCxRandom       (Range: Cardinal = 0): Cardinal;
function  RCxRandomStringA(Length: Integer): AnsiString;
function  RCxRandomStringW(Length: Integer): WideString;

implementation

type
  PByteArray = ^TByteArray;
  TByteArray = array[0..MaxInt -1] of Byte;

procedure RCxInit(var RCx: TRCxContext; const Key; KeySize: Integer);
var
  R,S,T,K: Byte;
  L: Integer;
  M: array[Byte] of Byte;
begin
  with RCx do
  try
    L := 0;
    for S := 0 to 255 do
    begin
      D[S] := S;
      M[S] := TByteArray(Key)[S mod KeySize] xor L;
      L := (L + M[S] * 257) mod MaxInt +1;
    end;
    I := 0;
    J := 0;
    R := L;
    F := L shr 8;
    for S := 0 to 255 do
    begin
      Inc(R, D[S] + M[S]);
      T    := D[S];
      D[S] := D[R];
      D[R] := T;
    end;
  finally
    R := 0;
    S := 0;
    T := 0;
    L := 0;
    FillChar(M, SizeOf(M), 0);
  end;
end;

procedure RCxInitA(var RCx: TRCxContext; const Key: AnsiString);
begin
  RCxInit(RCx, Pointer(Key)^, Length(Key));
end;

procedure RCxInitW(var RCx: TRCxContext; const Key: WideString);
begin
  RCxInit(RCx, Pointer(Key)^, Length(Key) * 2);
end;

procedure RCxDone(var RCx: TRCxContext);
begin
  FillChar(RCx, SizeOf(RCx), 0);
end;

procedure RCxEncode(var RCx: TRCxContext; const Source; var Dest; Count: Integer);
var
  S: TByteArray absolute Source;
  O: TByteArray absolute Dest;
  C: Integer;
  T,K: Byte;
begin
  with RCx do
    for C := 0 to Count -1 do
    begin
      Inc(I);
      T := D[I];
      Inc(J, T);
      D[I] := D[J] xor F;
      D[J] := T - F;
      Inc(T, D[I]);

      K := S[C];
      O[C] := K xor D[T];
      F := F xor K;
    end;
end;

procedure RCxDecode(var RCx: TRCxContext; const Source; var Dest; Count: Integer);
var
  S: TByteArray absolute Source;
  O: TByteArray absolute Dest;
  C: Integer;
  T,K: Byte;
begin
  with RCx do
    for C := 0 to Count -1 do
    begin
      Inc(I);
      T := D[I];
      Inc(J, T);
      D[I] := D[J] xor F;
      D[J] := T - F;
      Inc(T, D[I]);

      K := S[C] xor D[T];
      O[C] := K;
      F := F xor K;
    end;
end;

function RCxEncodeA(var RCx: TRCxContext; const Value: AnsiString): AnsiString;
var
  Count: Integer;
begin
  Count := Length(Value);
  SetLength(Result, Count);
  RCxEncode(RCx, Value[1], Result[1], Count);
end;

function RCxEncodeW(var RCx: TRCxContext; const Value: WideString): WideString;
var
  Count: Integer;
begin
  Count := Length(Value);
  SetLength(Result, Count);
  RCxEncode(RCx, Value[1], Result[1], Count * 2);
end;

function RCxDecodeA(var RCx: TRCxContext; const Value: AnsiString): AnsiString;
var
  Count: Integer;
begin
  Count := Length(Value);
  SetLength(Result, Count);
  RCxDecode(RCx, Value[1], Result[1], Count);
end;

function RCxDecodeW(var RCx: TRCxContext; const Value: WideString): WideString;
var
  Count: Integer;
begin
  Count := Length(Value);
  SetLength(Result, Count);
  RCxDecode(RCx, Value[1], Result[1], Count * 2);
end;

function RCxEncode_A(const Value, Password: AnsiString): AnsiString;
var
  RCx: TRCxContext;
begin
  RCxInitA(RCx, Password);
  try
    Result := RCxEncodeA(RCx, Value);
  finally
    RCxDone(RCx);
  end;
end;

function RCxEncode_W(const Value, Password: WideString): WideString;
var
  RCx: TRCxContext;
begin
  RCxInitW(RCx, Password);
  try
    Result := RCxEncodeW(RCx, Value);
  finally
    RCxDone(RCx);
  end;
end;

function RCxDecode_A(const Value, Password: AnsiString): AnsiString;
var
  RCx: TRCxContext;
begin
  RCxInitA(RCx, Password);
  try
    Result := RCxDecodeA(RCx, Value);
  finally
    RCxDone(RCx);
  end;
end;

function RCxDecode_W(const Value, Password: WideString): WideString;
var
  RCx: TRCxContext;
begin
  RCxInitW(RCx, Password);
  try
    Result := RCxDecodeW(RCx, Value);
  finally
    RCxDone(RCx);
  end;
end;

var
  FRCxRegister: TRCxContext;

procedure RCxSeed(const Seed; SeedSize: Integer);
begin
  RCxInit(FRCxRegister, Seed, SeedSize);
end;

procedure RCxSeedA(const Seed: AnsiString);
begin
  RCxSeed(Pointer(Seed)^, Length(Seed));
end;

procedure RCxSeedW(const Seed: WideString);
begin
  RCxSeed(Pointer(Seed)^, Length(Seed) * 2);
end;

procedure RCxRandomize;
var
  Tick: Cardinal;
begin
  Tick := GetTickCount;
  FRCxRegister.F := Tick;
  FRCxRegister.I := Tick shr 8;
  FRCxRegister.J := Tick shr 16;
  RCxEncode(FRCxRegister, FRCxRegister.D, FRCxRegister.D, SizeOf(FRCxRegister.D));
end;

function RCxRandom(Range: Cardinal): Cardinal;
type
  PCardinal = ^Cardinal;
begin
  RCxEncode(FRCxRegister, FRCxRegister.D, FRCxRegister.D, SizeOf(FRCxRegister.D));
  Result := PCardinal(@FRCxRegister.D)^;
  if Range > 1 then Result := Result mod Range;
end;

procedure RCxRandomStringA(Length: Integer; var Result: AnsiString);
var
  I: Integer;
begin
  SetLength(Result, Length);
  for I := 1 to Length do
  begin
    RCxEncode(FRCxRegister, FRCxRegister.D, FRCxRegister.D, SizeOf(FRCxRegister.D));
    Result[I] := AnsiChar(FRCxRegister.D[0]);
  end;
end;

procedure RCxRandomStringW(Length: Integer; var Result: WideString);
//begin
//  SetLength(Result, Length);
//  for I := 1 to Length do
//  begin
//    RCxEncode(FRCxRegister, FRCxRegister.D, FRCxRegister.D, SizeOf(FRCxRegister.D));
//    W := FRCxRegister.D[0];
//    RCxEncode(FRCxRegister, FRCxRegister.D, FRCxRegister.D, SizeOf(FRCxRegister.D));
//    Result[I] := WideChar((Word(FRCxRegister.D[0]) shl 8) or W);
//  end;
//end;
var
  I: Integer;
  W: Word;
begin
  W := 0;
  SetLength(Result, Length);
  for I := 1 to Length * 2 do
  begin
    RCxEncode(FRCxRegister, FRCxRegister.D, FRCxRegister.D, SizeOf(FRCxRegister.D));
    if Odd(I) then W := FRCxRegister.D[0]
    else Result[I div 2] := WideChar((Word(FRCxRegister.D[0]) shl 8) or W);
  end;
end;

const
  FRCxSeed: TGUID = '{F4D35205-2B59-42B0-8B8F-239855B6DD2B}';

initialization
  RCxSeed(FRCxSeed, SizeOf(FRCxSeed));

finalization

end.