Гибридная система шифрования (ГСШ-11)

                      j:=j div 2;

                      End

         Else if j=1 then

                      Begin

                      Z[i]:=1;

                      j:=0;

                      End

           Else Z[i]:=0;

      If k>1 then Begin

                      key[i]:=k mod 2;

                      k:=k div 2;

                      End

         Else if k=1 then

                      Begin

                      key[i]:=1;

                      k:=0;

                      End

           Else key[i]:=0;

    End;

End; 

Procedure TForm1.Posl;//Формирование  псевдослуч. посл-ти

Var Q: array of byte;

    k:Byte;

    j,i:Integer;

Begin

  Setlength(Q,Length(Z));

  Setlength(C,Trunc(IntPower(2,Length(Z))));

  For j:=0 to Length(Z)-1 do

     Q[j]:=key[j];

  j:=0;

  While j<Trunc(IntPower(2,Length(Z))) do

  Begin

    i:=High(Z);

    p:=Q[i];

  While i>0 do

    Begin

      If Z[i-1]=1 then p:=p xor q[i-1];

      i:=i-1;

    End;

    C[j]:=Q[High(Q)];

  For k:=High(Q) downto 1 do

        Q[k]:=Q[k-1];

    Q[0]:=p;

    p:=0;

  For k:=0 to High(Q) do

        If Q[k]=key[k] then p:=p+1;

     If p=Length(Q) then Begin

                         p:=j;

                         j:=Trunc(IntPower(2,Length(Z)));

                         End

                    else j:=j+1;

  End;

  Label2.Caption:='Длина последовательности='+IntToStr(p);

End; 

Procedure TForm1.SymvToBit(cq:char);//Преобразования символа в бит.посл-ть

Var k,j:Byte;

Begin

  j:=ord(cq);//символ переводится в его порядковый № в таблице символов

  For k:=7 downto 0 do

    Begin

      If j>1 then Begin

                      T[k]:=j mod 2;

                      j:=j div 2;

                      End

         Else if j=1 then

                      Begin

                      T[k]:=1;

                      j:=0;

                      End

           Else T[k]:=0;

    End;

End; 

Function TForm1.CodeToSymv: integer; //Преобразование кода в символ

Var k:Byte;

    Z,i:Integer;

Begin

Z:=0;

  For k:=0 to 7 do

      Z:=Z+T[k]*Trunc(IntPower(2,7-k));

CodeToSymv:=Z;

End; 

procedure TForm1.Button7Click(Sender: TObject);    //2z

Var    Ch:Char;

begin

  memo2.Text:='';

  memo3.Text:='';

  If OpenDialog1.Execute then

  Begin

  AssignFile(F,OpenDialog1.FileName);

  FName:=OpenDialog1.FileName;

  Reset(F);

  If IOResult=0 then Begin

    While not Eof(f) do

      Begin

        Read(F,Ch);

        Memo2.Text:=Memo2.Text+Ch;

      End;

    CloseFile(F);

                     End;

  End;

end; 

procedure TForm1.Button8Click(Sender: TObject); //Шифрование S

Var conf,c0:LongInt;

    n:Byte;

    k:Longword;

    j,l:Word;

    i:byte;

begin

   conf:=1362;

   c0:=834;

   n:=14;

NachC(conf,c0,n);

Posl;

  Setlength(T,8);

  j:=0;

  Memo1.Text:='';

  For k:=1 to Length(Memo2.Text) do

    Begin

      SymvToBit(Memo2.Text[k]);

      If j<p-1 then For l:=0 to 7 do

                      Begin

                       T[l]:=C[j] xor T[l];

                       j:=j+1;

                      End

         Else

               Begin

               T[l]:=C[j] xor T[l];

               j:=0;

               End;

      Memo1.Text:=Memo1.Text+char(CodeToSymv);

    End;

end; 

procedure TForm1.Button2Click(Sender: TObject); //2s

begin

  FName:='Полиалфиват';

  SaveDialog1.FileName:=Fname;

  If SaveDialog1.Execute then Fname:=SaveDialog1.FileName;

  Memo2.Lines.SaveToFile(FName);

End; 

procedure TForm1.Button6Click(Sender: TObject);  //3s

begin

  FName:='шифр-текст';

  SaveDialog1.FileName:=Fname;

  If SaveDialog1.Execute then Fname:=SaveDialog1.FileName;

  Memo3.Lines.SaveToFile(FName);

end; 

procedure TForm1.Button9Click(Sender: TObject); //Дешифрование S

Var conf,c0:LongInt;

    n:Byte;

    k:Longword;

    j,l:Word;

    i:byte;

begin

   conf:=1362;

   c0:=834;

   n:=14;

NachC(conf,c0,n);

     Posl;

  Setlength(T,8);

  j:=0;

  Memo3.Text:='';

  For k:=1 to Length(Memo2.Text) do

    Begin

      SymvToBit(Memo2.Text[k]);

      If j<p-1 then For l:=0 to 7 do

                      Begin

                       T[l]:=C[j] xor T[l];

                       j:=j+1;

                      End

         Else

               Begin

               T[l]:=C[j] xor T[l];

               j:=0;

               End;

      Memo3.Text:=Memo3.Text+char(CodeToSymv);

    End;

end; 

procedure TForm1.Button10Click(Sender: TObject);

begin

Memo1.Text:=Memo3.Text;

Memo2.Text:='';

Memo3.Text:='';

end; 

procedure TForm1.Button11Click(Sender: TObject);//Новые параметры

begin

   s:='';

   Memo1.Text:='';

   Memo2.Text:='';

   Memo3.Text:='';

   Label3.Visible:=False;

   Label1.Visible:=False;

   Button4.Visible:=False;

   Button1.Visible:=False;

   Button9.Visible:=False;

   Button8.Visible:=False; 

end; 

procedure TForm1.BitBtn1Click(Sender: TObject);

begin

  Label3.Visible:=False;

  Label1.Visible:=True;

  Button4.Visible:=False;

  Button1.Visible:=True ;

  Button9.Visible:=False;

  Button8.Visible:=True ;

end; 

procedure TForm1.BitBtn2Click(Sender: TObject);

begin

  Label1.Visible:=False;

  Label3.Visible:=True;

  Button1.Visible:=False;

  Button4.Visible:=True;

  Button8.Visible:=False;

  Button9.Visible:=True ;

end; 

procedure TForm1.BitBtn3Click(Sender: TObject);

begin

  close

end; 

procedure TForm1.BitBtn4Click(Sender: TObject);

Var u:Integer;

begin

LabeledEdit1.Visible:=True;

u:=0;

s :=LabeledEdit1.Text;

while u=0 do

begin

if Length(s)<>8 then

begin

MessageDlg('Длина ключа должна равняться 8! ', mtWarning, [mbOK], 0);

s := InputBox('Метод полиалфавитной замены','Попробуйте еще раз','');

end

else u:=u+1;

end;

BitBtn4.Visible:=False;

LabeledEdit1.Visible:=False;

Zashifr;

end; 

procedure TForm1.Button12Click(Sender: TObject);

Var u:Integer;

begin

u:=0;

s :=LabeledEdit1.Text;

while u=0 do

begin

if Length(s)<>8 then

begin

MessageDlg('Длина  ключа должна равняться 8!', mtWarning, [mbOK], 0);

s := InputBox('Метод полиалфавитной замены','Попробуйте еще раз','');