crypt

program shifr;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils, Math, Windows;

Type
  TArr = array of array of char;
  TCrypt = record
    Direct:byte;
    Angle:byte;
    SizeLen:integer;
  end;
  TFCr = file of TCrypt;

Var
  choose,dir,angle:char;
  input:string;
  InpArr:TArr;
  F:TextFile;
  FCr:TFCr;
  interCr:TCrypt;

function OPDecrypt(MyArr:TArr):string;
var
  i,j:integer;
begin
  for i := 0 to length(MyArr)-1 do
    for j := 0 to length(MyArr)-1 do
      result:=result+MyArr[i,j];
end;

procedure FillArr(var MyArr:TArr; MyInp:string);
var
  len:integer;
  k,i,j:integer;
begin
  //writeln('Исходный массив');
  len:=Ceil(sqrt(Length(MyInp)));
  SetLength(MyArr, len, len);
  k:=1;
  for i := 0 to len-1 do
  begin
    for j := 0 to len-1 do
    begin
      MyArr[i,j]:=MyInp[k];
      //write(MyArr[i,j]);
      inc(k);
    end;
    writeln;
  end;
end;

procedure CWEncrypt(MyArr:TArr; var MyFile:TextFile; var CrFile:TFCr; angle:integer);
var
  i,j,m,tmp,check:integer;
  x,y,k:integer;
  inter:string;
  intCrypt:TCrypt;
begin
  Rewrite(CrFile);
  intCrypt.Direct:=1;
  intCrypt.Angle:=angle;
  intCrypt.SizeLen:=length(MyArr);
  write(CrFile,intCrypt);
  closefile(CrFile);

  case Odd(Length(MyArr)) of
    True:
    begin
      x:=Length(MyArr) div 2;
      y:=x;
      case angle of
        1: k:=2;
        2: k:=3;
        3: k:=1;
        4: k:=0;
      end;
    end;

    False:
    begin
      case angle of
        1:
        begin
          k:=0;
          x:=Length(MyArr) div 2;
          y:=x;
        end;

        2:
        begin
          k:=1;
          x:=(Length(MyArr) div 2) ;
          y:=x-1;
        end;

        3:
        begin
          k:=3;
          x:=(Length(MyArr) div 2)-1;
          y:=x+1;
        end;

        4:
        begin
          k:=2;
          x:=(Length(MyArr) div 2)-1;
          y:=x;
        end;
      end;
    end;
  end;
  check:=1;
  tmp:=length(MyArr)-1;
  i := length(MyArr)+length(MyArr)-1;
  while (i >= 1) and (check <= sqr(length(MyArr))) do
  begin
    m:=1;
    while (m <= 2) and (check <= sqr(length(MyArr))) do
    begin
      j:=1;
      while (j <= Length(MyArr)-tmp) and (check <= sqr(length(MyArr))) do
      begin
        inter:=inter+MyArr[x,y];
        case k mod 4 of
          0: dec(y);
          1: dec(x);
          2: inc(y);
          3: inc(x);
        end;
        inc(check);
        inc(j);
      end;
      inc(k);
      inc(m);
    end;
    dec(tmp);
    dec(i);
  end;

  rewrite(MyFile);
  write(MyFile, inter);
  closefile(MyFile);
end;

procedure ACWEncrypt(MyArr:TArr; var MyFile:TextFile; var CrFile:TFCr; angle:integer);
var
  i,j,m,tmp,check:integer;
  x,y,k:integer;
  inter:string;
  intCrypt:TCrypt;
begin
  Rewrite(CrFile);
  intCrypt.Direct:=0;
  intCrypt.Angle:=angle;
  intCrypt.SizeLen:=length(MyArr);
  write(CrFile,intCrypt);
  closefile(CrFile);
  case Odd(Length(MyArr)) of
    True:
    begin
      x:=Length(MyArr) div 2;
      y:=x;
      case angle of
        1: k:=1;
        2: k:=0;
        3: k:=2;
        4: k:=3;
      end;
    end;

    False:
    begin
      case angle of
        1:
        begin
          k:=3;
          x:=(Length(MyArr) div 2)-1;
          y:=x;
        end;

        2:
        begin
          k:=2;
          x:=(Length(MyArr) div 2)-1;
          y:=x+1;
        end;

        3:
        begin
          k:=0;
          x:=(Length(MyArr) div 2)-1;
          y:=x-1;
        end;

        4:
        begin
          k:=1;
          x:=(Length(MyArr) div 2);
          y:=x;
        end;
      end;
    end;
  end;

  check:=1;
  tmp:=length(MyArr)-1;
  i := length(MyArr)+length(MyArr)-1;
  while (i >= 1) and (check <= sqr(length(MyArr))) do
  begin
    m:=1;
    while (m <= 2) and (check <= sqr(length(MyArr))) do
    begin
      j:=1;
      while (j <= Length(MyArr)-tmp) and (check <= sqr(length(MyArr))) do
      begin
        inter:=inter+MyArr[x,y];
        case k mod 4 of
          0: inc(y);
          1: dec(x);
          2: dec(y);
          3: inc(x);
        end;
        inc(check);
        inc(j);
      end;
      inc(k);
      inc(m);
    end;
    dec(tmp);
    dec(i);
  end;

  //writeln(inter);
  rewrite(MyFile);
  write(MyFile, inter);
  closefile(MyFile);
end;

procedure CWDecrypt(var MyArr:TArr; var MyFile:TextFile; angle,size:integer);
var
  i,j,m,tmp,check:integer;
  x,y,k:integer;
  inter:char;
begin
  SetLength(MyArr,size,size);
  reset(MyFile);
  case Odd(Length(MyArr)) of
    True:
    begin
      x:=Length(MyArr) div 2;
      y:=x;
      case angle of
        1: k:=2;
        2: k:=3;
        3: k:=1;
        4: k:=0;
      end;
    end;

    False:
    begin
      case angle of
        1:
        begin
          k:=0;
          x:=Length(MyArr) div 2;
          y:=x;
        end;

        2:
        begin
          k:=1;
          x:=(Length(MyArr) div 2) ;
          y:=x-1;
        end;

        3:
        begin
          k:=3;
          x:=(Length(MyArr) div 2)-1;
          y:=x+1;
        end;

        4:
        begin
          k:=2;
          x:=(Length(MyArr) div 2)-1;
          y:=x;
        end;
      end;
    end;
  end;
  check:=1;
  tmp:=length(MyArr)-1;
  i := length(MyArr)+length(MyArr)-1;
  while (i >= 1) and (check <= sqr(length(MyArr))) do
  begin
    m:=1;
    while (m <= 2) and (check <= sqr(length(MyArr))) do
    begin
      j:=1;
      while (j <= Length(MyArr)-tmp) and (check <= sqr(length(MyArr))) do
      begin
        read(MyFile,inter);
        MyArr[x,y]:=inter;
        case k mod 4 of
          0: dec(y);
          1: dec(x);
          2: inc(y);
          3: inc(x);
        end;
        inc(check);
        inc(j);
      end;
      inc(k);
      inc(m);
    end;
    dec(tmp);
    dec(i);
  end;
  closefile(MyFile);

end;

procedure ACWDecrypt(var MyArr:TArr; var MyFile:TextFile; angle,size:integer);
var
  i,j,m,tmp,check:integer;
  x,y,k:integer;
  inter:char;
begin
  SetLength(MyArr,size,size);
  reset(MyFile);
  case Odd(Length(MyArr)) of
    True:
    begin
      x:=Length(MyArr) div 2;
      y:=x;
      case angle of
        1: k:=1;
        2: k:=0;
        3: k:=2;
        4: k:=3;
      end;
    end;

    False:
    begin
      case angle of
        1:
        begin
          k:=0;
          x:=Length(MyArr) div 2;
          y:=x;
        end;

        2:
        begin
          k:=1;
          x:=(Length(MyArr) div 2) ;
          y:=x-1;
        end;

        3:
        begin
          k:=3;
          x:=(Length(MyArr) div 2)-1;
          y:=x+1;
        end;

        4:
        begin
          k:=2;
          x:=(Length(MyArr) div 2)-1;
          y:=x;
        end;
      end;
    end;
  end;
  check:=1;
  tmp:=length(MyArr)-1;
  i := length(MyArr)+length(MyArr)-1;
  while (i >= 1) and (check <= sqr(length(MyArr))) do
  begin
    m:=1;
    while (m <= 2) and (check <= sqr(length(MyArr))) do
    begin
      j:=1;
      while (j <= Length(MyArr)-tmp) and (check <= sqr(length(MyArr))) do
      begin
        read(MyFile,inter);
        MyArr[x,y]:=inter;
        case k mod 4 of
          0: inc(y);
          1: dec(x);
          2: dec(y);
          3: inc(x);
        end;
        inc(check);
        inc(j);
      end;
      inc(k);
      inc(m);
    end;
    dec(tmp);
    dec(i);
  end;
  closefile(MyFile);

end;

begin
  writeln('Привет.');
  AssignFile(F,'Encrypt.txt');
  AssignFile(FCr,'CryptParam.dat');
  writeln('Что вы хотите сделать?');
  writeln('1 - шифрование'#13#10'2 - дешифрование');
  repeat
    readln(choose);
  until choose in ['1','2'];

  case choose of
    '1':
    begin
      writeln(#13#10'Зашифрованный текст - в файле "Encrypt.txt"');
      writeln('Файл с названием "Encrypt.txt" будет сохранен в папке с программой.');

      writeln(#13#10'В каком направлении проводить шифрование?');
      writeln('1 - по часовой стрелке');
      writeln('2 - против часовой стрелки');
      //ввод направления
      repeat
        readln(dir);
      until dir in ['1','2'];

      writeln(#13#10'В какой угол идти?');
      writeln('1 - правый верхний');
      writeln('2 - правый нижний');
      writeln('3 - левый верхний');
      writeln('4 - левый нижний');
      //ввод угла
      repeat
        readln(angle);
      until angle in ['1'..'4'];
      //ввод текста
      writeln(#13#10'Введите текст:');
      readln(input);

      FillArr(InpArr,input);

      case dir of
        '1': CWEncrypt(InpArr,F,FCr,strtoint(angle));
        '2': ACWEncrypt(InpArr,F,FCr,strtoint(angle));
      end;
      writeln('Зашифровано.');
    end;

    '2':
    begin
      try
        writeln(#13#10'Текст для дешифрования берется из файла Encrypt.txt');
        Reset(FCr);
        read(FCr,interCr);
        writeln(#13#10'Дешифрованное сообщение: ');
        case interCr.Direct of
          0: ACWDecrypt(InpArr,F,interCr.Angle,interCr.SizeLen);
          1: CWDecrypt(InpArr,F,interCr.Angle,interCr.SizeLen);
        end;
        closefile(FCr);
        writeln(OPDecrypt(InpArr));
      except
        On EInOutError do
          MessageBox(0, PChar('Файла с защифрованным текстом не существует!'#13#10'Для начала зашифруйте что-нибудь!!!!!!!!!!'), 'Ошибка!',MB_ICONERROR+MB_OK+MB_TOPMOST)
        else
          MessageBox(0, PChar('Неизвестная ошибка!'), 'Ошибка!',MB_ICONERROR+MB_OK+MB_TOPMOST)
      end;
    end;
  end;
  writeln('==============================');
  writeln('Нажмите "Enter" для выхода...');
  readln;
end.