Шифрование

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.

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
  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.

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.

type
  tdatablock = array [0..1] of longword;
type
  pdatablock = ^Tdatablock;
type
  t2datablock = array [0..1] of tdatablock;
type
  p2datablock = ^T2datablock;
type
  tkeyblock = array [0..3] of longword;
type
  pkeyblock = ^Tkeyblock;


  { Шифрование }
  procedure crypt (Dat a: tdatablock; var Result: tdatablock; key: pkeyblock);
  stdcall; export;
  var
    b0: longword;
    b1: longword;
    i:  longword;
    sk: array [0..31] of longword;
    k:  tkeyblock;
  begin

    b0 := Data[0];
    b1 := Data[1];

    move(key^, k[0], 16);

    for I := 0 to 31 do
      begin
      k[i mod 4] := ((k[0] + k[1]) + ((k[2] + k[3]) xor (k[0] shl k[2])));
      sk[i] := k[i mod 4];
      end;

    for i := 0 to 31 do
      begin
      b0 := b0 + (((sk[i] + b1) shl 9) xor ((sk[i] - b1) xor ((sk[i] + b1) shr 14)));
      b1 := b1 + (((sk[i] + b0) shl 9) xor ((sk[i] - b0) xor ((sk[i] + b0) shr 14)));
      end;

    Result[0] := b0;
    Result[1] := b1;

  end;


  { Дешифрование }
  procedure decrypt (Dat a: tdatablock; var Result: tdatablock; key: pkeyblock);
  stdcall; export;
  var
    b0: longword;
    b1: longword;
    i:  longword;
    sk: array [0..31] of longword;
    k:  tkeyblock;
  begin

    b0 := Data[0];
    b1 := Data[1];

    move(key^, k[0], 16);

    for I := 0 to 31 do
      begin
      k[i mod 4] := ((k[0] + k[1]) + ((k[2] + k[3]) xor (k[0] shl k[2])));
      sk[i] := k[i mod 4];
      end;

    for i := 31 downto 0 do
      begin
      b1 := b1 - (((sk[i] + b0) shl 9) xor ((sk[i] - b0) xor ((sk[i] + b0) shr 14)));
      b0 := b0 - (((sk[i] + b1) shl 9) xor ((sk[i] - b1) xor ((sk[i] + b1) shr 14)));
      end;

    Result[0] := b0;
    Result[1] := b1;

  end;