RCX, RC4 and XOR Encryption - uEncryption by testest

posted 4 Nov 2010, 17:19 by Delphi Basics   [ updated 28 Feb 2011, 11:14 ]
This delphi unit, written by testest allows you to use three types of encryption; rcx, rc4 and xor.

unit uEncryption;
//Author: testest
interface

type
  TCipher = class
  public
    procedure Init(const Key; KeySize: Cardinal); overload; virtual;
    procedure Init(const Key: String); overload; virtual;
    procedure Encode(const Source; var Dest; Count: Cardinal); overload; virtual;
    procedure Encode(var Buffer; Count: Cardinal); overload; virtual;
    function Encode(const Value: String): String; overload; virtual;
    procedure Decode(const Source; var Dest; Count: Cardinal); overload; virtual;
    procedure Decode(var Buffer; Count: Cardinal); overload; virtual;
    function Decode(const Value: String): String; overload; virtual;
    procedure Done; virtual;
  end;

type
  TCipherSym = class(TCipher)
  public
    procedure Code(const Source; var Dest; Count: Cardinal); overload; virtual;
    procedure Code(var Buffer; Count: Cardinal); overload; virtual;
    function Code(const Value: String): String; overload; virtual;
    procedure Encode(const Source; var Dest; Count: Cardinal); override;
    procedure Decode(const Source; var Dest; Count: Cardinal); override;
  end;

/////////////////////////////////////////////////////////////
//////////////////////////// RCx ////////////////////////////
/////////////////////////////////////////////////////////////
type
  TRCx = class(TCipher)
  private
    D: array[Byte] of Byte;
    I,J,F: Byte;
  public
    procedure Init(const Key; KeySize: Cardinal); overload; override;
    procedure Encode(const Source; var Dest; Count: Cardinal); overload; override;
    procedure Decode(const Source; var Dest; Count: Cardinal); overload; override;
    procedure Done; override;
  end;

/////////////////////////////////////////////////////////////
//////////////////////////// RC4 ////////////////////////////
/////////////////////////////////////////////////////////////
type
  TRC4 = class(TCipherSym)
  private
    SBox: array[Byte] of Byte;
    I, J: Cardinal;
  public
    procedure Init(const Key; KeySize: Cardinal); overload; override;
    procedure Code(const Source; var Dest; Count: Cardinal); overload; override;
    procedure Done; override;
  end;

/////////////////////////////////////////////////////////////
//////////////////////////// Xor ////////////////////////////
/////////////////////////////////////////////////////////////
type
  TXor = class(TCipherSym)
  private
    Key: array of Byte;
    J, Len: Cardinal;
  public
    procedure Init(const Key; KeySize: Cardinal); overload; override;
    procedure Code(const Source; var Dest; Count: Cardinal); overload; override;
    procedure Done; override;
  end;


type
  PByteArray = ^TByteArray;
  TByteArray = array[0..MaxInt-1] of Byte;
  TCipherId  = (ciNone, ciXOR, ciRC4, ciRCX);


function RandomRange(const Low, High: Integer): Integer;
function RandomPassword(const Len: Integer): String; overload;
function RandomPassword(const lenFrom, lenTo: Integer): String; overload;

procedure Encode(const Source; var Dest; Count: Cardinal; const Key; KeySize: Cardinal; Cipher: TCipherId); overload;
procedure Encode(var Buffer; Count: Cardinal; const Key; KeySize: Cardinal; Cipher: TCipherId); overload;
function Encode(const Value, Key: String; Cipher: TCipherId): String; overload;

procedure Decode(const Source; var Dest; Count: Cardinal; const Key; KeySize: Cardinal; Cipher: TCipherId); overload;
procedure Decode(var Buffer; Count: Cardinal; const Key; KeySize: Cardinal; Cipher: TCipherId); overload;
function Decode(const Value, Key: String; Cipher: TCipherId): String; overload;

function Encrypt(const Source: Pointer; var Dest: Pointer; const Count: Cardinal; const Key: ShortString; Cipher: TCipherId): Cardinal; overload;
function Encrypt(const Value: String; const Key: ShortString; Cipher: TCipherId): String; overload;
function Decrypt(const Source: Pointer; var Dest: Pointer; const Count: Cardinal): Cardinal; overload;
function Decrypt(const Value: String): String; overload;

function SimpleHash(const Buffer; const Size: Cardinal): Cardinal; overload;
function SimpleHash(const S: String): Cardinal; overload;

function CreateCipher(const Cipher: TCipherId): TCipher;


implementation

function RandomRange(const Low, High: Integer): Integer;
begin
  Result := Random(High - Low + 1) + Low;
end;

function RandomPassword(const Len: Integer): String;
var I: Integer;
begin
  SetLength(Result, Len);
  for I := 1 to Len do
    Result[I] := Chr(Random(256));
end;

function RandomPassword(const LenFrom, LenTo: Integer): String;
begin
  Result := RandomPassword(RandomRange(LenFrom, LenTo));
end;


procedure Encode(const Source; var Dest; Count: Cardinal; const Key; KeySize: Cardinal; Cipher: TCipherId);
var C: TCipher;
begin
  C := CreateCipher(Cipher);
  try
    C.Init(Key, KeySize);
    C.Encode(Source, Dest, Count);
    C.Done;
  finally
    C.Free;
  end;
end;

procedure Encode(var Buffer; Count: Cardinal; const Key; KeySize: Cardinal; Cipher: TCipherId);
begin
  Encode(Buffer, Buffer, Count, Key, KeySize, Cipher);
end;

function Encode(const Value, Key: String; Cipher: TCipherId): String;
var L: Cardinal;
begin
  L := Length(Value);
  SetLength(Result, L);
  Encode(Value[1], Result[1], L, Key[1], Length(Key), Cipher);
end;


procedure Decode(const Source; var Dest; Count: Cardinal; const Key; KeySize: Cardinal; Cipher: TCipherId);
var C: TCipher;
begin
  C := CreateCipher(Cipher);
  try
    C.Init(Key, KeySize);
    C.Decode(Source, Dest, Count);
    C.Done;
  finally
    C.Free;
  end;
end;

procedure Decode(var Buffer; Count: Cardinal; const Key; KeySize: Cardinal; Cipher: TCipherId);
begin
  Decode(Buffer, Buffer, Count, Key, KeySize, Cipher);
end;

function Decode(const Value, Key: String; Cipher: TCipherId): String;
var L: Cardinal;
begin
  L := Length(Value);
  SetLength(Result, L);
  Decode(Value[1], Result[1], L, Key[1], Length(Key), Cipher);
end;


function SimpleHash(const Buffer; const Size: Cardinal): Cardinal;
var
  B: TByteArray absolute Buffer;
  I: Integer;
begin
  Result := 0;
  for I := 0 to Size - 1 do
    if Result and $F0000000 = 0 then
      Result := Result shl 4 + B[I]
    else
      Result := (Result shl 1 + B[I]) xor Result;
end;

function SimpleHash(const S: String): Cardinal;
begin
  Result := SimpleHash(S[1], Length(S));
end;


function CreateCipher(const Cipher: TCipherId): TCipher;
begin
  case Cipher of
    ciXOR: Result := TXor.Create;
    ciRC4: Result := TRC4.Create;
    ciRCX: Result := TRCx.Create;
    else Result := TCipher.Create;
  end;
end;


/////////////////////////////////////////////////////////////
////////////////////////// Cipher ///////////////////////////
/////////////////////////////////////////////////////////////

procedure TCipher.Init(const Key; KeySize: Cardinal);
begin end;

procedure TCipher.Init(const Key: String);
begin
  Init(Key[1], Length(Key));
end;

procedure TCipher.Encode(const Source; var Dest; Count: Cardinal);
begin
  Move(Source, Dest, Count);
end;

procedure TCipher.Encode(var Buffer; Count: Cardinal);
begin
  Encode(Buffer, Buffer, Count);
end;

function TCipher.Encode(const Value: String): String;
var Count: Cardinal;
begin
  Count := Length(Value);
  SetLength(Result, Count);
  Encode(Value[1], Result[1], Count);
end;

procedure TCipher.Decode(const Source; var Dest; Count: Cardinal);
begin
  Move(Source, Dest, Count);
end;

procedure TCipher.Decode(var Buffer; Count: Cardinal);
begin
  Decode(Buffer, Buffer, Count);
end;

function TCipher.Decode(const Value: String): String;
var Count: Cardinal;
begin
  Count := Length(Value);
  SetLength(Result, Count);
  Decode(Value[1], Result[1], Count);
end;

procedure TCipher.Done;
begin end;



/////////////////////////////////////////////////////////////
///////////////////////// CipherSym /////////////////////////
/////////////////////////////////////////////////////////////

procedure TCipherSym.Code(const Source; var Dest; Count: Cardinal);
begin
  Move(Source, Dest, Count);
end;

procedure TCipherSym.Code(var Buffer; Count: Cardinal);
begin
  Code(Buffer, Buffer, Count);
end;

function TCipherSym.Code(const Value: String): String;
var Count: Cardinal;
begin
  Count := Length(Value);
  SetLength(Result, Count);
  Code(Value[1], Result[1], Count);
end;

procedure TCipherSym.Encode(const Source; var Dest; Count: Cardinal);
begin
  Code(Source, Dest, Count);
end;

procedure TCipherSym.Decode(const Source; var Dest; Count: Cardinal);
begin
  Code(Source, Dest, Count);
end;



/////////////////////////////////////////////////////////////
//////////////////////////// RCx ////////////////////////////
/////////////////////////////////////////////////////////////

{$HINTS OFF}
procedure TRCx.Init(const Key; KeySize: Cardinal);
var
  R,S,T: Byte;
  L: Integer;
  M: array[Byte] of Byte;
begin
  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
    FillChar(M, SizeOf(M), 0);
    R := 0;
    S := 0;
    T := 0;
    L := 0;
  end;
end;
{$HINTS ON}

procedure TRCx.Encode(const Source; var Dest; Count: Cardinal);
var
  S: TByteArray absolute Source;
  O: TByteArray absolute Dest;
  C: Integer;
  T,K: Byte;
begin
  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 TRCx.Decode(const Source; var Dest; Count: Cardinal);
var
  S: TByteArray absolute Source;
  O: TByteArray absolute Dest;
  C: Integer;
  T,K: Byte;
begin
  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;

{$HINTS OFF}
procedure TRCx.Done;
begin
  FillChar(D, SizeOf(D), 0);
  I := 0;
  J := 0;
  F := 0;
end;
{$HINTS ON}


/////////////////////////////////////////////////////////////
//////////////////////////// RC4 ////////////////////////////
/////////////////////////////////////////////////////////////

procedure TRC4.Init(const Key; KeySize: Cardinal);
var K, L, LenS, LenK: Cardinal;
  T: Byte;
  S: TByteArray absolute Key;
begin
  LenS := Length(SBox);
  LenK := KeySize;
  for K := 0 to LenS - 1 do
    SBox[K] := K;
  I := 0;
  J := 0;
  L := 0;
  for K := 0 to LenS - 1 do
  begin
    T := SBox[K];
    L := (L + T + S[K mod LenK]) mod LenS;
    SBox[K] := SBox[L];
    SBox[L] := T;
  end;
end;

procedure TRC4.Code(const Source; var Dest; Count: Cardinal);
var
  K, LenS: Cardinal;
  S: TByteArray absolute Source;
  D: TByteArray absolute Dest;
begin
  LenS := Length(SBox);
  for K := 0 to Count - 1 do
    begin
      I := (I + 1) mod lenS;
      J := (J + SBox[I]) mod lenS;
      D[K] := S[K] xor SBox[(SBox[I] + SBox[J]) mod LenS];
    end;
end;

{$HINTS OFF}
procedure TRC4.Done;
begin
  FillChar(SBox[0], Length(SBox), 0);
  I := 0;
  J := 0;
end;
{$HINTS ON}



/////////////////////////////////////////////////////////////
//////////////////////////// Xor ////////////////////////////
/////////////////////////////////////////////////////////////

procedure TXor.Init(const Key; KeySize: Cardinal);
begin
  J := 0;
  Len := KeySize;
  SetLength(Self.Key, Len);
  Move(Key, Self.Key[0], Len);
end;

procedure TXor.Code(const Source; var Dest; Count: Cardinal);
var
  S: TByteArray absolute Source;
  D: TByteArray absolute Dest;
  I: Cardinal;
begin
  for I := 0 to Count - 1 do
  begin
    D[I] := S[I] xor Key[J];
    Inc(J);
    if J = Len then J := 0;
  end;
end;

{$HINTS OFF}
procedure TXor.Done;
begin
  FillChar(Key[0], Len, 0);
  J := 0;
end;
{$HINTS ON}



/////////////////////////////////////////////////////////////
////////////////////////// API Enc //////////////////////////
/////////////////////////////////////////////////////////////

function Encrypt(const Source: Pointer; var Dest: Pointer; const Count: Cardinal; const Key: ShortString; Cipher: TCipherId): Cardinal;
var
  LenKey: Byte;
  D: Cardinal;
begin
  LenKey := Length(Key);
  Result := 2 + LenKey + Count;
  GetMem(Dest, Result);
  D := Cardinal(Dest);
  Move(LenKey, Pointer(D)^, 1);
  Move(Byte(Cipher), Pointer(D + 1)^, 1);
  Move(Key[1], Pointer(D + 2)^, LenKey);
  Move(Source^, Pointer(D + 2 + LenKey)^, Count);
  Encode(Pointer(D + 2 + LenKey)^, Count, Key[1], LenKey, Cipher);
end;

function Encrypt(const Value: String; const Key: ShortString; Cipher: TCipherId): String;
var
  Buffer: PChar;
  Count: Cardinal;
begin
  Count := Encrypt(@Value[1], Pointer(Buffer), Length(Value), Key, Cipher);
  SetString(Result, Buffer, Count);
end;

function Decrypt(const Source: Pointer; var Dest: Pointer; const Count: Cardinal): Cardinal;
var
  LenKey: Byte;
  S: Cardinal;
  Key: String;
  Cipher: TCipherId;
begin
  S := Cardinal(Source);
  Move(Pointer(S)^, LenKey, 1);
  Move(Pointer(S + 1)^, Cipher, 1);
  Result := Count - LenKey - 2;
  SetLength(Key, LenKey);
  GetMem(Dest, Result);
  Move(Pointer(S + 2)^, Key[1], LenKey);
  Move(Pointer(S + 2 + LenKey)^, Dest^, Result);
  Decode(Dest^, Result, Key[1], LenKey, Cipher);
end;

function Decrypt(const Value: String): String;
var
  Buffer: PChar;
  Count: Cardinal;
begin
  Count := Decrypt(@Value[1], Pointer(Buffer), Length(Value));
  SetString(Result, Buffer, Count);
end;


end.
Comments