Шифрование методом Льюиса

const
  len = 26;

  {Это символы для выбора столбца таблицы}
  alpha_hor: string = 'abcdefghijklmnopqrstuvwxyz';

  {Здесь будут символы для выбора строки таблицы}
  alpha_ver: string = '';

var
  {Это собственно таблица кодирования}
  table: array[1 .. len, 1 .. len] of char;

{функция получает строку S и возвращает строку,
  полученную из исходной сдвигом на N позиций}
function shift(s: string; n: integer): string;
  begin
    s := copy(s, length(s) - pred(n), n) + s;
    delete(s, length(s) - pred(n), n); shift := s
  end;

var
  i, j, row, col: integer;
  s: string; ch: char;

  key: string;
  is_russian: boolean;
  f_in: file of char; f_out, f_key: text;
begin
  { Заполнение таблицы кодировки }
  for i := 1 to len do begin
    {получаем строку символов для текущей строки таблицы}
    s := shift(alpha_hor, pred(i));
    for j := 1 to len do
      table[i, j] := s[j];
    {
      не забываем первый символ заносить в "хранилище"
      для выбора строк по кодируемой букве
    }
    alpha_ver := alpha_ver + s[1]
  end;

  { связываем логические файлы программы с физическими файлами на диске }

  { файл с фразой для кодирования - открываем для чтения }
  assign(f_in, 'f_00in.txt');
  {$i-} reset(f_in); {$i+}

  { файл для сохранения результата - открываем для записи }
  assign(f_out, 'f_00out.txt');
  {$i-} rewrite(f_out); {$i+}

  {
    файл, содержащий ключевое слово - открываем для чтения,
    считываем слово в строковую переменную и закрываем файл
  }
  assign(f_key, 'f_00key.txt');
  {$i-} reset(f_key); {$i+}
  readln(f_key, key);
  close(f_key);

  { счетчик закодированных символов }
  i := 0;
  {до конца кодируемого файла делаем следующее:}
  while not eof(f_in) do begin
    { читаем очередной символ }
    read(f_in, ch);
    { находим по нему строку таблицы }
    row := pos(ch, alpha_ver);
    {
      эта переменная содержит значение успеха предыдущей операции
      (если True, то символ присутствует в таблице, иначе False)
    }
    is_russian := (row > 0);
    if is_russian then begin
      { Если символ присутствует в таблице, его надо кодировать }

      { увеличиваем счетчик закодированных символов }
      inc(i);

      {
        находим столбец по значению ключевого символа
        (операция mod используется, чтобы исключить выход
        за пределы ключа, т.к. длина ключа обычно меньше
        длины шифруемой последовательности)
      }
      col := pos(key[i mod (length(key))], alpha_hor);
      { и заменяем простой символ на зашифрованный (из таблицы) }
      ch := table[row, col];
    end;
    {
      если символ надо было шифровать, он уже зашифрован,
      если он не может быть зашифрован, он остался без изменений.
      Пишем его в выходной файл
    }
    write(f_out, ch)
  end;

  { И закрываем оба файла: исходный и зашифрованный }
  close(f_out);
  close(f_in)
end.

Шифрование методом Атбаш

function Atbash(toCode: string): string;
var i: integer;
begin
  for i := 1 to length(toCode) do
    toCode[ i ] := Chr(256 - Ord(toCode[ i ]));
  Atbash := toCode;
end;

{ Использование: }
var
  s: string;

begin
  s := Atbash('Just a test'); { зашифровать }
  writeln(s);
  writeln('s = ', Atbash(s)); { расшифровать }
end.

Шифрование методом Цезаря

const
  n = 3;

function CaesarEncipher(toCode: string): string;
var i, T: integer;
begin
  for i := 1 to length(toCode) do begin
    T := (Ord(toCode[ i ]) + n);
    if T >= 256 then dec(T, 256);
    toCode[ i ] := Chr(T);
  end;
  CaesarEncipher := toCode;
end;

function CaesarDecipher(toDecode: string): string;
var i, T: integer;
begin
  for i := 1 to length(toDecode) do begin
    T := (Ord(toDecode[ i ]) - n);
    if T < 0 then Inc(T, 256);
    toDecode[ i ] := Chr(T);
  end;
  CaesarDecipher := toDecode;
end;

{ применение: }
var
  s: string;

begin
  s := CaesarEncipher('just a Caesar');
  writeln(s);
  writeln('s = ', CaesarDecipher(s));
end.

Квадрат Полибия

const
  TPolibius: array['A' .. 'E', 'A' .. 'E'] of char = (
    ('A', 'B', 'C', 'D', 'E'),
    ('F', 'G', 'H', 'I', 'K'),
    ('L', 'M', 'N', 'O', 'P'),
    ('Q', 'R', 'S', 'T', 'U'),
    ('V', 'W', 'X', 'Y', 'Z')
  );
function PolibiusEncipher(toCode: string): string;
var
  i: integer;
  ix, jx: char;
  s: string;
begin
  s := '';
  for i := 1 to length(toCode) do begin

    for ix := 'A' to 'E' do
      for jx := 'A' to 'E' do
        if TPolibius[ix, jx] = toCode[ i ] then begin
          s := s + ix + jx; break;
        end;

  end;
  PolibiusEncipher := s
end;

function PolibiusDecipher(toDecode: string): string;
var
  i: integer;
  s: string;
begin
  s := '';
  i := 1;
  while i <= length(toDecode) do begin
    s := s + TPolibius[toDecode[ i ], toDecode[succ(i)]];
    inc(i, 2);
  end;
  PolibiusDecipher := s
end;

var
  s: string;

begin
  s := PolibiusEncipher('POLIBIUS');
  writeln(s);
  writeln('s = ', PolibiusDecipher(s));
end.

Шифр Вижинера

const
  TViginer: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';

function ViginerEncipher(toCode, K: string): string;
var
  i: integer;
  currK: byte;
  s: string;
begin
  s := '';
  for i := 1 to length(toCode) do begin
    currK := pred(pos(K[ (pred(i) mod length(K)) + 1 ], TViginer));
    s := s +
      TViginer[ ((pred(pos(toCode[ i ], TViginer)) + currK) mod length(TViginer)) + 1 ];
  end;
  ViginerEncipher := s;
end;

function ViginerDecipher(toDecode, K: string): string;
var
  i, T: integer;
  currK: byte;
  s: string;
begin
  s := '';
  for i := 1 to length(toDecode) do begin
    currK := pred(pos(K[ (pred(i) mod length(K)) + 1 ], TViginer));
    T := pred(pos(toDecode[ i ], TViginer)) - currK;
    if T < 0 then inc(T, length(TViginer));
    s := s + TViginer[T + 1];
  end;
  ViginerDecipher := s;
end;

var
  s: string;

begin
  s := ViginerEncipher('INFORMATION', 'BORED');
  writeln(s);
  writeln('s = ', ViginerDecipher(s, 'BORED'));
end.

Шифр Гронсфельда

function GronsfeldEncipher(toCode, K: string): string;
var i, T, _T: integer;
begin
  for i := 1 to length(toCode) do begin
    _T := ord(toCode[ i ]);

    T := (Ord(toCode[ i ])

      +
      (Ord(K[(pred(i) mod length(K)) + 1]) - Ord('0'))

         );

    if T >= 256 then dec(T, 256);
    toCode[ i ] := Chr(T);
  end;
  GronsfeldEncipher := toCode;
end;

function GronsfeldDecipher(toDecode, K: string): string;
var i, T: integer;
begin
  for i := 1 to length(toDecode) do begin
    T := (Ord(toDecode[i])

      -
      (Ord(K[(pred(i) mod length(K)) + 1]) - Ord('0'))

         );
    if T < 0 then Inc(T, 256);
    toDecode[ i ] := Chr(T);
  end;
  GronsfeldDecipher := toDecode;
end;

var
  s: string;

begin
  s := GronsfeldEncipher('INFORMATION', '2178');
  writeln(s);
  writeln('s = ', GronsfeldDecipher(s, '2178'));
end.

Шифрование с помощью решетки

const
  n = 8;
type
  sType = string[n];
  matrix = array[1 .. n] of sType;
const
  mask: matrix = (
    'x...x...',
    '.x...x..',
    '..x...x.',
    '...x...x',
    '..x...x.',
    '...x....',
    'x...x..x',
    '..x..x..'
  );

  st: string =
    'сколькоцелыхчетырёхзначныхчиселможнополучитьизцифрнольодиндватри';

var
  encoded: matrix;
  masked: matrix;

{ Процедура поворота матрицы }
procedure T(var res: matrix);
var
  i, j: integer;
  mx: matrix;
begin
  mx := res;
  for i := 1 to n do
    for j := 1 to n do
      res[j, n - i + 1] := mx[i, j];
end;

{ Зашифровка текста }
procedure EncodeText(const s: string;
          const mask: matrix; var mx: matrix);
var
  i, j, count: integer;
  masked: matrix;
begin
  { Заполнение матрицы mx строками по N пробелов }
  for i := 1 to n do
    for j := 1 to n do mx[i] := mx[i] + #32;

  masked := mask;
  count := 1;
  while count <= length(s) do begin

    for i := 1 to n do
      for j := 1 to n do
        if masked[i, j] = 'x' then begin
          mx[i][j] := s[count];
          inc(count)
        end;
    T(masked);

  end;
end;

{ Расшифровка текста }
function DecodeText(const mask, encoded: matrix): string;
var
  s: string;
  i, j, count: integer;
  masked: matrix;
begin

  masked := mask;
  count := 0; s := '';
  while length(s) < n*n do begin
    for i := 1 to n do
      for j := 1 to n do
        if masked[i, j] = 'x' then s := s + encoded[i, j];
    T(masked);
  end;
  DecodeText := s;

end;
var
  i: integer;
begin

  EncodeText(st, mask, encoded);

  writeln('encoded text: ');
  for i := 1 to n do begin
    writeln(encoded[i]);
  end;

  writeln(DecodeText(mask, encoded));

end.

encoded text:
срофкжрё
ноноолхп
зльноакь
олчонудц
чыеиинлх
чтдывьиа
хтисчезе
рлтцмыии
сколькоцелыхчетырёхзначныхчиселможнополучитьизцифрнольодиндватри

Шифр Хилла (с длиной блока = 2)

    | 3 3 |          |15 17 |
M = |     |, и M-1 = |      |
    | 2 5 |          |20  9 |

MP = C

     |H|   |7|          |L|   |11|
P1 = | | = | |  и  P2 = | | = |  |
     |E|   |4|          |P|   |15|

       |7|                 | 0|
M*P1 = | | = C1  и  M*P2 = |  | = C2
       |8|                 |19|

P = M-1 * C [mod 26]

type
  very_long = longint;

  { Тип матрицы - ключа }
  tkey    = array[1 .. 2, 1 .. 2] of integer;
  { Матрица - столбец }
  tcolumn = array[1 .. 2] of integer;

  pmatrix = ^matrix;
  matrix  = array [1 .. maxint div sizeof(tcolumn)] of tcolumn;

function _inc(var x: integer): integer;
begin
  inc(x);
  _inc := x;
end;

{
  Реализация расширенного алгоритма Евклида
  (используется для нахождения числа, обратного данному по модулю
   при вычислении определителя матрицы)
}
procedure extended_euclid(a, b: very_long;
          var x, y, d: very_long);
var q, r, x1, x2, y1, y2: very_long;
begin

  if b = 0 then begin

    d := a; x := 1; y := 0;
    exit

  end;

  x2 := 1; x1 := 0; y2 := 0; y1 := 1;
  while b > 0 do begin

    q := a div b; r := a - q * b;
    x := x2 - q * x1; y := y2 - q * y1;
    a := b; b := r;
    x2 := x1; x1 := x; y2 := y1; y1 := y;

  end;

  d := a; x := x2; y := y2;

end;

(* Вычисление числа, обратного A по модулю N *)
function inverse(a, n: very_long): very_long;
var d, x, y: very_long;
begin

  extended_euclid(a, n, x, y, d);
  if d = 1 then inverse := x
  else inverse := 0;

end;

{ Алфавит криптосистемы }
const
  alpha: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';

{ Преобразование массива столбцов длины Count в строку символов }
function make_str(const arr: array of tcolumn;
         const count: integer): string;
var
  res: string;
  i, j: integer;
begin
  res := '';

  for i := 0 to pred(count) do
    for j := 1 to 2 do res := res + alpha[succ(arr[i][j])];

  make_str := res;
end;
{ Преобразование строки символов S в массив столбцов (возвращается длина массива) }
function make_columns(var arr: array of tcolumn;
         const s: string): integer;
var
  i, count: integer;
  col: tcolumn;
begin
  count := -1;
  for i := 1 to length(s) do begin

    col[2 - (i mod 2)] := pred(pos(s[i], alpha));
    if not odd(i) then
      arr[_inc(count)] := col;

  end;
  make_columns := count + 1;
end;

{ Функция шифрования сообщения S ключом K }
function EncodeHill(const k: Tkey; const s: string): string;
var
  i, j, count: integer;
  mx, Y: pmatrix;
  len: integer;

begin
  len := sizeof(tcolumn) * ( (length(s) div 2) + byte(odd(length(s))) );
  getmem(mx, len);
  getmem( Y, len);

  count := make_columns(mx^, s);
  for i := 1 to count do
    for j := 1 to 2 do
      Y^[i][j] := (K[j, 1] * mx^[i][1] + K[j, 2] * mx^[i][2]) mod length(alpha);

  EncodeHill := make_str(Y^, count);

  freemem( Y, len);
  freemem(mx, len);
end;

{ Функция расшифровки шифротекста S известным ключом K }
function DecodeHill(const k: Tkey; const s: string): string;

  function positive(X: integer): integer;
  begin
    repeat
      inc(X, length(alpha));
    until X >= 0;
    positive := X;
  end;

var
  inv_k: Tkey;
  det, i, j, count: integer;
  mx, Y: pmatrix;
  len: integer;

begin
  det := k[1, 1] * k[2, 2] - k[1, 2] * k[2, 1];
  if det < 0 then det := positive(det);

  det := inverse(det, length(alpha));
  for i := 1 to 2 do
    for j := 1 to 2 do begin

      if i = j then
        inv_k[i, j] := det * k[3 - i, 3 - j]
      else
        inv_k[i, j] := - det * k[i, j];

      if inv_k[i, j] < 0 then
        inv_k[i, j] := positive(inv_k[i, j])
      else inv_k[i, j] := inv_k[i, j] mod 26;
    end;

  len := sizeof(tcolumn) * ( (length(s) div 2) + byte(odd(length(s))) );
  getmem(mx, len);
  getmem( Y, len);

  count := make_columns(Y^, s);

  for i := 1 to count do
    for j := 1 to 2 do
      mx^[i][j] := (inv_k[j, 1] * Y^[i][1] + inv_k[j, 2] * Y^[i][2]) mod length(alpha);

  DecodeHill := make_str(mx^, count);

  freemem( Y, len);
  freemem(mx, len);
end;

{ Тестируем работу функций кодирования/декодирования }
const
  k_2: Tkey = ((1, 7), (3, 6));

begin
  writeln('encoding:');
  writeln(EncodeHill(k_2, 'AFINEAFTERNOON'));
  writeln('decoding:');
  { Декодируем результат работы предыдущей функции с тем же ключом }
  writeln(DecodeHill(k_2, 'JEVYEMIZTKHTBQ'));
end.