1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
| unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Grids, ValEdit, XPMan;
type
TRusDstAlphabet = array [Char] of Char;
Tdecryptor1 = class(TForm)
mmDecryptMessage: TMemo;
mmEncryptMessage: TMemo;
btnEncryptMessage: TButton;
stringgrid1: TStringGrid;
stringgrid2: TStringGrid;
VleSubst: TValueListEditor;
xpmnfst1: TXPManifest;
procedure btnEncryptMessageClick(Sender: TObject);
private
{ Private declarations }
RusDstAlphabet: TRusDstAlphabet;
function ValidateRearrangement: Boolean;
procedure RecalcAlphabet(nKey: Integer);
function EncryptDecryptString(strMsg: String): String;
function UpCaseRus(Ch: Char): Char;
function LowCaseRus(Ch: Char): Char;
public
{ Public declarations }
end;
var
decryptor1: Tdecryptor1;
i:Integer;
implementation
{$R *.dfm}
uses Unit1;
// проверяет корректность перестановки введенной пользователем
function Tdecryptor1.ValidateRearrangement: Boolean;
var
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;
function Tdecryptor1.UpCaseRus(Ch: Char): Char;
begin
if Ch = 'ё' then Ch := 'Е';
if Ch in ['а'..'я'] then Dec(Ch, 32);
Result := Ch;
end;
function Tdecryptor1.LowCaseRus(Ch: Char): Char;
begin
if Ch = 'Ё' then Ch := 'е';
if Ch in ['А'..'Я'] then Inc(Ch, 32);
Result := Ch;
end;
procedure Tdecryptor1.RecalcAlphabet(nKey: Integer);
var
Ch: Char;
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;
procedure Tdecryptor1.btnEncryptMessageClick(Sender: TObject);
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;
end. |
(
