Шифр Цезаря в Delphi


Шифр Цезаря в Delphi

Шифр Цезаря, также известный как шифр сдвига, код Цезаря или сдвиг Цезаря — один из самых простых и наиболее широко известных методов шифрования.


Шифр Цезаря — это вид шифра подстановки, в котором каждый символ в открытом тексте заменяется буквой находящейся на некоторое постоянное число позиций левее или правее него в алфавите. Например, в шифре со сдвигом 3, А была бы заменена на Г, Б станет Д, и так далее.


Шифр назван в честь римского императора Гая Юлия Цезаря, использовавшего его для секретной переписки со своими генералами.


Шаг шифрования, выполняемый шифром Цезаря, часто включается как часть более сложных схем, таких как шифр Виженера, и все еще имеет современное приложение в системе ROT13. Как и все моноалфавитные шифры, шифр Цезаря легко взламывается и не имеет практически никакого применения на практике.



Итак, вот краткое описание функций программы:
1) Шифрование русскоязычных и англоязычных текстов при известном ключе;
2) Дешифрование русскоязычных и англоязычных текстов при известном ключе; 
3) Взлом русскоязычных текстов с определением ключа:
4) Все символы, отличные от букв, программа игнорирует, кроме того, все символы принудительно переводятся в верхний регистр;
5) Результат выводится на экран группами по 6 символов;
6) Программа работает с любыми целыми значениями сдвига;
7) Предусмотрена защита 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, Mask, Buttons;

type
TRusLetters = set of Char; // all rusletters
TRusSrcAlphabet = array [0..65] of Char;// rus alpabet
TRusFrequency = array [0..32] of Real;//frequency
TFrequency = array [Char] of Real;
TRusDstAlphabet = array [Char] of Char;
TForm1 = class(TForm)
IshMemo: TMemo;
ObrMemo: TMemo;
GroupBox3: TGroupBox;
Label2: TLabel;
Button1: TBitBtn;
Button5: TBitBtn;
Button3: TBitBtn;
Button4: TBitBtn;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
Edit1: TMaskEdit;
procedure IshMemoChange(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char); // decrypt
procedure FormActivate(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button5Click(Sender: TObject);

private
{ Private declarations }
{ Private declarations }
SaveWindowProc: TWndMethod;
nHackKey: Integer;// hack key
nCount: LongInt;// count letters in encrypting message
AbsFrequency: TFrequency;// absolut frequency (count each letter) in encrypting message
RelFreqInMsg: TFrequency; // relative frequency letters of rusalpgabet in encrypting message
RelFreqInLang: TFrequency;// relative frequency letters of rusalpgabet in ruslanguage
function UpCaseRus(Ch: Char): Char;

public
{ Public declarations }
procedure TEditWindowProc(var Message: TMessage);
end;

const
RusLetters: TRusLetters = ['Ё', 'ё', 'А'..'я'];
RusSrcAlphabet: TRusSrcAlphabet = 'АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ' +
'абвгдеёжзийклмнопрстуфхцчшщъыьэюя';
RusFrequency: TRusFrequency =(
0.063, 0.014, 0.038, 0.013, 0.025, 0.072, 0.072, 0.007,
0.016, 0.062, 0.010, 0.028, 0.035, 0.026, 0.052, 0.090,
0.023, 0.040, 0.045, 0.053, 0.021, 0.001, 0.009, 0.004,
0.012, 0.005, 0.003, 0.015, 0.017, 0.015, 0.002, 0.006,
0.018); // frequency in russian alphabet

var
Form1: TForm1;
key:integer; // ключ
ish,Rus,russmall,Eng,engsmall,obr:string; // алфавит
i,j,sdv,gr:integer;

implementation
{$R *.dfm}

procedure TForm1.FormActivate(Sender: TObject);
begin
IshMemo.Clear;
ObrMemo.Clear;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i,j:integer;
begin
if radiobutton1.Checked =true then // шифрование
if IshMemo.text='' then
begin
showmessage('Введите текст');
abort;end;
If edit1.text='' then
begin
showmessage('Введите ключ');
abort;end;
ObrMemo.Clear;
ish:=IshMemo.Text;
obr:=ObrMemo.Text;
ish:=AnsiUpperCase(ish); // верхний регистр
rus:='АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ';
russmall:='абвгдежзийклмнопрстуфхцчшщъыьэюя';
eng:='ABCDEFGHIJKLMNOPQRSTUVWXYZ';
engsmall:='abcdefghijklmnopqrstuvwxyz';

for i:=1 to length(ish) do //по тексту
for j:=1 to 32 do //по алфавиту
begin
key:=StrToInt(Edit1.Text); //ключ
if (ish[i]=rus[j]) or (ish[i]=russmall[j]) then
begin
if key<0 then // для отрицательного ключа
begin
while key<-32 do
key:=key+32;
key:=32-abs(key);
end;
begin
while key>32 do
key:=key-32; // ключ в пределах 32
end;
if j+key>32 // сдвиг
then
sdv:=j+key-32
else
sdv:=j+key;
ObrMemo.Text:=ObrMemo.Text+rus[sdv];
end;

If (ish[i]=Eng[j]) or (ish[i]=engsmall[j])
then
begin
if key<0 then // для отрицательного ключа
begin
while key<-26 do
key:=key+26;
key:=26-abs(key);
end;
begin
while key>26 do
key:=key-26; // ключ в пределах 26
end;
if j+key>26 // сдвиг
then
sdv:=j+key-26
else
sdv:=j+key;
ObrMemo.Text:=ObrMemo.Text+Eng[sdv];
end;

ObrMemo.Text:=ObrMemo.Text+'';
end;

obr:=ObrMemo.Text; // группа по 6 символов
gr:=0;
while gr<length(obr) do
begin
gr:=gr+7;
insert(' ',obr,gr);
end;
ObrMemo.Text:=obr;

if radiobutton2.checked=true then // расшифрование
begin
if IshMemo.text='' then
begin
showmessage('Введите текст');
abort;
end;
If edit1.text='' then
begin
showmessage('Введите ключ');
abort;
end;
ObrMemo.Clear;
ish:=IshMemo.Text;
ish:=AnsiUpperCase(ish);
rus:='АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ';
russmall:='абвгдежзийклмнопрстуфхцчшщъыьэюя';
eng:='ABCDEFGHIJKLMNOPQRSTUVWXYZ';
engsmall:='abcdefghijklmnopqrstuvwxyz';

for i:=1 to length(ish) do // по тексту
for j:=1 to 32 do //по алфавиту
begin
key:=StrToInt(Edit1.Text); //ключ
if (ish[i]=rus[j]) or (ish[i]=russmall[j]) then
begin
if key<0 then // если отрицательный ключ
begin
while key<-32 do
key:=key+32;
key:=32-abs(key);

end;
begin
while key>32 do
key:=key-32; // ключ в пределах 32
end;
if j-key<=0 //сдвиг
then
sdv:=j-key+32
else
sdv:=j-key;
ObrMemo.Text:=ObrMemo.Text+rus[sdv]
end;

If (ish[i]=Eng[j]) or (ish[i]=engsmall[j])then
begin
begin
while key>26 do
key:=key-26; // ключ в пределах 26
end;
if j-key<=0 // сдвиг
then
sdv:=j-key+26
else
sdv:=j-key;
ObrMemo.Text:=ObrMemo.Text+Eng[sdv]
end;
ObrMemo.Text:=ObrMemo.Text+'';
end;
obr:=ObrMemo.Text; // группа по 6 символов
gr:=0;
while gr<length(obr) do
begin
gr:=gr+7;
insert(' ',obr,gr);
end;
ObrMemo.Text:=obr;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
i, h: Integer;
begin
h := High(RusSrcAlphabet) div 2;
for i := Low(RusSrcAlphabet) to High(RusSrcAlphabet) do
RelFreqInLang[RusSrcAlphabet[i]] := RusFrequency[i mod h];

SaveWindowProc:=Edit1.WindowProc;
Edit1.WindowProc:=TEditWindowProc;
end;

procedure TForm1.IshMemoChange(Sender: TObject);
begin
ishmemo.Text:=StringReplace(ishmemo.Text,'ё','е',[rfReplaceAll]);// заменяем ё на е
ishmemo.Text:=StringReplace(ishmemo.Text,'Ё','Е',[rfReplaceAll]);// заменяем Ё на Е
end;

function Tform1.UpCaseRus(Ch: Char): Char;
begin
if Ch = 'ё' then Ch := 'Ё';
if Ch in ['а'..'я'] then Dec(Ch, 32);
Result := Ch;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
Ch: Char;
i, j, h: Integer;
Delta, MinDelta: Real;
begin
nCount := 0; // обнуляем счетчик русских букв в закодированном сообщении
FillChar(AbsFrequency, SizeOf(AbsFrequency), 0);

for i := 0 to IshMemo.Lines.Count - 1 do
for j := 1 to Length(IshMemo.Lines[i]) do
begin
Ch := IshMemo.Lines[i][j];// очередной символ сообщения
// принадлежит ли символ множеству русских букв
if Ch in RusLetters then
begin
// подсчитываем количество данной буквы в отдельности
// и в совокупности со всеми русскими буквами
AbsFrequency[UpCaseRus(Ch)] := AbsFrequency[UpCaseRus(Ch)] + 1;
Inc(nCount);
end;
end;
if nCount = 0 then
begin
Showmessage('Введите текст');
Exit;
end;
// вычисляем относительные частоты букв в закодированном сообщении
FillChar(RelFreqInMsg, SizeOf(RelFreqInMsg), 0);
for i := Low(RusSrcAlphabet) to High(RusSrcAlphabet) div 2 do
RelFreqInMsg[RusSrcAlphabet[i]] := AbsFrequency[RusSrcAlphabet[i]] / nCount;
// перебираем все возможные ключи и выбираем тот, при
// использовании которого частоты появления русских букв
// в закодированном сообщении наиболее близки к частотам
// появления русских букв в русском языке, то есть сумма
// абсолютных разностей частот букв должна быть наименьшей
h := High(RusSrcAlphabet) div 2 + 1;
MinDelta := h;
for i := 1 to h - 1 do
begin
Delta := 0;
for j := 0 to h - 1 do
Delta := Delta + Sqr(RelFreqInLang[RusSrcAlphabet[j]] -
RelFreqInMsg[RusSrcAlphabet[(i + j + h) mod h]]);
// очередная сумма разностей меньше всех предыдущих
if MinDelta > Delta then
begin
// запоминаем ее...
MinDelta := Delta;
//и запоминаем ключ, при котором получено данное значение
nHackKey := i;
if nhackkey>20 then nhackkey:=nhackkey-1;

end;
end;
edit1.Text := IntToStr(nHackKey);
ObrMemo.Clear;
ish:=IshMemo.Text;
ish:=AnsiUpperCase(ish);
rus:='АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ';
russmall:='абвгдежзийклмнопрстуфхцчшщъыьэюя';
eng:='ABCDEFGHIJKLMNOPQRSTUVWXYZ';
engsmall:='abcdefghijklmnopqrstuvwxyz';
for i:=1 to length(ish) do //по тексту
for j:=1 to 32 do //по алфавиту}
begin
key:=StrToInt(Edit1.Text); //ключ
if (ish[i]=rus[j]) or (ish[i]=russmall[j]) then
begin
key:=nhackkey;
if j-key<=0 then
sdv:=j-key+32
else
sdv:=j-key;
ObrMemo.Text:=ObrMemo.Text+rus[sdv]
end;
end;
obr:=ObrMemo.Text; //группа по 6 символов
gr:=0;
while gr<length(obr) do
begin
gr:=gr+7;
insert(' ',obr,gr);
end;
ObrMemo.Text:=obr;
end;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
case key of
#46,#8, '0'..'9': ;
'-' : if length(edit1.Text)<>0 then key:=#0;
else key:=#0;
end;
end;

procedure TForm1.Button4Click(Sender: TObject); // close
begin
Close;
end;

procedure TForm1.Button3Click(Sender: TObject); // clear
begin
IshMemo.Clear;
ObrMemo.Clear;
Edit1.Clear;
end;

procedure TForm1.TEditWindowProc(var Message: TMessage);
begin
if Message.Msg=wm_paste then Message.Result:=0
else SaveWindowProc(Message);
end;
end.