RC4 Extendet String & File Crypter

Unit RC4.pas

unit RC4;

interface

uses
  SysUtils;

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

  procedure RC4Init(var RC4: TRC4Context; const Key: String);
  procedure RC4Done(var RC4: TRC4Context);
  procedure RC4Code(var RC4: TRC4Context; const Source; var Dest; Count: Integer); overload;
  function RC4Code(var RC4: TRC4Context; const Value: String): String; overload;
  function RC4Code(const Value, Password: String): String; overload;

implementation

procedure RC4Init(var RC4: TRC4Context; const Key: String);
var
  R,S,T,K: Byte;
  U,L: Integer;
begin
{$R-}
{$Q-}
  L := Length(Key);
  with RC4 do
  begin
    I := 0;
    J := 0;
    for S := 0 to 255 do D[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, D[S] + K);
      T    := D[S];
      D[S] := D[R];
      D[R] := T;
    end;
  end;
end;

procedure RC4Done(var RC4: TRC4Context);
begin
  FillChar(RC4, SizeOf(RC4), 0);
end;

procedure RC4Code(var RC4: TRC4Context; const Source; var Dest; Count: Integer); overload;
var
  S: Integer;
  T: Byte;
begin
  with RC4 do
    for S := 0 to Count -1 do
    begin
      Inc(I);
      T := D[I];
      Inc(J, T);
      D[I] := D[J];
      D[J] := T;
      Inc(T, D[I]);
      TByteArray(Dest)[S] := TByteArray(Source)[S] xor D[T];
    end;
end;

function RC4Code(var RC4: TRC4Context; const Value: String): String; overload;
var
  Count: Integer;
begin
  Count := Length(Value);
  SetLength(Result, Count);
  RC4Code(RC4, Value[1], Result[1], Count);
end;

function RC4Code(const Value, Password: String): String; overload;
var
  RC4: TRC4Context;
begin
  RC4Init(RC4, Password);
  try
    Result := RC4Code(RC4, Value);
  finally
    RC4Done(RC4);
  end;
end;

end.

Unit1 :

uses RC4

//

// File Crypt
procedure TForm1.Button1Click(Sender: TObject);
const
  BLOCKSIZE: Integer = 1024;
var
  RC4: TRC4Context;
  Filename: string;
  source, dest: TFileStream;
  Len: Int64;
  SourceBuffer, DestBuffer: Pointer;
begin
  Filename := 'D:\Tmp\RC4Demo\Unit1.pas';
  source := TFileStream.Create(Filename, fmOpenRead);
  dest := TFileStream.Create(Filename + '.foo', fmCreate);
  try
    GetMem(SourceBuffer, BLOCKSIZE);
    GetMem(DestBuffer, BLOCKSIZE);
    try
      RC4Init(RC4, 'Foobar');
      Progressbar1.Max := source.Size;
      while source.Position < source.Size do
      begin
        if source.Size - source.Position > BLOCKSIZE then
          Len := BLOCKSIZE
        else
          Len := source.Size - source.Position;
        Progressbar1.Position := source.Position;
        Progressbar1.Refresh;
        source.ReadBuffer(SourceBuffer^, Len);
        RC4Code(RC4, SourceBuffer^, DestBuffer^, len);
        dest.WriteBuffer(DestBuffer^, Len);
      end;
      RC4Done(RC4);
    finally
      FreeMemory(SourceBuffer);
      FreeMemory(DestBuffer);
    end;
  finally
    FreeAndNil(source);
    FreeAndnIl(dest);
  end;
end;

// String Crypt
procedure TForm1.Button2Click(Sender: TObject);
var
  RC4: TRC4Context;
  s, s1: String;
begin
  s := Edit1.Text;
  setlength(s1, length(s));
  RC4Init(RC4, 'foo');
  RC4Code(RC4, s[1], s1[1], length(Edit1.Text));
  RC4Done(RC4);
  Edit2.Text := s1;
end;

// String Decrypt
procedure TForm1.Button3Click(Sender: TObject);
var
  RC4: TRC4Context;
  s, s1: String;
begin
  s := Edit2.Text;
  setlength(s1, length(s));
  RC4Init(RC4, 'foo');
  RC4Code(RC4, s[1], s1[1], length(Edit1.Text));
  RC4Done(RC4);
  Edit3.Text := s1;
end;