Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Шифрование IDEA

01.01.2007
Автор: Матвеев Игорь

Часто в свои проекты необходимо включать шифрование данных. Самый простой способ - xor шифрование, но он подходит только когда необходимо обеспечить малый уровень защиты. Но иногда необходимы более серьезные алгоритмы.

Работая над архиватором файлов (вроде WinRar), у меня встал вопрос о шифровании, в таких программах как архиватор это просто необходимо.

Итак, существует ряд алгоритмов симметричного шифрования - когда один и тот же ключ используется для шифрования и дешифрования. Эти алгоритмы, как правило, очень хорошо изучены и их стойкость к различного рода атакам подтверждена результатами математических исследований.

Кроме того, 2 октября 2000 года NIST (Национальный институт стандартов и технологий, правопреемник прежнего НБС), утвердил алгоритм Rijndael Джоана Димена и Винсента Риджмена как AES (Усовершенствованный алгоритм шифрования, который должен стать заменой прежнего стандарта - DES). Алгоритм Rijndael свободен как для коммерческого, так и для некоммерческого использования и, по видимому, является наилучшим выбором если необходима достаточная стойкость шифра наряду с высокой скоростью работы и относительной простотой реализации.

Но я выбрал для своего архиватора алгоритм IDEA (International Data Encryption Algorithm). Этот алгоритм был разработан для простого воплощения как программно, так и аппаратно. Стойкость IDEA основывается на использовании трех несовместимых типов арифметических операций над 16-битными словами. IDEA очень распространен в Европе и используется в популярной программе шифрования электронных писем PGP (Pretty Good Privacy).

Нижепредставленный модуль полностью реализует в себе метода IDEA шифрования. Главными функциями являются:

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; // Расшифровать содержимое потока

А теперь сам модуль:

{ *********************************************************************** }
{                                                                         }
{ Delphi Еncryption Library                                               }
{ Еncryption / Decryption stream - IDEA                                   }
{                                                                         }
{ Copyright (c) 2004 by Matveev Igor Vladimirovich                        }
{ With offers and wishes write: teap_leap@mail.ru                         }
{                                                                         }
{ *********************************************************************** }
 
unit IDEA;
 
interface
 
uses
  SysUtils, Classes, Math;
 
const
  Rounds    = 8;
  KeyLength = (Rounds * 6) + 4;
  Maxim     = 65537;
 
type
  TIDEAKey   = array[0..KeyLength-1] of Word;
  TIDEABlock = array[1..4] of Word;
 
var
  Z : TIDEAKey;
  K : TIDEAKey;
 
  FBlockSize  : Integer;
  FKey        : string;
  FBufferSize : Integer;
  FKeySize    : Integer;
  FKeyPtr     : PChar;
 
////////////////////////////////////////////////////////////////////////////////
// Дополнительные функции
 
procedure Initialize(AKey: string);           // Инициализация
procedure CalculateSubKeys;                   // Подготовка подключей
function  EncipherBlock(var Block): Boolean;  // Шифрация блока (8 байт) 
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;
 
////////////////////////////////////////////////////////////////////////////////
 
procedure InvolveKey;
var
  TempKey : string;
  i, j    : Integer;
  K1, K2  : LongWord;
begin
 // Разворачивание ключа до длинны 51 символ
 TempKey := FKey;
 i := 1;
 while ((Length(TempKey) mod FKeySize) <> 0) do
   begin
     TempKey := TempKey + TempKey[i];
     Inc(i);
   end;
 
 // Now shorten the key down to one KeySize block by combining the bytes
 i := 1;
 j := 0;
 while (i < Length(TempKey)) do
   begin
     Move((FKeyPtr+j)^, K1, 4);
     Move(TempKey[i], K2, 4);
     K1 := ROL(K1, K2) xor K2;
     Move(K1, (FKeyPtr+j)^, 4);
     j := (j + 4) mod FKeySize;
     Inc(i, 4);
   end;
end;
 
////////////////////////////////////////////////////////////////////////////////
 
{$R-,Q-}
procedure ExpandKeys;
var
  i : Integer;
begin
 // Копирование ключа в Z
 Move(FKeyPtr^, Z, FKeySize);
 
 // Генерация подключа зашифрование
 for i := 8 to KeyLength-1 do
   begin
     if (((i+2) mod 8) = 0) then Z[i] := (Z[i- 7] shl 9) xor (Z[i-14] shr 7)
       else if (((i+1) mod 8) = 0) then Z[i] := (Z[i-15] shl 9) xor (Z[i-14] shr 7)
         else Z[i] := (Z[i- 7] shl 9) xor (Z[i- 6] shr 7);
   end;
end;
 
////////////////////////////////////////////////////////////////////////////////
 
procedure InvertKeys;
type
  PWord        = ^Word;
var
  j          : Integer;
  pz, pp     : PWord;
  t1, t2, t3 : Word;
 
////////////////////////////////////////
 
  function Inv(I: Integer): Integer;
  var
    n1, n2, q, r, b1, b2, t : Integer;
  begin
   if (I = 0) then
     Result := 0 else
       begin
         n1 := Maxim;
         n2 := I;
         b2 := 1;
         b1 := 0;
         repeat
         r := (n1 mod n2);
         q := (n1-r) div n2;
         if (r = 0) then
           begin
             if (b2 < 0) then b2 := Maxim + b2;
           end else
               begin
                 n1 := n2;
                 n2 := r;
                 t  := b2;
                 b2 := b1 - q * b2;
                 b1 := t;
               end;
         until (r = 0);
         Result := b2;
       end;
  Result := (Result and $ffff);
  end;
 
////////////////////////////////////////
 
begin
    pz := @Z;
    pp := @K;
    Inc(pp, KeyLength);
 
//  t1 = inv(*Z++);
    t1 := Inv(pz^);
    Inc(pz);
 
//  t2 = -*Z++;
    t2 := -pz^;
    Inc(pz);
 
//  t3 = -*Z++;
    t3 := -pz^;
    Inc(pz);
 
//  *--p = inv(*Z++);
    Dec(pp);
    pp^ := Inv(pz^);
    Inc(pz);
 
//  *--p = t3;
    Dec(pp);
    pp^ := t3;
 
//  *--p = t2;
    Dec(pp);
    pp^ := t2;
 
//  *--p = t1;
    Dec(pp);
    pp^ := t1;
 
    for j := 1 to Rounds-1 do
      begin
//      t1 = *Z++;
        t1 := pz^;
        Inc(pz);
 
//      *--p = *Z++;
        Dec(pp);
        pp^ := pz^;
        Inc(pz);
 
//      *--p = t1;
        Dec(pp);
        pp^ := t1;
 
//      t1 = inv(*Z++);
        t1 := Inv(pz^);
        Inc(pz);
 
//      t2 = -*Z++;
        t2 := -pz^;
        Inc(pz);
 
//      t3 = -*Z++;
        t3 := -pz^;
        Inc(pz);
 
//      *--p = inv(*Z++);
        Dec(pp);
        pp^ := Inv(pz^);
        Inc(pz);
 
//      *--p = t2;
        Dec(pp);
        pp^ := t2;
 
//      *--p = t3;
        Dec(pp);
        pp^ := t3;
 
//      *--p = t1;
        Dec(pp);
        pp^ := t1;
      end;
 
//  t1 = *Z++;
    t1 := pz^;
    Inc(pz);
 
//  *--p = *Z++;
    Dec(pp);
    pp^ := pz^;
    Inc(pz);
 
//  *--p = t1;
    Dec(pp);
    pp^ := t1;
 
//  t1 = inv(*Z++);
    t1 := Inv(pz^);
    Inc(pz);
 
//  t2 = -*Z++;
    t2 := -pz^;
    Inc(pz);
 
//  t3 = -*Z++;
    t3 := -pz^;
    Inc(pz);
 
//  *--p = inv(*Z++);
    Dec(pp);
    pp^ := Inv(pz^);
 
//  *--p = t3;
    Dec(pp);
    pp^ := t3;
 
//  *--p = t2;
    Dec(pp);
    pp^ := t2;
 
//  *--p = t1;
    Dec(pp);
    pp^ := t1;
end;
{$R+,Q+}
 
////////////////////////////////////////////////////////////////////////////////
 
procedure CalculateSubKeys;
begin
 ExpandKeys;
 InvertKeys;
end;
 
////////////////////////////////////////////////////////////////////////////////
 
procedure Initialize(AKey: string);
begin
 FBlockSize  := 8;
 FBufferSize := 2048;
 FKey        := AKey;
 FKeySize    := 32;
 
 FillChar(Z, SizeOf(Z), 0);
 FillChar(K, SizeOf(K), 0);
 
 GetMem(FKeyPtr, FKeySize);
 FillChar(FKeyPtr^, FKeySize, #0);
 
 InvolveKey;
end;
 
////////////////////////////////////////////////////////////////////////////////
 
{$R-,Q-}
procedure Cipher(var Block: TIDEABlock; const Keys: TIDEAKey);
var
  x1, x2, x3, x4 : Word;
  t1, t2         : Word;
  pz             : ^Word;
  r                     : Integer;
 
////////////////////////////////////////
 
  function Mul(a,b: Word): Word;
  var
    p : LongWord;
  begin
   if (a > 0) then
   begin
     if (b > 0) then
     begin
       p := LongWord(a)*b;
       b := p and $ffff;
       a := p shr 16;
       Result := ((b - a) + Ord(b < a));
     end else Result := 1 - a;
   end else Result := 1 - b;
  end;
 
////////////////////////////////////////
 
begin
//  x1 = *in++;  x2 = *in++;
    x1 := Block[1];
    x2 := Block[2];
//  x3 = *in++;  x4 = *in;
    x3 := Block[3];
    x4 := Block[4];
 
    pz := @Keys;
    for r := 1 to Rounds do
      begin
//      MUL(x1,*Z++);
        x1 := Mul(x1, pz^);
        Inc(pz);
 
//      x2 += *Z++;
        x2 := x2 + pz^;
        Inc(pz);
 
//      x3 += *Z++;
        x3 := x3 + pz^;
        Inc(pz);
 
//      MUL(x4, *Z++);
        x4 := Mul(x4, pz^);
        Inc(pz);
 
//      t2 = x1^x3;
        t2 := x1 xor x3;
 
//      MUL(t2, *Z++);
        t2 := Mul(t2, pz^);
        Inc(pz);
 
//      t1 = t2 + (x2^x4);
        t1 := t2 + (x2 xor x4);
 
//      MUL(t1, *Z++);
        t1 := Mul(t1, pz^);
        Inc(pz);
 
//      t2 = t1+t2;
        t2 := (t1 + t2);
 
//      x1 ^= t1;
        x1 := x1 xor t1;
 
//      x4 ^= t2;
        x4 := x4 xor t2;
 
//      t2 ^= x2;
        t2 := t2 xor x2;
 
//      x2 = x3^t1;
        x2 := x3 xor t1;
 
//      x3 = t2;
        x3 := t2;
      end;
 
//  MUL(x1, *Z++);
    x1 := Mul(x1, pz^);
    Inc(pz);
 
//  *out++ = x1;
    Block[1] := x1;
 
//  *out++ = x3 + *Z++;
    Block[2] := x3 + pz^;
    Inc(pz);
 
//  *out++ = x2 + *Z++;
    Block[3] := x2 + pz^;
    Inc(pz);
 
//  MUL(x4, *Z);
    x4 := Mul(x4, pz^);
 
//  *out = x4;
    Block[4] := x4;
end;
{$R+,Q+}
 
////////////////////////////////////////////////////////////////////////////////
 
function EncipherBlock(var Block): Boolean;
begin
 Cipher(TIDEABlock(Block), Z);
 Result := TRUE;
end;
 
////////////////////////////////////////////////////////////////////////////////
 
function DecipherBlock(var Block): Boolean;
begin
 Cipher(TIDEABlock(Block), K);
 Result := TRUE;
end;
 
////////////////////////////////////////////////////////////////////////////////
// Главные функции ...
 
function EncryptCopy(DestStream, SourseStream : TStream; Count: Int64;
  Key : string): Boolean;
var
  Buffer   : TIDEABlock;
  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 >= 8 do
     begin
       SourseStream.Read(Buffer, SizeOf(TIDEABlock));
       EncipherBlock(Buffer);
       DestStream.Write(Buffer, SizeOf(TIDEABlock));
       Inc(PrCount, 8);
     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   : TIDEABlock;
  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 >= 8 do
     begin
       SourseStream.Read(Buffer, SizeOf(TIDEABlock));
       DecipherBlock(Buffer);
       DestStream.Write(Buffer, SizeOf(TIDEABlock));
       Inc(PrCount, 8);
     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   : TIDEABlock;
  PrCount  : Int64;
  AddCount : Byte;
begin
 Result := True;
 try
   if Key = '' then
     begin
       DataStream.Seek(Count, soFromCurrent);
       Exit;
     end;
   Initialize(Key);
   CalculateSubKeys;
   PrCount := 0;
   while Count - PrCount >= 8 do
     begin
       DataStream.Read(Buffer, SizeOf(TIDEABlock));
       EncipherBlock(Buffer);
       DataStream.Seek(-SizeOf(TIDEABlock), soFromCurrent);
       DataStream.Write(Buffer, SizeOf(TIDEABlock));
       Inc(PrCount, 8);
     end;
 except
   Result := False;
 end;
end;
 
////////////////////////////////////////////////////////////////////////////////
 
function DecryptStream(DataStream: TStream; Count: Int64; Key: string): Boolean;
var
  Buffer   : TIDEABlock;
  PrCount  : Int64;
begin
 Result := True;
 try
   if Key = '' then
     begin
       DataStream.Seek(Count, soFromCurrent);
       Exit;
     end;
   Initialize(Key);
   CalculateSubKeys;
   PrCount := 0;
   while Count - PrCount >= 8 do
     begin
       DataStream.Read(Buffer, SizeOf(TIDEABlock));
       DecipherBlock(Buffer);
       DataStream.Seek(-SizeOf(TIDEABlock), soFromCurrent);
       DataStream.Write(Buffer, SizeOf(TIDEABlock));
       Inc(PrCount, 8);
     end;
 except
   Result := False;
 end;
end;
 
// Завершение главных функций ...
////////////////////////////////////////////////////////////////////////////////
 
end.

А пользоваться этим модулем можно так. Нижеприведенный пример демонстрирует шифрование / дешифрование файла с использованием функций EncryptStream / DecryptStream:

procedure TForm1.Button1Click(Sender: TObject);
var
  SourseStream : TFileStream;
begin
 SourseStream := TFileStream.Create(Edit1.Text, fmOpenReadWrite        );
 EncryptStream(SourseStream, SourseStream.Size, Edit2.Text);
 SourseStream.Free;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
var
  SourseStream : TFileStream;
begin
 SourseStream := TFileStream.Create(Edit1.Text, fmOpenReadWrite        );
 DecryptStream(SourseStream, SourseStream.Size, Edit2.Text);
 SourseStream.Free;
end;

ПРИМЕЧАНИЕ: Так как алгоритм шифрует данные блоками по 8 байт, а размер шифруемых данных не всегда кратен 8, поэтому в данном модуле последний блок, если он размером больше нодя и меньше восьми, не шифруется. Поэтому, если функцию шифрования обозначить e(x), а Srt1 и Str2 - шифруемые данные, то e(Str1) + e(Str2) не всегда равно e(Str1 + Str2).

Матвеев Игорь Владимирович

https://delphiworld.narod.ru/

DelphiWorld 6.0