[~ SaM ~]

Код:

var
  Form1: TForm1;

const alphabet = 'абвгдеёжзийклмнопрстуфхцчшщъыьэюя1234567890АБВГДЕЁЖЗИКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ ,.;:-+_()!?"№%*/=\|@#$^~`''&abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';

implementation

uses About;

{$R *.dfm} 

//шифрование Вижинера
for i:=0 to memo1.lines.count-1 do
begin
     wifr :=''; wifr2 :='';  klu4 := '';
     wifr := Memo1.Lines[i]; 


   dlina_text := length(Memo1.Lines[i]);     

    kkk := dlina_text div dlina_klu4a + 1;
    for t := 1 to kkk do
         klu4 := klu4 + key;

     for j:=1 to length(wifr) do
  begin
      t:=0;  k:=0;
          for p :=1 to dlina_alphabet do
          	begin
  	  	      if wifr[j] = alphabet[p] then    t := p; 
 		          if klu4[j] = alphabet[p] then   k := p;    
            end;

         w := (t + k) mod dlina_alphabet; 

     if w = 0 then w := dlina_alphabet;

           jj:=1;

h:       if jj <= dlina_alphabet then
           begin
             if w = jj then
                    begin wifr2 := wifr2 + alphabet[jj];
                         goto h1;
                    end
              else
                 jj:=jj+1;
                 goto h;
          end;
h1:  ;
  end;
  Memo1.Lines[i] := wifr2; 
end;
    memo2.Clear;
    Memo2.Lines.Add(Memo1.Lines.GetText);
end;

//расшифрование текста

Код:

procedure TForm1.Button4Click(Sender: TObject);
      label h, h1;
  Var
                    key, wifr,wifr2, klu4 : String;
                  kkk, w, t, k, jj, i, j,p : integer;
 dlina_klu4a, dlina_text, dlina_alphabet : integer;

begin

for i:=0 to memo1.lines.count-1 do
begin
     wifr :=''; wifr2 :='';  klu4 := '';
     wifr := Memo1.Lines[i]; 
     dlina_text := length(wifr);
    kkk := (dlina_text div dlina_klu4a) + 1;
    for t := 1 to kkk do
         klu4 := klu4 + key;
    for j:=1 to length(wifr) do
  begin
      t:=0; k:=0;
          for p :=1 to dlina_alphabet do
          	begin
  	  	      if wifr[j] = alphabet[p] then    t := p;
 		          if klu4[j] = alphabet[p] then   k := p;
            end;
    if (t-k) > 0 then
            w := t-k   else  w := (t+dlina_alphabet) - k; 
           jj:=1;
h:       if jj <= dlina_alphabet then
           begin
             if w = jj then
                    begin wifr2 := wifr2 + alphabet[jj];
                         goto h1;
                    end
              else
                 jj:=jj+1;
                 goto h;
          end;
h1:  ;
  end;
      Memo1.Lines[i] := wifr2;
end;
    memo2.Clear;
    Memo2.Lines.Add(Memo1.Lines.GetText);
end;