{ *********************************************************************** }
{ }
{ Delphi Еncryption Library }
{ Еncryption / Decryption stream - RC6 }
{ }
{ Copyright (c) 2004 by Matveev Igor Vladimirovich }
{ With offers and wishes write: teap_leap@mail.ru }
{ }
{ *********************************************************************** }

unit RC6;

interface

uses
 SysUtils, Classes;

const
 Rounds = 20;
 KeyLength = 2 * (Rounds + 2);

 BlockSize = 16;
 KeySize = 16 * 4;

 P32 = $b7e15163;
 Q32 = $9e3779b9;
 lgw = 5;

type
 TRC6Block = array[1..4] of LongWord;

var
 S : array[0..KeyLength-1] of LongWord;
 Key : string;
 KeyPtr : PChar;

////////////////////////////////////////////////////////////////////////////////
// Дополнительные функции

procedure Initialize(AKey: string); // Инициализация
procedure CalculateSubKeys; // Подготовка подключей
function EncipherBlock(var Block): Boolean; // Шифрация блока (16 байт)
function DecipherBlock(var Block): Boolean; // Дешифрация блока

////////////////////////////////////////////////////////////////////////////////
// Главные функции

function EncryptCopy(DestStream, SourseStream : TStream; Count: Int64;
 Key : string): Boolean; // Зашифровать данные из одного потока в другой

function DecryptCopy(DestStream, SourseStream : TStream; Count: Int64;
 Key : string): Boolean; // Расшифровать данные из одного потока в другой

function EncryptStream(DataStream: TStream; Count: Int64;
 Key: string): Boolean; // Зашифровать содержимое потока

function DecryptStream(DataStream: TStream; Count: Int64;
 Key: string): Boolean; // Расшифровать содержимое потока

implementation

////////////////////////////////////////////////////////////////////////////////

function ROL(a, s: LongWord): LongWord;
asm
 mov ecx, s
 rol eax, cl
end;

////////////////////////////////////////////////////////////////////////////////

function ROR(a, s: LongWord): LongWord;
asm
 mov ecx, s
 ror eax, cl
end;

////////////////////////////////////////////////////////////////////////////////

procedure InvolveKey;
var
 TempKey : string;
 i, j : Integer;
 K1, K2 : LongWord;
begin
 // Разворачивание ключа до длинны KeySize = 64
 TempKey := Key;
 i := 1;
 while ((Length(TempKey) mod KeySize) <> 0) do
 begin
 TempKey := TempKey + TempKey[i];
 Inc(i);
 end;

 i := 1;
 j := 0;
 while (i < Length(TempKey)) do
 begin
 Move((KeyPtr+j)^, K1, 4);
 Move(TempKey[i], K2, 4);
 K1 := ROL(K1, K2) xor K2;
 Move(K1, (KeyPtr+j)^, 4);
 j := (j + 4) mod KeySize;
 Inc(i, 4);
 end;
end;

////////////////////////////////////////////////////////////////////////////////

procedure CalculateSubKeys;
var
 i, j, k : Integer;
 L : array[0..15] of LongWord;
 A, B : LongWord;
begin
 // Копирование ключа в L
 Move(KeyPtr^, L, KeySize);

 // Инициализация подключа S
 S[0] := P32;
 for i := 1 to KeyLength-1 do
 S[i] := S[i-1] + Q32;

 // Смешивание S с ключом
 i := 0;
 j := 0;
 A := 0;
 B := 0;
 for k := 1 to 3*KeyLength do
 begin
 A := ROL((S[i] + A + B), 3);
 S[i] := A;
 B := ROL((L[j] + A + B), (A + B));
 L[j] := B;
 i := (i + 1) mod KeyLength;
 j := (j + 1) mod 16;
 end;
end;

////////////////////////////////////////////////////////////////////////////////

procedure Initialize(AKey: string);
begin
 GetMem(KeyPtr, KeySize);
 FillChar(KeyPtr^, KeySize, #0);
 Key := AKey;

 InvolveKey;
end;

////////////////////////////////////////////////////////////////////////////////

function EncipherBlock(var Block): Boolean;
var
 RC6Block : TRC6Block absolute Block;
 i : Integer;
 t, u : LongWord;
 Temp : LongWord;
begin
 // Инициализация блока
 Inc(RC6Block[2], S[0]);
 Inc(RC6Block[4], S[1]);

 for i := 1 to Rounds do
 begin
 t := ROL((RC6Block[2] * (2*RC6Block[2] + 1)), lgw);
 u := ROL((RC6Block[4] * (2*RC6Block[4] + 1)), lgw);
 RC6Block[1] := ROL((RC6Block[1] xor t), u) + S[2*i];
 RC6Block[3] := ROL((RC6Block[3] xor u), t) + S[2*i+1];

 Temp := RC6Block[1];
 RC6Block[1] := RC6Block[2];
 RC6Block[2] := RC6Block[3];
 RC6Block[3] := RC6Block[4];
 RC6Block[4] := Temp;
 end;

 RC6Block[1] := RC6Block[1] + S[2*Rounds+2];
 RC6Block[3] := RC6Block[3] + S[2*Rounds+3];

 Result := TRUE;
end;

////////////////////////////////////////////////////////////////////////////////

function DecipherBlock(var Block): Boolean;
var
 RC6Block : TRC6Block absolute Block;
 i : Integer;
 t, u : LongWord;
 Temp : LongWord;
begin
 // Инициализация блока
 RC6Block[3] := RC6Block[3] - S[2*Rounds+3];
 RC6Block[1] := RC6Block[1] - S[2*Rounds+2];

 for i := Rounds downto 1 do
 begin
 Temp := RC6Block[4];
 RC6Block[4] := RC6Block[3];
 RC6Block[3] := RC6Block[2];
 RC6Block[2] := RC6Block[1];
 RC6Block[1] := Temp;

 u := ROL((RC6Block[4] * (2*RC6Block[4] + 1)),lgw);
 t := ROL((RC6Block[2] * (2*RC6Block[2] + 1)),lgw);
 RC6Block[3] := ROR((RC6Block[3]-S[2*i+1]), t) xor u;
 RC6Block[1] := ROR((RC6Block[1]-S[2*i]), u) xor t;
 end;

 Dec(RC6Block[4], S[1]);
 Dec(RC6Block[2], S[0]);

 Result := TRUE;
end;

////////////////////////////////////////////////////////////////////////////////
// Реализация главных функций

function EncryptCopy(DestStream, SourseStream : TStream; Count: Int64;
 Key : string): Boolean;
var
 Buffer : TRC6Block;
 PrCount : Int64;
 AddCount : Byte;
begin
 Result := True;
 try
 if Key = '' then
 begin
 DestStream.CopyFrom(SourseStream, Count);
 Exit;
 end;
 Initialize(Key);
 CalculateSubKeys;
 PrCount := 0;
 while Count - PrCount >= BlockSize do
 begin
 SourseStream.Read(Buffer, BlockSize);
 EncipherBlock(Buffer);
 DestStream.Write(Buffer, BlockSize);
 Inc(PrCount, BlockSize);
 end;

 AddCount := Count - PrCount;
 if Count - PrCount <> 0 then
 begin
 SourseStream.Read(Buffer, AddCount);
 DestStream.Write(Buffer, AddCount);
 end;
 except
 Result := False;
 end;
end;

////////////////////////////////////////////////////////////////////////////////

function DecryptCopy(DestStream, SourseStream : TStream; Count: Int64;
 Key : string): Boolean;
var
 Buffer : TRC6Block;
 PrCount : Int64;
 AddCount : Byte;
begin
 Result := True;
 try
 if Key = '' then
 begin
 DestStream.CopyFrom(SourseStream, Count);
 Exit;
 end;
 Initialize(Key);
 CalculateSubKeys;
 PrCount := 0;
 while Count - PrCount >= BlockSize do
 begin
 SourseStream.Read(Buffer, BlockSize);
 DecipherBlock(Buffer);
 DestStream.Write(Buffer, BlockSize);
 Inc(PrCount, BlockSize);
 end;

 AddCount := Count - PrCount;
 if Count - PrCount <> 0 then
 begin
 SourseStream.Read(Buffer, AddCount);
 DestStream.Write(Buffer, AddCount);
 end;
 except
 Result := False;
 end;
end;

////////////////////////////////////////////////////////////////////////////////

function EncryptStream(DataStream: TStream; Count: Int64; Key: string): Boolean;
var
 Buffer : TRC6Block;
 PrCount : Int64;
begin
 Result := True;
 try
 if Key = '' then
 begin
 DataStream.Seek(Count, soFromCurrent);
 Exit;
 end;
 Initialize(Key);
 CalculateSubKeys;
 PrCount := 0;
 while Count - PrCount >= BlockSize do
 begin
 DataStream.Read(Buffer, BlockSize);
 EncipherBlock(Buffer);
 DataStream.Seek(-BlockSize, soFromCurrent);
 DataStream.Write(Buffer, BlockSize);
 Inc(PrCount, BlockSize);
 end;
 except
 Result := False;
 end;
end;

////////////////////////////////////////////////////////////////////////////////

function DecryptStream(DataStream: TStream; Count: Int64; Key: string): Boolean;
var
 Buffer : TRC6Block;
 PrCount : Int64;
begin
 Result := True;
 try
 if Key = '' then
 begin
 DataStream.Seek(Count, soFromCurrent);
 Exit;
 end;
 Initialize(Key);
 CalculateSubKeys;
 PrCount := 0;
 while Count - PrCount >= BlockSize do
 begin
 DataStream.Read(Buffer, BlockSize);
 DecipherBlock(Buffer);
 DataStream.Seek(-BlockSize, soFromCurrent);
 DataStream.Write(Buffer, BlockSize);
 Inc(PrCount, BlockSize);
 end;
 except
 Result := False;
 end;
end;

// Завершение главных функций ...
////////////////////////////////////////////////////////////////////////////////

end.