SHARE
TWEET

Untitled

a guest Sep 14th, 2019 90 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,System.Math, StrUtils;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     edKey: TEdit;
  12.     btnPressEncrypt: TButton;
  13.     chbStolb: TCheckBox;
  14.     chbReshet: TCheckBox;
  15.     chbViginer: TCheckBox;
  16.     mmEncryptText: TMemo;
  17.     btnDeEncrypt: TButton;
  18.     procedure btnPressEncryptClick(Sender: TObject);
  19.     procedure chbStolbClick(Sender: TObject);
  20.     procedure chbReshetClick(Sender: TObject);
  21.     procedure chbViginerClick(Sender: TObject);
  22.     procedure btnDeEncryptClick(Sender: TObject);
  23.   private
  24.     { Private declarations }
  25.   public
  26.     { Public declarations }
  27.   end;
  28.  
  29. var
  30.   Form1: TForm1;
  31.  
  32. implementation
  33. {$R *.dfm}
  34. type
  35.     TMatr = array [1..4] of array [1..4] of integer;
  36. const
  37.   Alphabet : set of char = ['A'..'Z',' '];
  38.  
  39. procedure ColumnProc(key: string; var mmEncryptText:TMemo; flag: boolean);
  40. const
  41.   Alphabet : set of char = ['A'..'Z'];
  42. var
  43.   chiphertext, dechiphertext, keybuff, text ,temp: string;
  44.   min : char;
  45.   colCount, i, j,k, minpos,m,rowcount: integer;
  46.   Myfile: TextFile;
  47. begin
  48.  
  49.   key := UpperCase(key);
  50.   keybuff := key;
  51.   if flag then begin
  52.   mmEncryptText.Lines.Clear;
  53.   AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\stolbсifer.txt');
  54.   Reset(myFile);
  55.   text:='';
  56.   while not EOF(myFile) do begin
  57.     readln(myFile,temp);
  58.     text:=text+temp;
  59.   end;
  60.   closeFile(myFile);
  61.  
  62.   text := UpperCase(text);
  63.   text:= trim(text);
  64.  
  65.   i := 1;
  66.   while (i<= length(text)) do
  67.   begin
  68.     if not(text[i] in Alphabet) then
  69.     begin
  70.       delete(text,i,1);
  71.       dec(i);
  72.     end;
  73.     inc(i);
  74.   end;
  75.   mmEncryptText.Lines.Add('Текст: '+text);
  76.   mmEncryptText.Lines.Add('-------------------------');
  77.   mmEncryptText.Lines.Add('Ключ: '+key);
  78.   mmEncryptText.Lines.Add('-------------------------');
  79.   colcount := length(key);
  80.  
  81.   while (length(text)mod length(key)<>0) do
  82.     text := text + ' ';
  83.   rowcount := ceil(length(text)/length(key));
  84.  
  85.   chiphertext := '';
  86.   for k := 1 to length(key) do
  87.    begin
  88.  
  89.       min := key[1];
  90.       minpos := 1;
  91.       for j := 2 to length(key) do
  92.       begin
  93.         if min > key[j] then
  94.         begin
  95.           min := key[j];
  96.           minpos := j;
  97.         end;
  98.       end;
  99.       key[minpos] := '_';
  100.       i := minpos;
  101.  
  102.       while (i<= length(text)) do
  103.       begin
  104.         if text[i] = ' ' then begin
  105.           inc(i,length(key));
  106.           continue;
  107.         end;
  108.  
  109.         chiphertext := chiphertext + text[i];
  110.         inc(i,length(key));
  111.       end;
  112.    end;
  113.  
  114.   mmEncryptText.Lines.Add('Шифротекст: '+chiphertext);
  115.   AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\stolbсiferCIFER.txt');
  116.   Rewrite(myFile);
  117.     writeln(myFile,chiphertext);
  118.   closeFile(myFile);
  119.  
  120. end;
  121.  
  122.   if not (flag) then begin
  123.   AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\stolbсiferCIFER.txt');
  124.   Reset(myFile);
  125.     readln(myFile,chiphertext);
  126.   closeFile(myFile);
  127.  
  128.   text := '';
  129.   SetLength(dechiphertext, length(chiphertext));
  130.   for i := 1 to length(chiphertext) do
  131.     dechiphertext[i] := ' ';
  132.    m :=1;
  133.    for k := 1 to length(keybuff) do
  134.    begin
  135.       min := keybuff[1];
  136.       minpos := 1;
  137.       for j := 2 to length(keybuff) do
  138.       begin
  139.         if min > keybuff[j] then
  140.         begin
  141.           min := keybuff[j];
  142.           minpos := j;
  143.         end;
  144.       end;
  145.       keybuff[minpos] := '_';
  146.       i := minpos;
  147.       while (i<= length(chiphertext)) do
  148.       begin
  149.         dechiphertext[i] := chiphertext[m];
  150.         inc(i,length(key));
  151.         inc(m);
  152.       end;
  153.    end;
  154.  
  155.   mmEncryptText.Lines.Add('-------------------------');
  156.   mmEncryptText.Lines.Add('Дешифротекст: '+dechiphertext);
  157.  
  158.   AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\stolbсiferDECIFER.txt');
  159.   Rewrite(myFile);
  160.     writeln(myFile,dechiphertext);
  161.   closeFile(myFile);
  162.   end;
  163. end;
  164.  
  165. procedure MatrRotate(var Matr :TMatr);
  166.  var
  167.     i,j, buff : integer;
  168.  begin
  169.    for i := 1 to 4 do
  170.    begin
  171.      for j:= i to 4 do
  172.      begin
  173.        if (i+j) mod 2 = 1 then
  174.        begin
  175.          buff := Matr[i,j];
  176.          Matr[i,j] := Matr[j,i];
  177.          Matr[j,i] := buff;
  178.        end;
  179.  
  180.  
  181.      end;
  182.  
  183.    end;
  184.  
  185.    for j := 1 to 4 do
  186.    begin
  187.      buff := Matr[j,1];
  188.      Matr[j,1] := Matr[j,4];
  189.      Matr[j,4] := buff;
  190.      buff := Matr[j,2];
  191.      Matr[j,2] := Matr[j,3];
  192.      Matr[j,3] := buff;
  193.    end;
  194.  end;
  195.  
  196.  function KardanoMatr( var text : string):string;
  197.  var
  198.   i,j, k,m,lastind : integer;
  199.   matr : Tmatr ;
  200.   textpart,resultpart : string;
  201.  begin
  202.   SetLength(result, length(text));
  203.   for i := 1 to length(text) do
  204.     result[i] := ' ';
  205.  
  206.   for i := 1 to 4 do
  207.     for j := 1 to 4 do
  208.       Matr[i,j]:=0;
  209.   Matr[1,1] := 1;
  210.   Matr[2,4] := 1;
  211.   Matr[3,3] := 1;
  212.   Matr[4,2] := 1;
  213.  
  214.    m:=1;
  215.    while (m <= length(text))  do
  216.    begin
  217.     if m+16 > length(text) then
  218.     begin
  219.         lastind := length(text);
  220.         SetLength(textpart,lastind-m);
  221.         SetLength(resultpart,lastind-m);
  222.     end
  223.     else
  224.     begin
  225.      lastind := m+16;
  226.      SetLength(textpart,16);
  227.      SetLength(resultpart,16);
  228.     end;
  229.  
  230.      for j := m to lastind do
  231.        textpart[j-m+1] := text[j];
  232.  
  233.      k:= 1;
  234.      while (k < 16) do
  235.      begin
  236.        for  i:= 1 to 4 do
  237.        begin
  238.          for j := 1 to 4 do
  239.          begin
  240.            if Matr[i,j] =1  then
  241.            begin
  242.              resultpart[j+(i-1)*4]:=textpart[k];
  243.              inc(k);
  244.            end;
  245.          end;
  246.        end;
  247.        MatrRotate(matr);
  248.      end;
  249.  
  250.      for k := m to m+15 do
  251.       result[k] := resultpart[k-m+1];
  252.  
  253.      inc(m,16);
  254.  
  255.    end;
  256.  
  257.  end;
  258.  
  259.  function DeKardanoMatr( var chiphertext : string):string;
  260.  var
  261.   i,j, k,m,lastind : integer;
  262.   matr : Tmatr ;
  263.   textpart,resultpart : string;
  264.  begin
  265.   SetLength(result, length(chiphertext));
  266.   for i := 1 to length(chiphertext) do
  267.     result[i] := ' ';
  268.  
  269.   for i := 1 to 4 do
  270.     for j := 1 to 4 do
  271.       Matr[i,j]:=0;
  272.   Matr[1,1] := 1;
  273.   Matr[2,4] := 1;
  274.   Matr[3,3] := 1;
  275.   Matr[4,2] := 1;
  276.  
  277.    m:=1;
  278.    while (m <= length(chiphertext))  do
  279.    begin
  280.     if m+16 > length(chiphertext) then
  281.     begin
  282.         lastind := length(chiphertext);
  283.         SetLength(textpart,lastind-m);
  284.         SetLength(resultpart,lastind-m);
  285.     end
  286.     else
  287.     begin
  288.      lastind := m+16;
  289.      SetLength(textpart,16);
  290.      SetLength(resultpart,16);
  291.     end;
  292.  
  293.      for j := m to lastind do
  294.        textpart[j-m+1] := chiphertext[j];
  295.  
  296.      k:= 1;
  297.      while (k < 16) do
  298.      begin
  299.        for  i:= 1 to 4 do
  300.        begin
  301.          for j := 1 to 4 do
  302.          begin
  303.            if Matr[i,j] =1  then
  304.            begin
  305.              resultpart[k]:=textpart[j+(i-1)*4];
  306.              inc(k);
  307.            end;
  308.          end;
  309.        end;
  310.        MatrRotate(matr);
  311.      end;
  312.  
  313.      for k := m to m+15 do
  314.       result[k] := resultpart[k-m+1];
  315.  
  316.      inc(m,16);
  317.  
  318.    end;
  319.  
  320.  end;
  321.  
  322. const
  323.   Alphabet1 : set of char = ['A'..'Z',' '];
  324.  
  325. procedure GridProc(var mmEncryptText:TMemo);
  326. var
  327.   chiphertext, dechiphertext,text : string;
  328.   colCount, i, j,k, minpos,m,rowcount: integer;
  329.   MATR : TMATR;
  330.   myFile: TextFile;
  331. begin
  332.   mmEncryptText.Lines.Clear;
  333.   AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\gridbсifer.txt');
  334.   Reset(myFile);
  335.     readln(myFile,text);
  336.   closeFile(myFile);
  337.  
  338.   text := UpperCase(text);
  339.   i := 1;
  340.  
  341.   while (i<= length(text)) do
  342.   begin
  343.     if not(text[i] in Alphabet) then
  344.     begin
  345.       delete(text,i,1);
  346.       dec(i);
  347.     end;
  348.     inc(i);
  349.   end;
  350.  
  351.   text:=trim(text);
  352.  
  353.   while (length(text)mod 16 <> 0) do
  354.     text := text+' ';
  355.  
  356.   mmEnCryptText.Lines.Add('Исходный текст: '+text);
  357.   SetLength(chiphertext, length(text));
  358.  
  359.   chiphertext := KardanoMatr(text);
  360.   mmEnCryptText.Lines.Add('--------------------');
  361.   mmEnCryptText.Lines.Add('Зашифрованный текст: '+chiphertext);
  362.  
  363.   AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\gridbсiferCIFER.txt');
  364.   Rewrite(myFile);
  365.     writeln(myFile,chiphertext);
  366.   closeFile(myFile);
  367.  
  368.   dechiphertext := DeKardanoMatr(chiphertext);
  369.   mmEnCryptText.Lines.Add('--------------------');
  370.   mmEnCryptText.Lines.Add('Расшифрованный текст: '+dechiphertext);
  371.  
  372.   AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\gridbсiferDECIFER.txt');
  373.   Rewrite(myFile);
  374.     writeln(myFile,dechiphertext);
  375.   closeFile(myFile);
  376.  
  377. end;
  378.  
  379. procedure ViginerProc(key: string; var mmEncryptText:TMemo;flag: boolean);
  380. var
  381.   myFile: TextFile;
  382.   chiphertext, dechiphertext,text,long_key,RusAlph,yo,temp: string;
  383.   i,j,ind: Integer;
  384.   flagpos: boolean;
  385. begin
  386. AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\viginer.txt');
  387.   Reset(myFile);
  388.   while not(EOF(myfile)) do begin
  389.     readln(myFile,temp);
  390.     text:=text+temp;
  391.   end;
  392.   closeFile(myFile);
  393.  
  394.   RusAlph := 'АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ';
  395.   //ShowMessage(IntToStr(ord('ё')-ord('а')));
  396.   text:=AnsiUpperCase(text);
  397.   i := 1;
  398.   yo:='ё';
  399.   while (i<= length(text)) do
  400.   begin
  401.     if not( (text[i] >= AnsiUpperCase('а')) and (text[i] <= AnsiUpperCase('я') ) or (text[i] = AnsiUpperCase('ё')) ) then
  402.     begin
  403.  
  404.       delete(text,i,1);
  405.       dec(i);
  406.     end;
  407.     inc(i);
  408.   end;
  409.   j:=0;
  410.   long_key:=key;
  411.  
  412.   for i := length(key)+1 to length(text) do begin
  413.     if j = length(text) then j:=0;
  414.     long_key:=long_key+text[j+1];
  415.     inc(j);
  416.   end;
  417.   mmEncryptText.Lines.Add('Текст: '+text);
  418.   mmEncryptText.Lines.Add('-----------------');
  419.   mmEncryptText.Lines.Add('Ключ: '+long_key);
  420.   mmEncryptText.Lines.Add('-----------------');
  421.  
  422. if flag then begin
  423.  
  424.   mmEncryptText.Lines.Clear;
  425.  
  426.   chiphertext := '';
  427.   ind:=0;
  428.   {for i := 1 to length(text) do begin
  429.     if (AnsiUpperCase(text[i]) = AnsiUpperCase(yo)) then
  430.       chiphertext:=chiphertext+AnsiUpperCase(text[i])
  431.     else begin
  432.     ind:= (ord(text[i])+ord(long_key[i]))mod 32;
  433.     chiphertext:=chiphertext+RusAlph[ind+1];
  434.     end;
  435.   end;}
  436.  
  437.   for i := 1 to length(text) do begin
  438.     ind:= (pos(text[i],RusAlph)+pos(long_key[i],RusAlph));
  439.  
  440.     if (ind=34) then begin
  441.     dec(ind,2);
  442.     flagpos:=true;
  443.     end;
  444.  
  445.     if not(flagpos) then chiphertext:=chiphertext+RusAlph[(ind-1) mod 33]
  446.     else if flagpos then chiphertext:=chiphertext+RusAlph[(ind-1) mod 33+2]
  447.  
  448.  
  449.   end;
  450.  
  451.   //ShowMessage(IntToStr((21+13) mod 33));
  452.  
  453.   mmEncryptText.Lines.Add('Шифротекст: '+chiphertext);
  454.   mmEncryptText.Lines.Add('-----------------');
  455.  
  456.   AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\viginerCIFER.txt');
  457.   Rewrite(myFile);
  458.     writeln(myFile,chiphertext);
  459.   closeFile(myFile);
  460. end;
  461.  
  462. if not(flag) then begin
  463.   AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\viginerCIFER.txt');
  464.   Reset(myFile);
  465.     readln(myFile,chiphertext);
  466.   closeFile(myFile);
  467.   ind:=0;
  468.   dechiphertext:='';
  469.   {for i := 1 to length(text) do begin
  470.     if (AnsiUpperCase(text[i]) = AnsiUpperCase(yo)) then
  471.       dechiphertext:=dechiphertext+AnsiUpperCase(text[i])
  472.     else begin
  473.       ind:=(ord(chiphertext[i])+33-ord(long_key[i]) ) mod 32;
  474.       dechiphertext:=dechiphertext+RusAlph[ind];
  475.     end;
  476.   end;}
  477.  
  478.   for i := 1 to length(text) do begin
  479.       ind:=(pos(chiphertext[i],RusAlph)+33-pos(long_key[i],RusAlph) ) mod 33;
  480.       dechiphertext:=dechiphertext+RusAlph[ind+1];
  481.   end;
  482.  
  483.  
  484.   mmEncryptText.Lines.Add('Дешифротекст: '+dechiphertext);
  485.  
  486.   AssignFile(myFile, 'D:\Embarcadero\projects\TI_1\textfiles\viginerDECIFER.txt');
  487.   Rewrite(myFile);
  488.     writeln(myFile,dechiphertext);
  489.   closeFile(myFile);
  490. end;
  491.  
  492. end;
  493.  
  494. procedure TForm1.btnDeEncryptClick(Sender: TObject);
  495. var
  496. i: integer;
  497. key: string;
  498. letter_a, letter_ya: string;
  499. flag: boolean;
  500. begin
  501.   flag:=false;
  502.   if chbStolb.Checked then begin
  503.     key:=edKey.Text;
  504.     key := UpperCase(key);
  505.     i:=1;
  506.  
  507.       while (i<= length(key)) do begin
  508.         if not(key[i] in Alphabet1) then begin
  509.           delete(key,i,1);
  510.           dec(i);
  511.         end;
  512.  
  513.         inc(i);
  514.       end;
  515.  
  516.       if key = '' then ShowMessage('Неверный ключ, введите заного!')
  517.       else ColumnProc(trim(key),mmEncryptText,flag);
  518.   end
  519.   else if chbReshet.Checked then GridProc(mmEncryptText)
  520.  
  521.   else if chbViginer.Checked then begin
  522.     key:=edKey.Text;
  523.     key := AnsiUpperCase(key);
  524.  
  525.     i:=1;
  526.       while (i<= length(key)) do begin
  527.         if not((key[i] >= AnsiUpperCase('а')) and (key[i] <= AnsiUpperCase('я')) or (key[i] = AnsiUpperCase('ё')) ) then begin
  528.           delete(key,i,1);
  529.           dec(i);
  530.         end;
  531.  
  532.         inc(i);
  533.       end;
  534.       if key = '' then ShowMessage('Неверный ключ, введите заного!')
  535.       else ViginerProc(trim(key),mmEncryptText,flag);
  536.   end;
  537.  
  538. end;
  539.  
  540. procedure TForm1.btnPressEncryptClick(Sender: TObject);
  541. var
  542. i: integer;
  543. key: string;
  544. letter_a, letter_ya: string;
  545. flag: boolean;
  546. begin
  547.   flag:=true;
  548.   if chbStolb.Checked then begin
  549.     key:=edKey.Text;
  550.     key := UpperCase(key);
  551.     i:=1;
  552.  
  553.       while (i<= length(key)) do begin
  554.         if not(key[i] in Alphabet1) then begin
  555.           delete(key,i,1);
  556.           dec(i);
  557.         end;
  558.  
  559.         inc(i);
  560.       end;
  561.  
  562.       if key = '' then ShowMessage('Неверный ключ, введите заного!')
  563.       else ColumnProc(trim(key),mmEncryptText,flag);
  564.   end
  565.   else if chbReshet.Checked then GridProc(mmEncryptText)
  566.  
  567.   else if chbViginer.Checked then begin
  568.     key:=edKey.Text;
  569.     key := AnsiUpperCase(key);
  570.  
  571.     i:=1;
  572.       while (i<= length(key)) do begin
  573.         if not((key[i] >= AnsiUpperCase('а')) and (key[i] <= AnsiUpperCase('я')) or (key[i] = AnsiUpperCase('ё')) ) then begin
  574.           delete(key,i,1);
  575.           dec(i);
  576.         end;
  577.  
  578.         inc(i);
  579.       end;
  580.       if key = '' then ShowMessage('Неверный ключ, введите заного!')
  581.       else ViginerProc(trim(key),mmEncryptText,flag);
  582.   end;
  583.  
  584. end;
  585.  
  586. procedure TForm1.chbReshetClick(Sender: TObject);
  587. begin
  588.   chbStolb.Checked:=false;
  589.   chbViginer.Checked:=false;
  590. end;
  591.  
  592. procedure TForm1.chbStolbClick(Sender: TObject);
  593. begin
  594.   chbReshet.Checked:= false;
  595.   chbViginer.Checked:=false;
  596. end;
  597.  
  598. procedure TForm1.chbViginerClick(Sender: TObject);
  599. begin
  600.   chbStolb.Checked:=false;
  601.   chbReshet.Checked:=false;
  602. end;
  603.  
  604. end.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!
 
Top