procedure TfmSubstitution.GenRearrangment;
var
Ch, c: char;
//нужен для определения, встречался ли символ ранее
WasGen: array [Char] of Boolean;
begin
//заполняем массив значением False
FillChar(WasGen, SizeOf(WasGen), False);
for Ch := 'А' to 'Я' do
begin
//генерируем случайный символ до тех пор, пока
//не будет получен еще не сгенерированный
repeat
c := Chr(Ord('А') + random(32));
until not WasGen[c];
//помечаем, что символ сгенерирован
WasGen[c] := True;
vleSubst.Values[Ch] := c;
end;
end;
В нашем приложении пользователь может сам задавать необходимую перестановку букв алфавита, поэтому стоит учесть тот факт, что он может ошибиться при ее вводе. Для решения данной проблемы реализуем функцию, которая будет отвечать на вопрос о том, является ли введенная перестановка корректной. Определимся с тем, каким критериям должна отвечать перестановка, чтобы считаться допустимой. Во-первых, в каждой ячейке ввода должна присутствовать лишь одна буква – ни больше, ни меньше. Во-вторых, каждая введенная буква обязана принадлежать множеству букв русского алфавита. И в-третьих, ни одна введенная буква не должна ни разу повторяться. Проверка первого критерия довольно проста. Для этого достаточно лишь проверить длину строки, введенной в каждой ячейке. Второй критерий также проверяется довольно простой конструкцией принадлежности заданному множеству. Третий критерий проверяется подобно тому, как в предыдущем реализованном методе проверялось, сгенерирована данная буква или нет. Следующий исходный код, представленный в листинге 12.3, показывает, как эта проверка осуществляется.
...
Листинг 12.3.
Реализация метода проверки допустимости перестановки
function TfmSubstitution.ValidateRearrangement: Boolean;
var
i: Integer;
s: String;
Used: array [Char] of Boolean;
begin
Result := False;
FillChar(Used, SizeOf(Used), False);
for i := 1 to vleSubst.RowCount – 1 do
Begin
//символ единственный в строке?
s := vleSubst.Cells[1, i];
if (Length(s) <> 1) then
Exit;
//символ – буква русского языка?
s[1] := UpCaseRus(s[1]);
if not (s[1] in ['А'..’Я’]) then
Exit;
//уже встречался ранее?
if Used[s[1]] then Exit;
Used[s[1]] := True;
End;
Result := True;
end;
Далее мы реализуем две вспомогательные функции, которые позволят преобразовать буквы верхнего регистра к нижнему и наоборот. Их реализация немного специфична и основывается на используемой кодировке. Отдельная проверка буквы «Ё» производится на основании иного расположения в таблице кодировки, чем у остальных букв. Буквы русского алфавита верхнего регистра расположены начиная с «А» по порядку следования в алфавите, а сразу после них аналогично расположены буквы нижнего регистра. Этим объясняется увеличение кода буквы на фиксированное число. Реализация данных вспомогательных функций приведена в листинге 12.4.
...
Листинг 12.4.
Вспомогательные функции преобразования регистра букв
function TfmSubstitution.UpCaseRus(Ch: Char): Char;
begin
if Ch = 'ё' then Ch := 'Е
if Ch in ['а'..’я’] then Dec(Ch, 32);
Result := Ch;
end;
function TfmSubstitution.LowCaseRus(Ch: Char): Char;
begin
if Ch = 'Ё' then Ch := 'е
if Ch in ['А'..’Я’] then Inc(Ch, 32);
Result := Ch;
end;
Теперь рассмотрим работу обработчика события формы OnCreate и обработчика события кнопки OnClick. Первый сначала инициализирует редактор значений полями, для которых будут задаваться данные. После того как все поля созданы, вызывается функция генерации случайной перестановки, которая, в свою очередь, заполняет все поля редактора значений необходимыми данными. Второй же обработчик только вызывает функцию генерации случайной перестановки. В листинге 12.5 приведен исходный код данных методов.
...
Листинг 12.5.
Использование генерации случайной перестановки
procedure TfmSubstitution.FormCreate(Sender: TObject);
var
Ch: char;
begin
Randomize;
//инициализация редактора значений
for Ch := 'А' to 'Я' do
vleSubst.InsertRow(Ch, '', True);
//генерация случайной перестановки
GenRearrangment;
end;
procedure TfmSubstitution.btnGenRearrangementClick(Sender:
TObject);
begin
GenRearrangment;
end;
Следующим объектом нашего рассмотрения является функция предварительной подготовки алфавита преобразования для шифрования либо дешифрования сообщения. У метода RecalcAlphabet есть параметр пКеу, который в зависимости от своего значения показывает, что является ключом. Возможными значениями пКеу являются 0 и 1. Значение 0 указывает на то, что будет производиться шифрование сообщения и требуется поставить в соответствие буквам открытого текста буквы перестановки. Значение 1, напротив, указывает на то, что будет производиться дешифрование сообщения и требуется поставить в соответствие буквам перестановки буквы открытого текста. Для этого массив сопоставления символов изначально заполняется таким образом, чтобы каждый символ соответствовал самому себе. Это происходит в следующих строках метода:
...
for Ch := Low(RusDstAlphabet) to High(RusDstAlphabet) do RusDstAlphabet[Ch] := Ch;
После чего требуется подкорректировать данный массив таким образом, чтобы выполнялось требуемое соответствие. Для этого мы проходим по всем элементам редактора значений vleSubstn поправляем массив, указывая в качестве индекса элемента то, чему ставится соответствие, а в качестве значения элемента массива – то, что является соответствием.
...
for i := 1 to vleSubst.RowCount – 1 do
RusDstAlphabet[vleSubst.Cells[nKey, i][1]] :=
vleSubst.Cells[1 – nKey, i][1];
Редактор значений vleSubst предназначен для сопоставления букв верхнего регистра. Нам же требуется избавиться от различия между буквами верхнего и нижнего регистров. Для этого мы дополнительно производим следующие действия:
...
for i := 1 to vleSubst.RowCount – 1 do
RusDstAlphabet[LowCaseRus(vleSubst.Cells[nKey, i][1])] :=
LowCaseRus(vleSubst.Cells[1 – nKey, i][1]);
Мы рассмотрели работу данного метода по частям. Его полный код приведен в листинге 12.6. Как видите, все относительно просто. Здесь мы используем вспомогательную функцию LowCaseRus.
...
Листинг 12.6.
Функция предварительной подготовки алфавита преобразования
procedure TfmSubstitution.RecalcAlphabet(nKey: Integer);
var
Ch: Char;
i: Integer;
begin
//предварительно все символы в алфавите шифрования
//соответствуют символам из незашифрованного алфавита
for Ch := Low(RusDstAlphabet) to High(RusDstAlphabet) do
RusDstAlphabet[Ch] := Ch;
//формируем алфавит отдельно для каждого из регистров букв
//здесь для верхнего
for i := 1 to vleSubst.RowCount – 1 do
RusDstAlphabet[vleSubst.Cells[nKey, i][1]] :=
vleSubst.Cells[1 – nKey, i][1];
//здесь для нижнего
for i := 1 to vleSubst.RowCount – 1 do
RusDstAlphabet[LowCaseRus(vleSubst.Cells[nKey, i][1])] :=
LowCaseRus(vleSubst.Cells[1 – nKey, i][1]);
end;
Еще одной вспомогательной функцией является функция преобразования строки символов с помощью алфавита преобразования в соответствии с указанной операцией. Работа ее довольно проста. В цикле осуществляется прямой проход по строке, и каждый символ, принадлежащий ей, заменяется соответствующим символом алфавита преобразования. В итоге мы получаем зашифрованную либо дешифрованную строку. Посмотреть исходный код данного метода можно в листинге 12.7.
...
Листинг 12.7.
Преобразование строки при помощи массива сопоставления
function TfmSubstitution.EncryptDecryptString(strMsg: String):
String;
var
i: Integer;
begin
//преобразуем строку посимвольно
for i := 1 to Length(strMsg) do
strMsg[i] := RusDstAlphabet[strMsg[i]];
Result := strMsg;
end;
Теперь, используя все описанные функции, мы без труда можем зашифровать либо дешифровать сообщение. Например, чтобы зашифровать его, мы подготавливаем массив соответствия букв вызовом функции RecalcAlphabet с параметром 0. После чего для каждой строки открытого текста вызываем функцию EncryptDecryptString и в качестве результата получаем зашифрованную строку. Обработчики событий OnClick соответствующих кнопок шифруют либо дешифруют весь текст. Основная идея каждого из методов заключается в том, чтобы проверить корректность заданной перестановки, после чего производится предварительная подготовка алфавита сопоставления, и далее сообщение преобразуется (листинг 12.8).
...
Листинг 12.8.
Шифрование/дешифрование сообщения
procedure TfmSubstitution.btnEncryptMessageClick(Sender:
TObject);
var
i: Integer;
begin
//проверяем корректность ввода перестановки
if ValidateRearrangement then
begin
//создаем алфавит преобразования открытого текста
RecalcAlphabet(0);
//предотвращаем перерисовку компонента до тех пор,
//пока не зашифруем все строки сообщения
mmEncryptMessage.Lines.BeginUpdate;
//очищаем текстовый редактор
mmEncryptMessage.Clear;
//шифруем открытый текст построчно
for i := 0 to mmDecryptMessage.Lines.Count – 1 do
mmEncryptMessage.Lines.Add(EncryptDecryptString
(mmDecryptMessage.Lines[i]));
//разрешаем перерисовку компонента
mmEncryptMessage.Lines.EndUpdate;
end
else
MessageDlg('Ошибка: символы подстановки заданы неверно',
mtError, [mbOk], 0);
end;
procedure TfmSubstitution.btnDecpyptMessageClick(Sender:
TObject);
var
i: Integer;
begin
//проверяем корректность ввода перестановки
if ValidateRearrangement then
begin
//создаем алфавит преобразования шифрованного текста
RecalcAlphabet(1);
