unit HackEncrypting;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  // множество всех русских букв
  TRusLetters     = set of Char;
  // исходный алфавит русского языка
  TRusSrcAlphabet = array [0..65] of Char;
  // относительные частоты русских букв
  TRusFrequency   = array [0..32] of Real;
  TFrequency      = array [Char]  of Real;
  TRusDstAlphabet = array [Char]  of Char;

  TfmHackEncrypting = class(TForm)
    mmDecryptMessage: TMemo;
    mmEncryptMessage: TMemo;
    lbDecryptMessage: TLabel;
    lbEncryptMessage: TLabel;
    btnHackEncrypting: TButton;
    edKey: TEdit;
    lbKey: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure btnHackEncryptingClick(Sender: TObject);
  private
    { Private declarations }
    // значение ключа, вычисляемого на основании частотного анализа
    nHackKey: Integer;
    // количество букв русского алфавита в закодированном сообщение
    nCount: LongInt;
    // абсолютная частота букв русского алфавита (то есть количество
    // каждой буквы по отдельности) в зашифрованном сообщении
    AbsFrequency: TFrequency;
    // относительная частота букв русского алфавита в шифровке
    RelFreqInMsg: TFrequency;
    // относительная частота букв русского алфавита в русском языке
    RelFreqInLang: TFrequency;
    RusDstAlphabet: TRusDstAlphabet;
    function  UpCaseRus(Ch: Char): Char;
    procedure RecalcAlphabet(nKey: Integer);
    function  DecryptString(strDecryptMsg: String; nKey: Integer): String;
  public
    { Public declarations }
  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);

var
  fmHackEncrypting: TfmHackEncrypting;
implementation

{$R *.dfm}

// функция заполняет абсолютные частоты для больших и маленьких букв
procedure TfmHackEncrypting.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];
end;

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

procedure TfmHackEncrypting.btnHackEncryptingClick(Sender: TObject);
var
  Ch: Char;
  i, j, h: Integer;
  Delta, MinDelta: Real;
begin
  // обнуляем счетчик русских букв в закодированном сообщении
  nCount := 0;
  FillChar(AbsFrequency, SizeOf(AbsFrequency), 0);
  for i := 0 to mmEncryptMessage.Lines.Count - 1 do
    for j := 1 to Length(mmEncryptMessage.Lines[i]) do
      begin
        // очередной символ сообщения
        Ch := mmEncryptMessage.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
      MessageDlg('Дешифровать сообщение нельзя, так как' +
          ' отсутствует русский текст', mtError, [mbOk], 0);
      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 + Abs(RelFreqInLang[RusSrcAlphabet[j]] -
                   RelFreqInMsg[RusSrcAlphabet[(i + j + h) mod h]]);
      // очередная сумма разностей меньше всех предыдущих?
      if MinDelta > Delta then
        begin
          // запоминаем ее...
          MinDelta := Delta;
          // ... и запоминаем ключ, при котором полученна данное значение
          nHackKey := i;
        end;
    end;
  edKey.Text := IntToStr(nHackKey);
  h := High(RusSrcAlphabet) + 1;
  RecalcAlphabet(h - nHackKey mod h);
  mmDecryptMessage.Lines.BeginUpdate;
  mmDecryptMessage.Clear;
  for i := 0 to mmEncryptMessage.Lines.Count - 1 do
    mmDecryptMessage.Lines.Add(DecryptString(mmEncryptMessage.Lines[i], nHackKey));
  mmDecryptMessage.Lines.EndUpdate;
end;

procedure TfmHackEncrypting.RecalcAlphabet(nKey: Integer);
var
  Ch: Char;
  i: Integer;
  LetCnt: Integer;
begin
  for Ch := #0 to #255 do
    RusDstAlphabet[Ch] := Ch;
  LetCnt := SizeOf(TRusSrcAlphabet);
  for i := 0 to LetCnt - 1 do
    RusDstAlphabet[RusSrcAlphabet[(i - nKey + LetCnt) mod LetCnt]] :=
        RusSrcAlphabet[i];
end;

function TfmHackEncrypting.DecryptString(strDecryptMsg: String;
  nKey: Integer): String;
var
  i: Integer;
begin
  for i := 1 to Length(strDecryptMsg) do
    strDecryptMsg[i] := RusDstAlphabet[strDecryptMsg[i]];
  Result := strDecryptMsg;
end;

end.
