Валерий Борисок - Delphi. Трюки и эффекты

Листинг 12.23.

Объявление типов и класса нашей формы

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;

Листинг 12.24.

Обработчик события формы OnCreate

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;

Листинг 12.25.

Вспомогательные функции

function TfmHackEncrypting.UpCaseRus(Ch: Char): Char;

begin

if Ch = \'ё\' then Ch := \'Ё\

if Ch in [\'а\'..’я’] then Dec(Ch, 32);

Result := Ch;

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;

Листинг 12.26.

Обработчик события кнопки OnClick

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