Дешифрация сообщений на основе частотных характеристик языка сообщения

//*****************************************************************************
// Шифратор/дешифратор/анализатор методом Цезаря
//*****************************************************************************
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls;
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    Memo3: TMemo;
    Memo4: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Panel1: TPanel;
    Label5: TLabel;
    Edit1: TEdit;
    UpDown1: TUpDown;
    ButtonCode: TButton;
    ButtonDecode: TButton;
    Panel2: TPanel;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    ButtonOpen: TButton;
    ButtonSave: TButton;
    ButtonAnalisis: TButton;
    RadioButton4: TRadioButton;
    ProgressBar1: TProgressBar;
    procedure ButtonCodeClick(Sender: TObject);
    procedure ButtonAnalisisClick(Sender: TObject);
    procedure ButtonDecodeClick(Sender: TObject);
    procedure ButtonOpenClick(Sender: TObject);
    procedure ButtonSaveClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  end;
 
const
  N = 33;// Мощность алфавита
type
  // Поток
  TMyThread = class(TThread)
    procedure execute; override;
  end;
  // Алфавит
  TA = record
    L : char;
    C : word;
    F : real;
  end;
// Переменные
var
  Form1: TForm1;
  MyThread : TMyThread;// Поток
  Act: byte;// Действие
  A : array [0..N-1] of TA;// Начальный алфавит
  A1 : array [0..N-1] of TA;// Анализированный алфавит
 
  procedure Init;// Инициализация
  function Code(Text: string;// текст
                Key: word;// ключ
                Act: byte): string;// 1 - кодировать 2 - декодировать
  function Analisis(Text: string): string;//анализировать текст
 
implementation
{$R *.dfm}
//*****************************************************************************
// Выполнение потока
procedure TMyThread.Execute;
begin
  // Выбор действия
  case Act of
    1: Form1.Memo2.Text := Code(Form1.Memo1.Text,
                                StrToInt(Form1.Edit1.Text),
                                1);// Шифровать
    2: Form1.Memo1.Text := Code(Form1.Memo2.Text,
                                StrToInt(Form1.Edit1.Text),
                                2);// Дешифровать
    3: Form1.Memo4.Text := Analisis(Form1.Memo3.Text);// Анализировать
  end;
end;
//*****************************************************************************
// Инициализация
procedure Init;
begin
  Form1.UpDown1.Max := N;
  A[0].L := ' '; A[0].F := 0.175;
  A[1].L := 'а'; A[1].F := 0.065;
  A[2].L := 'б'; A[2].F := 0.014;
  A[3].L := 'в'; A[3].F := 0.038;
  A[4].L := 'г'; A[4].F := 0.013;
  A[5].L := 'д'; A[5].F := 0.025;
  A[6].L := 'е'; A[6].F := 0.072;
  A[7].L := 'ж'; A[7].F := 0.007;
  A[8].L := 'з'; A[8].F := 0.016;
  A[9].L := 'и'; A[9].F := 0.062;
  A[10].L := 'й'; A[10].F := 0.010;
  A[11].L := 'к'; A[11].F := 0.028;
  A[12].L := 'л'; A[12].F := 0.035;
  A[13].L := 'м'; A[13].F := 0.026;
  A[14].L := 'н'; A[14].F := 0.053;
  A[15].L := 'о'; A[15].F := 0.090;
  A[16].L := 'п'; A[16].F := 0.023;
  A[17].L := 'р'; A[17].F := 0.040;
  A[18].L := 'с'; A[18].F := 0.045;
  A[19].L := 'т'; A[19].F := 0.053;
  A[20].L := 'у'; A[20].F := 0.021;
  A[21].L := 'ф'; A[21].F := 0.002;
  A[22].L := 'х'; A[22].F := 0.009;
  A[23].L := 'ц'; A[23].F := 0.004;
  A[24].L := 'ч'; A[24].F := 0.012;
  A[25].L := 'ш'; A[25].F := 0.006;
  A[26].L := 'щ'; A[25].F := 0.003;
  A[27].L := 'ъ'; A[27].F := 0.014;
  A[28].L := 'ы'; A[28].F := 0.016;
  A[29].L := 'ь'; A[29].F := 0.019;
  A[30].L := 'э'; A[30].F := 0.003;
  A[31].L := 'ю'; A[31].F := 0.006;
  A[32].L := 'я'; A[32].F := 0.018;
end;
//*****************************************************************************
// Шифровать/дешифровать
function Code(Text: string; Key : word; Act : byte): string;
var
  i, j, Pos : integer;
begin
  Result := '';
  if Length(Text) <> 0 then
  begin
    Form1.ProgressBar1.Max := Length(Text);
    for i := 1 to Length(Text) do
    begin
      for j := 0 to N-1 do
        if Text[i] = A[j].L then
        begin
          if Act = 1 then
            Pos := (j + Key + N) mod N
          else
            Pos := (j - Key + N) mod N;
          Result := Result + A[Pos].L;
          Break;
        end;//if
      Form1.ProgressBar1.StepIt;
    end;//for
  end;//if
end;
//*****************************************************************************
// Анализировать
function Analisis(Text: string): string;
var
  i, j, k, m : word;
  Str : string;
  dif : array[0..N-1] of real;
  min : real;
begin
  // Создаем результат анализа
  for i := 0 to N do
  begin
    A1[i].L := A[i].L;
    A1[i].C := 0;
    A1[i].F := 0;
  end;
  // Заполняем результат анализа
  if Length(Text) <> 0 then//Если текст не пуст
  begin
    Form1.ProgressBar1.Max := Length(Text);
    for i := 1 to Length(Text) do
    begin
      for j := 0 to N-1 do
        if A1[j].L = Text[i] then
        begin
          Inc(A1[j].C);
          Break;
        end;//if
      Form1.ProgressBar1.StepIt;
    end;//for
    // Подсчет частотности и вывод на экран
    Result := '';
    for i := 0 to N-1 do
    begin
      A1[i].F := A1[i].C/Length(Text);
      Str := A1[i].L + '   ' +
             IntToStr(A1[i].C) + '    ' +
             FloatToStr(A1[i].F) + #13#10;
      Result := Result + Str;
    end;
    // находим сумму разностей
    k := 0;
    for i := 0 to N-1 do
    begin
      for j := 0 to N-1 do
      begin
        k := (j + k + N) mod N;
        Dif[i] := Dif[i] + (A1[j].F - A1[k].F);
      end;
      Inc(k);
    end;
    // находим индекс минимальную разницы
    min := 10000;
    m := 0;
    for i := 0 to N-1 do
      if Dif[i] < min then
      begin
        min := Dif[i];
        m := i;
      end;
    // декодируем текст
    Result := Result + Code(Form1.Memo3.Text, m, 2);
  end;//if
end;
//*****************************************************************************
// Кнопка шифровать
procedure TForm1.ButtonCodeClick(Sender: TObject);
begin
  Act := 1;
  MyThread := TMyThread.create(true);
  MyThread.FreeOnTerminate := true;
  MyThread.Priority := tpLower;
  MyThread.Resume;
end;
//*****************************************************************************
// Кнопка дешифровать
procedure TForm1.ButtonDecodeClick(Sender: TObject);
begin
  Act := 2;
  MyThread := TMyThread.create(true);
  MyThread.FreeOnTerminate := true;
  MyThread.Priority := tpLower;
  MyThread.Resume;
end;
//*****************************************************************************
// Кнопка анализировать
procedure TForm1.ButtonAnalisisClick(Sender: TObject);
begin
  Act := 3;
  MyThread := TMyThread.create(true);
  MyThread.FreeOnTerminate := true;
  MyThread.Priority := tpLower;
  MyThread.Resume;
end;
//*****************************************************************************
// Кнопка открыть
procedure TForm1.ButtonOpenClick(Sender: TObject);
begin
  // В зависимости от выбранного пункта мемо загружается из файла
  if OpenDialog1.Execute then
  begin
    if RadioButton1.Checked = true then
      Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
    if RadioButton2.Checked = true then
      Memo2.Lines.LoadFromFile(OpenDialog1.FileName);
    if RadioButton3.Checked = true then
      Memo3.Lines.LoadFromFile(OpenDialog1.FileName);
    if RadioButton4.Checked = true then
      Memo4.Lines.LoadFromFile(OpenDialog1.FileName);
  end;
end;
//*****************************************************************************
// Кнопка сохранить
procedure TForm1.ButtonSaveClick(Sender: TObject);
begin
  // В зависимости от выбранного пункта мемо сохраняется в файл
  if SaveDialog1.Execute then
  begin
    if RadioButton1.Checked = true then
      Memo1.Lines.SaveToFile(SaveDialog1.FileName);
    if RadioButton2.Checked = true then
      Memo2.Lines.SaveToFile(SaveDialog1.FileName);
    if RadioButton3.Checked = true then
      Memo3.Lines.SaveToFile(SaveDialog1.FileName);
    if RadioButton4.Checked = true then
      Memo4.Lines.SaveToFile(SaveDialog1.FileName);
  end;
end;
//*****************************************************************************
procedure TForm1.FormCreate(Sender: TObject);
begin
  Init;
end;
//*****************************************************************************
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  // Диалог закрытия
  if MessageDlg('      Закрыть программу?     ' ,
                mtConfirmation ,
                [mbYes, mbNo] , 0) = mrYes then
      // Закрываем программу
      Action := caFree
  else
    // Нет действий
    Action := caNone;
end;
//*****************************************************************************
end.