{ *********************************************************************** }

{ }

{ Delphi Еncryption Library }

{ Еncryption / Decryption stream -  }

{ }

{ Copyright (c) 2004 by Matveev Igor Vladimirovich }

{ With offers and wishes write: <a href="mailto:teap_leap@mail.ru">teap_leap@mail.ru</a> }

{ }

{ *********************************************************************** }

unit ;

interface

uses

 SysUtils, Classes;

const

 Rounds = 20;

 KeyLength = 2 * (Rounds + 2);

 BlockSize = 16;

 KeySize = 16 * 4;

 P32 = $b7e15163;

 Q32 = $9e3779b9;

 lgw = 5;

type

 TBlock = 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

 Block : TBlock absolute Block;

 i      : Integer;

 t, u      : LongWord;

 Temp      : LongWord;

begin

 // Инициализация блока

 Inc(Block[2], S[0]);

 Inc(Block[4], S[1]);

 for i := 1 to Rounds do

  begin

  t := ROL((Block[2] * (2*Block[2] + 1)), lgw);

  u := ROL((Block[4] * (2*Block[4] + 1)), lgw);

  Block[1] := ROL((Block[1] xor t), u) + S[2*i];

  Block[3] := ROL((Block[3] xor u), t) + S[2*i+1];

  Temp := Block[1];

  Block[1] := Block[2];

  Block[2] := Block[3];

  Block[3] := Block[4];

  Block[4] := Temp;

  end;

 Block[1] := Block[1] + S[2*Rounds+2];

 Block[3] := Block[3] + S[2*Rounds+3];

 Result := TRUE;

end;

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

function DecipherBlock(var Block): Boolean;

var

 Block : TBlock absolute Block;

 i      : Integer;

 t, u      : LongWord;

 Temp      : LongWord;

begin

 // Инициализация блока

 Block[3] := Block[3] - S[2*Rounds+3];

 Block[1] := Block[1] - S[2*Rounds+2];

 for i := Rounds downto 1 do

  begin

  Temp := Block[4];

  Block[4] := Block[3];

  Block[3] := Block[2];

  Block[2] := Block[1];

  Block[1] := Temp;

  u := ROL((Block[4] * (2*Block[4] + 1)),lgw);

  t := ROL((Block[2] * (2*Block[2] + 1)),lgw);

  Block[3] := ROR((Block[3]-S[2*i+1]), t) xor u;

  Block[1] := ROR((Block[1]-S[2*i]), u) xor t;

  end;

 Dec(Block[4], S[1]);

 Dec(Block[2], S[0]);

 Result := TRUE;

end;

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

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

function EncryptCopy(DestStream, SourseStream : TStream; Count: Int64;

 Key : string): Boolean;

var

 Buffer : TBlock;

 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 : TBlock;

 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 : TBlock;

 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 : TBlock;

 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.