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.