unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,System.Math, StrUtils;

type
  TForm1 = class(TForm)
    edKey: TEdit;
    btnPressEncrypt: TButton;
    chbStolb: TCheckBox;
    chbReshet: TCheckBox;
    chbViginer: TCheckBox;
    mmEncryptText: TMemo;
    btnDeEncrypt: TButton;
    procedure btnPressEncryptClick(Sender: TObject);
    procedure chbStolbClick(Sender: TObject);
    procedure chbReshetClick(Sender: TObject);
    procedure chbViginerClick(Sender: TObject);
    procedure btnDeEncryptClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}
type
    TMatr = array [1..4] of array [1..4] of integer;
const
  Alphabet : set of char = ['A'..'Z',' '];

procedure ColumnProc(key: string; var mmEncryptText:TMemo; flag: boolean);
const
  Alphabet : set of char = ['A'..'Z'];
var
  chiphertext, dechiphertext, keybuff, text ,temp: string;
  min : char;
  colCount, i, j,k, minpos,m,rowcount: integer;
  Myfile: TextFile;
begin

  key := UpperCase(key);
  keybuff := key;
  if flag then begin
  mmEncryptText.Lines.Clear;
  AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\stolbсifer.txt');
  Reset(myFile);
  text:='';
  while not EOF(myFile) do begin
    readln(myFile,temp);
    text:=text+temp;
  end;
  closeFile(myFile);

  text := UpperCase(text);
  text:= trim(text);

  i := 1;
  while (i<= length(text)) do
  begin
    if not(text[i] in Alphabet) then
    begin
      delete(text,i,1);
      dec(i);
    end;
    inc(i);
  end;
  mmEncryptText.Lines.Add('Текст: '+text);
  mmEncryptText.Lines.Add('-------------------------');
  mmEncryptText.Lines.Add('Ключ: '+key);
  mmEncryptText.Lines.Add('-------------------------');
  colcount := length(key);

  while (length(text)mod length(key)<>0) do
    text := text + ' ';
  rowcount := ceil(length(text)/length(key));

  chiphertext := '';
  for k := 1 to length(key) do
   begin

      min := key[1];
      minpos := 1;
      for j := 2 to length(key) do
      begin
        if min > key[j] then
        begin
          min := key[j];
          minpos := j;
        end;
      end;
      key[minpos] := '_';
      i := minpos;

      while (i<= length(text)) do
      begin
        if text[i] = ' ' then begin
          inc(i,length(key));
          continue;
        end;

        chiphertext := chiphertext + text[i];
        inc(i,length(key));
      end;
   end;

  mmEncryptText.Lines.Add('Шифротекст: '+chiphertext);
  AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\stolbсiferCIFER.txt');
  Rewrite(myFile);
    writeln(myFile,chiphertext);
  closeFile(myFile);

end;

  if not (flag) then begin
  AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\stolbсiferCIFER.txt');
  Reset(myFile);
    readln(myFile,chiphertext);
  closeFile(myFile);

  text := '';
  SetLength(dechiphertext, length(chiphertext));
  for i := 1 to length(chiphertext) do
    dechiphertext[i] := ' ';
   m :=1;
   for k := 1 to length(keybuff) do
   begin
      min := keybuff[1];
      minpos := 1;
      for j := 2 to length(keybuff) do
      begin
        if min > keybuff[j] then
        begin
          min := keybuff[j];
          minpos := j;
        end;
      end;
      keybuff[minpos] := '_';
      i := minpos;
      while (i<= length(chiphertext)) do
      begin
        dechiphertext[i] := chiphertext[m];
        inc(i,length(key));
        inc(m);
      end;
   end;

  mmEncryptText.Lines.Add('-------------------------');
  mmEncryptText.Lines.Add('Дешифротекст: '+dechiphertext);

  AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\stolbсiferDECIFER.txt');
  Rewrite(myFile);
    writeln(myFile,dechiphertext);
  closeFile(myFile);
  end;
end;

procedure MatrRotate(var Matr :TMatr);
 var
    i,j, buff : integer;
 begin
   for i := 1 to 4 do
   begin
     for j:= i to 4 do
     begin
       if (i+j) mod 2 = 1 then
       begin
         buff := Matr[i,j];
         Matr[i,j] := Matr[j,i];
         Matr[j,i] := buff;
       end;


     end;

   end;

   for j := 1 to 4 do
   begin
     buff := Matr[j,1];
     Matr[j,1] := Matr[j,4];
     Matr[j,4] := buff;
     buff := Matr[j,2];
     Matr[j,2] := Matr[j,3];
     Matr[j,3] := buff;
   end;
 end;

 function KardanoMatr( var text : string):string;
 var
  i,j, k,m,lastind : integer;
  matr : Tmatr ;
  textpart,resultpart : string;
 begin
  SetLength(result, length(text));
  for i := 1 to length(text) do
    result[i] := ' ';

  for i := 1 to 4 do
    for j := 1 to 4 do
      Matr[i,j]:=0;
  Matr[1,1] := 1;
  Matr[2,4] := 1;
  Matr[3,3] := 1;
  Matr[4,2] := 1;

   m:=1;
   while (m <= length(text))  do
   begin
    if m+16 > length(text) then
    begin
        lastind := length(text);
        SetLength(textpart,lastind-m);
        SetLength(resultpart,lastind-m);
    end
    else
    begin
     lastind := m+16;
     SetLength(textpart,16);
     SetLength(resultpart,16);
    end;

     for j := m to lastind do
       textpart[j-m+1] := text[j];

     k:= 1;
     while (k < 16) do
     begin
       for  i:= 1 to 4 do
       begin
         for j := 1 to 4 do
         begin
           if Matr[i,j] =1  then
           begin
             resultpart[j+(i-1)*4]:=textpart[k];
             inc(k);
           end;
         end;
       end;
       MatrRotate(matr);
     end;

     for k := m to m+15 do
      result[k] := resultpart[k-m+1];

     inc(m,16);

   end;

 end;

 function DeKardanoMatr( var chiphertext : string):string;
 var
  i,j, k,m,lastind : integer;
  matr : Tmatr ;
  textpart,resultpart : string;
 begin
  SetLength(result, length(chiphertext));
  for i := 1 to length(chiphertext) do
    result[i] := ' ';

  for i := 1 to 4 do
    for j := 1 to 4 do
      Matr[i,j]:=0;
  Matr[1,1] := 1;
  Matr[2,4] := 1;
  Matr[3,3] := 1;
  Matr[4,2] := 1;

   m:=1;
   while (m <= length(chiphertext))  do
   begin
    if m+16 > length(chiphertext) then
    begin
        lastind := length(chiphertext);
        SetLength(textpart,lastind-m);
        SetLength(resultpart,lastind-m);
    end
    else
    begin
     lastind := m+16;
     SetLength(textpart,16);
     SetLength(resultpart,16);
    end;

     for j := m to lastind do
       textpart[j-m+1] := chiphertext[j];

     k:= 1;
     while (k < 16) do
     begin
       for  i:= 1 to 4 do
       begin
         for j := 1 to 4 do
         begin
           if Matr[i,j] =1  then
           begin
             resultpart[k]:=textpart[j+(i-1)*4];
             inc(k);
           end;
         end;
       end;
       MatrRotate(matr);
     end;

     for k := m to m+15 do
      result[k] := resultpart[k-m+1];

     inc(m,16);

   end;

 end;

const
  Alphabet1 : set of char = ['A'..'Z',' '];

procedure GridProc(var mmEncryptText:TMemo);
var
  chiphertext, dechiphertext,text : string;
  colCount, i, j,k, minpos,m,rowcount: integer;
  MATR : TMATR;
  myFile: TextFile;
begin
  mmEncryptText.Lines.Clear;
  AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\gridbсifer.txt');
  Reset(myFile);
    readln(myFile,text);
  closeFile(myFile);

  text := UpperCase(text);
  i := 1;

  while (i<= length(text)) do
  begin
    if not(text[i] in Alphabet) then
    begin
      delete(text,i,1);
      dec(i);
    end;
    inc(i);
  end;

  text:=trim(text);

  while (length(text)mod 16 <> 0) do
    text := text+' ';

  mmEnCryptText.Lines.Add('Исходный текст: '+text);
  SetLength(chiphertext, length(text));

  chiphertext := KardanoMatr(text);
  mmEnCryptText.Lines.Add('--------------------');
  mmEnCryptText.Lines.Add('Зашифрованный текст: '+chiphertext);

  AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\gridbсiferCIFER.txt');
  Rewrite(myFile);
    writeln(myFile,chiphertext);
  closeFile(myFile);

  dechiphertext := DeKardanoMatr(chiphertext);
  mmEnCryptText.Lines.Add('--------------------');
  mmEnCryptText.Lines.Add('Расшифрованный текст: '+dechiphertext);

  AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\gridbсiferDECIFER.txt');
  Rewrite(myFile);
    writeln(myFile,dechiphertext);
  closeFile(myFile);

end;

procedure ViginerProc(key: string; var mmEncryptText:TMemo;flag: boolean);
var
  myFile: TextFile;
  chiphertext, dechiphertext,text,long_key,RusAlph,yo,temp: string;
  i,j,ind: Integer;
  flagpos: boolean;
begin
AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\viginer.txt');
  Reset(myFile);
  while not(EOF(myfile)) do begin
    readln(myFile,temp);
    text:=text+temp;
  end;
  closeFile(myFile);

  RusAlph := 'АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ';
  //ShowMessage(IntToStr(ord('ё')-ord('а')));
  text:=AnsiUpperCase(text);
  i := 1;
  yo:='ё';
  while (i<= length(text)) do
  begin
    if not( (text[i] >= AnsiUpperCase('а')) and (text[i] <= AnsiUpperCase('я') ) or (text[i] = AnsiUpperCase('ё')) ) then
    begin

      delete(text,i,1);
      dec(i);
    end;
    inc(i);
  end;
  j:=0;
  long_key:=key;

  for i := length(key)+1 to length(text) do begin
    if j = length(text) then j:=0;
    long_key:=long_key+text[j+1];
    inc(j);
  end;
  mmEncryptText.Lines.Add('Текст: '+text);
  mmEncryptText.Lines.Add('-----------------');
  mmEncryptText.Lines.Add('Ключ: '+long_key);
  mmEncryptText.Lines.Add('-----------------');

if flag then begin

  mmEncryptText.Lines.Clear;

  chiphertext := '';
  ind:=0;
  {for i := 1 to length(text) do begin
    if (AnsiUpperCase(text[i]) = AnsiUpperCase(yo)) then
      chiphertext:=chiphertext+AnsiUpperCase(text[i])
    else begin
    ind:= (ord(text[i])+ord(long_key[i]))mod 32;
    chiphertext:=chiphertext+RusAlph[ind+1];
    end;
  end;}

  for i := 1 to length(text) do begin
    ind:= (pos(text[i],RusAlph)+pos(long_key[i],RusAlph));

    if (ind=34) then begin
    dec(ind,2);
    flagpos:=true;
    end;

    if not(flagpos) then chiphertext:=chiphertext+RusAlph[(ind-1) mod 33]
    else if flagpos then chiphertext:=chiphertext+RusAlph[(ind-1) mod 33+2]


  end;

  //ShowMessage(IntToStr((21+13) mod 33));

  mmEncryptText.Lines.Add('Шифротекст: '+chiphertext);
  mmEncryptText.Lines.Add('-----------------');

  AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\viginerCIFER.txt');
  Rewrite(myFile);
    writeln(myFile,chiphertext);
  closeFile(myFile);
end;

if not(flag) then begin
  AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\viginerCIFER.txt');
  Reset(myFile);
    readln(myFile,chiphertext);
  closeFile(myFile);
  ind:=0;
  dechiphertext:='';
  {for i := 1 to length(text) do begin
    if (AnsiUpperCase(text[i]) = AnsiUpperCase(yo)) then
      dechiphertext:=dechiphertext+AnsiUpperCase(text[i])
    else begin
      ind:=(ord(chiphertext[i])+33-ord(long_key[i]) ) mod 32;
      dechiphertext:=dechiphertext+RusAlph[ind];
    end;
  end;}

  for i := 1 to length(text) do begin
      ind:=(pos(chiphertext[i],RusAlph)+33-pos(long_key[i],RusAlph) ) mod 33;
      dechiphertext:=dechiphertext+RusAlph[ind+1];
  end;


  mmEncryptText.Lines.Add('Дешифротекст: '+dechiphertext);

  AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\viginerDECIFER.txt');
  Rewrite(myFile);
    writeln(myFile,dechiphertext);
  closeFile(myFile);
end;

end;

procedure TForm1.btnDeEncryptClick(Sender: TObject);
var
i: integer;
key: string;
letter_a, letter_ya: string;
flag: boolean;
begin
  flag:=false;
  if chbStolb.Checked then begin
    key:=edKey.Text;
    key := UpperCase(key);
    i:=1;

      while (i<= length(key)) do begin
        if not(key[i] in Alphabet1) then begin
          delete(key,i,1);
          dec(i);
        end;

        inc(i);
      end;

      if key = '' then ShowMessage('Неверный ключ, введите заного!')
      else ColumnProc(trim(key),mmEncryptText,flag);
  end
  else if chbReshet.Checked then GridProc(mmEncryptText)

  else if chbViginer.Checked then begin
    key:=edKey.Text;
    key := AnsiUpperCase(key);

    i:=1;
      while (i<= length(key)) do begin
        if not((key[i] >= AnsiUpperCase('а')) and (key[i] <= AnsiUpperCase('я')) or (key[i] = AnsiUpperCase('ё')) ) then begin
          delete(key,i,1);
          dec(i);
        end;

        inc(i);
      end;
      if key = '' then ShowMessage('Неверный ключ, введите заного!')
      else ViginerProc(trim(key),mmEncryptText,flag);
  end;

end;

procedure TForm1.btnPressEncryptClick(Sender: TObject);
var
i: integer;
key: string;
letter_a, letter_ya: string;
flag: boolean;
begin
  flag:=true;
  if chbStolb.Checked then begin
    key:=edKey.Text;
    key := UpperCase(key);
    i:=1;

      while (i<= length(key)) do begin
        if not(key[i] in Alphabet1) then begin
          delete(key,i,1);
          dec(i);
        end;

        inc(i);
      end;

      if key = '' then ShowMessage('Неверный ключ, введите заного!')
      else ColumnProc(trim(key),mmEncryptText,flag);
  end
  else if chbReshet.Checked then GridProc(mmEncryptText)

  else if chbViginer.Checked then begin
    key:=edKey.Text;
    key := AnsiUpperCase(key);

    i:=1;
      while (i<= length(key)) do begin
        if not((key[i] >= AnsiUpperCase('а')) and (key[i] <= AnsiUpperCase('я')) or (key[i] = AnsiUpperCase('ё')) ) then begin
          delete(key,i,1);
          dec(i);
        end;

        inc(i);
      end;
      if key = '' then ShowMessage('Неверный ключ, введите заного!')
      else ViginerProc(trim(key),mmEncryptText,flag);
  end;

end;

procedure TForm1.chbReshetClick(Sender: TObject);
begin
  chbStolb.Checked:=false;
  chbViginer.Checked:=false;
end;

procedure TForm1.chbStolbClick(Sender: TObject);
begin
  chbReshet.Checked:= false;
  chbViginer.Checked:=false;
end;

procedure TForm1.chbViginerClick(Sender: TObject);
begin
  chbStolb.Checked:=false;
  chbReshet.Checked:=false;
end;

end.