Шифр Виженера в Delphi

Шифр Виженера в Delphi


Шифр Виженера (фр. Chiffre de Vigenère) — метод полиалфавитного шифрования буквенного текста с использованием ключевого слова.

Этот метод является простой формой многоалфавитной замены. Шифр Виженера изобретался многократно. Впервые этот метод описал Джован Баттиста Беллазо (итал. Giovan Battista Bellaso) в книге La cifra del. Sig. Giovan Battista Bellasо в 1553 году, однако в XIX веке получил имя Блеза Виженера, французского дипломата. Метод прост для понимания и реализации, он является недоступным для простых методов криптоанализа.







Использование "таблицы Виженера”, которая представляет собой квадратную таблицу с числом строк и столбцов равным количеству букв алфавита. Чтобы зашифровать какое-либо сообщение выбирают слово - лозунг (например, "монастырь”) и надписывают его над сообщением с необходимым повторением.
Чтобы получить шифрованный текст, находят очередной знак лозунга, начиная с первого в вертикальном алфавите, а ему соответствующий знак сообщения в горизонтальном алфавите. На пересечении выделенных столбца и строки находим первую букву шифра. Очевидно, что ключом к такому шифру является используемый лозунг.



Лозунг: м о н а с т ы р ь м о н а с т ы р ь м о н
Исходный текст: р а с к и н у л о с ь м о р е ш и р о к о
Шифротекст: э о я к щ а п ы й ю й щ о в ч ф ш л ь ш ы

Таблица Виженера
А Б В Г Д Е Ж З И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я
Б В Г Д Е Ж З И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я А
В Г Д Е Ж З И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я А Б
Г Д Е Ж З И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я А Б В
Д Е Ж З И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я А Б В Г
Е Ж З И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я А Б В Г Д
Ж З И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я А Б В Г Д Е
З И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я А Б В Г Д Е Ж
И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я А Б В Г Д Е Ж З
Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я А Б В Г Д Е Ж З И
К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я А Б В Г Д Е Ж З И Й
Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я А Б В Г Д Е Ж З И Й К
М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я А Б В Г Д Е Ж З И Й К Л
Н О П Р С Т У Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я А Б В Г Д Е Ж З И Й К Л М
О П Р С Т У Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я А Б В Г Д Е Ж З И Й К Л М Н
П Р С Т У Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я А Б В Г Д Е Ж З И Й К Л М Н О
Р С Т У Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я А Б В Г Д Е Ж З И Й К Л М Н О П
С Т У Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я А Б В Г Д Е Ж З И Й К Л М Н О П Р
Т У Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я А Б В Г Д Е Ж З И Й К Л М Н О П Р С
У Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я А Б В Г Д Е Ж З И Й К Л М Н О П Р С Т
Ф Х Ц Ч Ш Щ Ь Ы Э Ю Я А Б В Г Д Е Ж З И Й К Л М Н О П Р С Т У
Х Ц Ч Ш Щ Ь Ы Э Ю Я А Б В Г Д Е Ж З И Й К Л М Н О П Р С Т У Ф
Ц Ч Ш Щ Ь Ы Э Ю Я А Б В Г Д Е Ж З И Й К Л М Н О П Р С Т У Ф Х
Ч Ш Щ Ь Ы Э Ю Я А Б В Г Д Е Ж З И Й К Л М Н О П Р С Т У Ф Х Ц
Ш Щ Ь Ы Э Ю Я А Б В Г Д Е Ж З И Й К Л М Н О П Р С Т У Ф Х Ц Ч
Щ Ь Ы Э Ю Я А Б В Г Д Е Ж З И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш
Ь Ы Э Ю Я А Б В Г Д Е Ж З И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ
Ы Э Ю Я А Б В Г Д Е Ж З И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ь
Э Ю Я А Б В Г Д Е Ж З И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ь Ы
Ю Я А Б В Г Д Е Ж З И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ь Ы Э
Я А Б В Г Д Е Ж З И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ь Ы Э Ю




Итак, вот краткое описание функций программы:


1) Шифрование русскоязычных текстов; 

2) Взлом русскоязычных текстов методом МНК(метод наименьших вадратов):

3) Вывод на экран ключевого слова в случае взлома;

4) Результат выводится на экран группами по 6 символов;

5) Все символы, отличные от букв, программа игнорирует, кроме того, все символы принудительно переводятся в верхний регистр;

6) Предусмотрена защита foolproof.


Исходники можно найти тут:
depositfiles.com
letitbit.net


Вот небольшое задание для взлома:
depositfiles.com
letitbit.net


Ниже приведу полный код программы на Delphi в среде Developer Studio 2006:


unit Unit1; // реализация метода виженера

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Grids, math, ExtCtrls;// подключаемые модули

type
TForm1 = class(TForm) // форма
Edit1: TEdit; // ключ
Button1: TButton; // шифровать
Button2: TButton; // дешифровать
Button3: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Memo1: TMemo;
Memo2: TMemo;
Button5: TButton;
Button6: TButton; // взлом
Label4: TLabel;
Edit2: TEdit;
Label5: TLabel;
Label6: TLabel;
procedure FormCreate(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure Button5Click(Sender: TObject);

private
{ Private declarations }
SaveWindowProc: TWndMethod;
public
procedure TEditWindowProc(var Message: TMessage);
{ Public declarations }
end;

var
Form1: TForm1;
trs,trb:array [0..31] of char;
frs,frst:array [0..31] of real; // массивы частот
vig:array [1..32] of string; // таблица виженера

implementation
//Шифрование Виженера
function Viz_Crypt(s,key:string):string;
const
SizeA = 32; //Размер алфавита
RusA = 'абвгдежзийклмнопрстуфхцчшщъыьэюя'; //Алфавит
var i, P, t :integer;
temp:string;
begin
s:=AnsiLowerCase(s); // Нижний регистр
key:=AnsiLowerCase(key);
t:=0; // Символ ключа
for i := 1 to length(s) do // Удаляем посторонние символы
if pos(s[i],RusA)<>0 then // ищем русские буквы
temp:=temp+s[i];
s:=temp;
for i:=1 to length(s) do
begin
inc(t); // Увеличиваем на 1
if t>length(key) then t:=1; // распространяем ключ по тексту
P:=pos(s[i],RusA)+pos(key[t],RusA);//Ищем новую позицию
P:=P-1;
if P>SizeA then P:=P-SizeA; // Если больше 33
Result:=Result+RusA[P]; // Получаем шифрованный текст
end;
end;

//Дешифрование Виженера
function Viz_DeCrypt(s,key:string):string;
const
SizeA = 32; //Размер алфавита
RusA = 'абвгдежзийклмнопрстуфхцчшщъыьэюя'; //Алфавит
var i, P, t :integer;
temp:string;
begin
s:=AnsilowerCase(s); // нижний регистр
key:=AnsilowerCase(key);
t:=0;
for i := 1 to length(s) do // Удаляем посторонние символы
if pos(s[i],RusA)<>0 then // ищем русские буквы
temp:=temp+s[i];
s:=temp;
for i:=1 to length(s) do
begin
inc(t); // увеличиваем на 1
if t>length(key) then t:=1;
P:=pos(s[i],RusA)-pos(key[t],RusA);// поиск новой позиции
P:=P+1;
if P<=0 then P:=P+SizeA; // если больше 33
Result:=Result+RusA[P]; // получаем расшифрованный текст
end;
end;

//функция возвращает наибольший общий делитель двух чисел
function nod(a,b:longint):longint;
begin
while (a<>0) and (b<>0) do
if a>=b then a:=a mod b // mod возвращает остаток от
else b:=b mod a; // целочисленного деления
nod:=a+b; // получаем НОД
end;

//функция сдвига символа. Ей передается алфавит, символ и величина сдвига
function kod(alphabet:array of char;char:char;displacement:integer):char;
var i:integer;
begin
Result:=char;
for i:=0 to high(alphabet) do //по каждому символу алфавита
begin
if char=alphabet[i] then //если переданный символ является i-символом алфавита
begin
kod:=alphabet[(i+displacement) mod length(alphabet)]; //то результат функции - сдвиг этого символа
break;
end;
end;
end;

//функция получения величины сдвига путем анализа частот встречаемости букв
function getkey(text:string;alphabet:array of char;frequencies:array of real):integer;
var i,j:integer; textfr:array of integer; tt:array of double;
begin
Result:=0;
setlength(textfr,length(frequencies)); // заполняем массив частот
setlength(tt,length(alphabet)); // заполняем массив алфавитом
for i:=1 to length(text) do //считаем количество каждой буквы в тексте
for j:=0 to high(alphabet) do // для каждой буквы
if text[i]=alphabet[j] then textfr[j]:=textfr[j]+1; // количество букв в тексте
for i:=0 to high(alphabet) do //для каждой буквы
begin
tt[i]:=0; // массив наименьших квадратов
for j:=0 to high(alphabet) do //считаем столько сумм, сколько букв в алфавите
begin
tt[i]:=tt[i]+sqr(frequencies[j]-textfr[(i+j+1) mod 32]); //сумма - это сумма квадратов разностей между частотой встречаемости...
end; //...1..32 буквы языка и количеством в тексте (1..32)+номер суммы буквы шифротекста
end;
for i:=0 to high(tt) do
if tt[i]=minvalue(tt) then getkey:=31-i; //величина сдвига=длина алфавита-номер минимальной суммы.
end;

//функция удаления из строки небуквенных символов. строчные буквы возвращаются прописными
function probely(s:string;b:byte):string;
var i,g:integer;
begin
i:=0;
g:=length(s);
s:=ansiuppercase(s); // верхний регистр
repeat
inc(i); // увеличиваем на 1
if not (s[i] in ['А'..'Я']) then // если не соответствует сиволу
begin // русского алфавита, то
delete(s,i,1); // удаляем
dec(i); // на символ назад
dec(g); // т.к. удаляем сиволы, то уменьшается дляна текста
end
until i=g; // количество русских символов равно длине текста
probely:=s; // а пока i не равно g повторяем нашу функцию
end;
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject); // шифровать
var
obr:string;
gr:integer;
begin
if memo1.Text='' then // если текст пустой
begin
showmessage('Введите текст для шифровки');
abort;
end;
if edit1.Text='' then // если ключ пустой
begin
showmessage('Введите текст ключа');
abort;
end;
memo1.Text:=StringReplace(Memo1.Text,'ё','е',[rfReplaceAll]);// заменяем ё на е
memo1.Text:=StringReplace(Memo1.Text,'Ё','Е',[rfReplaceAll]);// заменяем Ё на Е
memo2.Text:=Viz_Crypt(memo1.Text,edit1.Text);//выполнить функцию шифрования
obr:=memo2.text;// делим обработанный текст на группы символов
gr:=0;
while gr<length(obr) do
begin
gr:=gr+7;
insert(' ',obr,gr);
end;
memo2.Text:=ansiuppercase(obr); // верхний регистр

end;

procedure TForm1.Button2Click(Sender: TObject); // дешифровать
var
obr:string;
gr:integer;
begin
if memo1.Text='' then // если не введен текст
begin
showmessage('Введите текст для расшифровки');
abort;
end;
if edit1.Text='' then // если не введен ключ
begin
showmessage('Введите текст ключа');
abort;
end;
memo1.Text:=StringReplace(Memo1.Text,'ё','е',[rfReplaceAll]);// заменяем ё на е
memo1.Text:=StringReplace(Memo1.Text,'Ё','Е',[rfReplaceAll]);// заменяем Ё на Е
memo2.Text:=Viz_DeCrypt(memo1.Text,edit1.Text); // выполняем функцию дешифрования
obr:=memo2.text;
gr:=0;
while gr<length(obr) do // делим полученный текст на группы
begin
gr:=gr+7;
insert(' ',obr,gr);
end;
memo2.Text:=ansiuppercase(obr); // переводим в регистр (верхний если что)
end;

procedure TForm1.Button3Click(Sender: TObject); // очистка
begin
memo1.Lines.Clear; // очищаем
memo2.Lines.Clear; // очищаем
edit1.Text:=''; // очищаем
edit2.visible:=false; // скрываем
label4.Visible:=false; // скрываем
label5.Visible:=false; // скрываем
label6.Visible:=false; // скрываем
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
case key of
#8, 'А'..'я': ; // разрешено для ввода
else key:=#0; // запрет ввода
end;
end;

procedure TForm1.FormActivate(Sender: TObject);
var i:integer;
begin
edit2.Enabled:=false;
vig[1]:='АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ'; // первая строка таблицы
for i:=2 to 32 do //создание таблицы виженера
vig[i]:=copy(vig[1],i,33-i)+copy(vig[1],1,i-1);
//заполнение массива частот встречаемости букв в русском языке
frs[0]:=0.062;frs[1]:=0.014;frs[2]:=0.038;frs[3]:=0.013;
frs[4]:=0.025;frs[5]:=0.072;frs[6]:=0.007;frs[7]:=0.016;
frs[8]:=0.062;frs[9]:=0.010;frs[10]:=0.028;frs[11]:=0.035;
frs[12]:=0.026;frs[13]:=0.052;frs[14]:=0.090;frs[15]:=0.023;
frs[16]:=0.040;frs[17]:=0.045;frs[18]:=0.053;frs[19]:=0.021;
frs[20]:=0.002;frs[21]:=0.009;frs[22]:=0.003;frs[23]:=0.012;
frs[24]:=0.006;frs[25]:=0.003;frs[26]:=0.007;frs[27]:=0.016;
frs[28]:=0.007;frs[29]:=0.003;frs[30]:=0.006;frs[31]:=0.018;
for i:=0 to 31 do //заполнение буквами массивов алфавитов
begin
trb[i]:=chr(192+i);
trs[i]:=chr(224+i);
end;
edit2.visible:=false; // скрыть
label4.Visible:=false; // скрыть
label5.Visible:=false; // скрыть
label6.Visible:=false; // скрыть
memo1.SetFocus; // сделать текущим
end;



procedure TForm1.Button5Click(Sender: TObject); // выход
begin
close;
end;

procedure TForm1.Button6Click(Sender: TObject); // взломать
var i,g,y,u,gr:integer; obr,s,s1,s3,s4,s2:string; t,r:word;
dist,kolnod,nody,distu,kk:array of integer; sm:array of string;
label zomg;
begin
if memo1.Text='' then // если текстовое полу пустое
begin
showmessage('Введите текст для взлома');
abort;
end;
s:=memo1.text; // s - присваиваем текст
y:=0;
begin
if (length(memo1.text)>0) and (strtointdef(edit1.text,3) in [3..20]) then
begin
s:=probely(memo1.Text,1);// удаляем ненужные символы
s3:=s;
s4:=s;
memo2.Clear;
setlength(dist,0);
g:=0;

for i:=1 to length(s) do //поиск совпадений букв
begin
s2:=copy(s,i,strtointdef(edit1.text,3));// копируем часть текста с i
if length(s2)>strtointdef(edit1.text,3)-1 then
begin
delete(s3,1,1); // удаляем первый символ
if pos(s2,s3)>0 then
begin
setlength(dist,g+1);
dist[g]:=pos(s2,s3);
inc(g);
end;
end;
end;

if length(dist)<2 then // если мало совпадений или вовсе текста нет
zomg:begin
showmessage('Не могу взломать, слишком сложная задача либо введен текст, не содержащий символы русского алфавита!'); // если мало совпадений или их вовсе нет
exit;
end;

for i:=0 to high(dist) do
begin
if maxintvalue(dist)>0 then // максимальные расстояния
begin
setlength(distu,i+1);
distu[i]:=maxintvalue(dist);
end;
for g:=0 to length(dist) do
if distu[i]=dist[g] then
dist[g]:=-1;
end;
setlength(nody,high(distu));

for i:=0 to high(distu)-1 do // находим ноды
nody[i]:=nod(distu[i],distu[i+1]);

for i:=0 to high(nody)-1 do // считаем ноды
begin
setlength(kolnod,length(kolnod)+1);
if nody[i]>1 then
for g:=1 to high(nody) do
if nody[i]=nody[g] then
begin
kolnod[i]:=kolnod[i]+1;
end;
end;
for i:=0 to high(kolnod) do
if maxintvalue(kolnod)=kolnod[i] then
y:=nody[i];
if y=0 then goto zomg;
end;

divmod(length(s),y,t,r);
setlength(sm,y);
setlength(kk,y);
for i:=0 to length(s) do
sm[i mod y]:=sm[i mod y]+s[i+1];
s1:='';
edit2.Clear;

for i:=1 to y do
begin
u:=getkey(sm[i-1],trb,frs); // определяем ключ
kk[i-1]:=u;
for g:=1 to length(sm[i-1]) do
sm[i-1][g]:=kod(trb,sm[i-1][g],u);
if kk[i-1]=0 then edit2.text:=edit2.Text+'А' else
edit2.Text:=edit2.text+trb[32-kk[i-1]]; // находим ключевое слово
end;

s:='';
for i:=1 to length(sm[0]) do
for g:=1 to y do
s:=s+sm[g-1][i];

delete(s,length(s)-(y-r)+1,y-r);
end;
memo2.Text:=s;
begin // делим текст на группы символов
obr:=memo2.text;
gr:=0;
while gr<length(obr) do
begin
gr:=gr+7;
insert(' ',obr,gr);
end;
memo2.Text:=ansiuppercase(obr); // регистр
label4.Caption:=inttostr(edit2.GetTextLen);// длина ключа
edit2.visible:=true; // показать ключевое слово
label4.Visible:=true; // показать длину ключа
label5.Visible:=true; // показать надпись
label6.Visible:=true; // показать надпись
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
SaveWindowProc:=Edit1.WindowProc;
Edit1.WindowProc:=TEditWindowProc;
end;

procedure TForm1.TEditWindowProc(var Message: TMessage);
begin
if Message.Msg=wm_paste then Message.Result:=0
else SaveWindowProc(Message);
end;
end. // конец