StealthMaster
17.11.2009, 14:51
Здравствуйте, пишу программу по шифрованию, расшифровке и дешифровке текста по алгоритму Энигмы (несколько изменяющихся на каждом следующем шаге шифрования подстановок).
Шифрование и расшифровка написаны, собственно это одна и та же процедура.
Дешифровка осуществляется по следующему принципу: известно все кроме ключа. Предполагается перебрать все ключи: запускаем процедуру расшифровки с первым ключом, получаем результат, проверяем в нем биграммы и делаем частотный анализ, если он похож на русский текст, то сохраняем в списке расшифрованных текстов. Но здесь как раз возникли проблемы: необходимо перебрать примерно 16кк ключей (64*64*64). Я планировал сделать это с помощью нескольких потоков, но не знаю как осуществить управление между ними, ведь после того как завершил работу первый поток его снова нужно запустить, но уже с новыми параметрами. Собственно вот вопрос: как организовать перебор ключей с помощью нескольких потоков.
Если нужно, мой код:
const
Alphabet = 'абвгдеёжзийклмнопрстуфхц шщъыьэюя0123456789$!.,?;*(){}+=:/[]@\^"';
type
Rotor = array [1..64] of byte;
type
TCrypt = class(TThread)
private
CloseText: TStrings;
OpenText: TStrings;
key: string;
textlength: longword;
R1, R2, R3: Rotor;
ComPanel: Rotor;
Reflector: Rotor;
Action: Char;
procedure CreateObjects;
procedure SetByKey;
procedure ChangeComPanel(index1, index2: byte);
function RollRotorLeft(R:Rotor; count: byte =1): Rotor;
function RollRotorRight(R:Rotor; count: byte =1): Rotor;
procedure RollRotors(Direction: char);
function GetCharNumber(chr: char): byte;
function FindNumber(R: Rotor; Num: byte): byte;
procedure Encrypt;
protected
procedure Execute; override;
end;
type
TStats = class
counter: array [1..33] of integer; // счетчики для частотного анализа
bigramms: string; // список часто встречающихся биграмм
bscounter: integer; // счетчик встретившихся наивероятнейших биграмм
bcounter: int64; // количество исследованных биграмм
text: TStrings;
textlength: longword;
constructor create;
destructor destroy;
procedure UpdateCounter;
procedure UpdateBCounter;
function FrequencyAnalysis: boolean;
function BigrammsAnalysis: boolean;
end;
procedure TCrypt.CreateObjects;
var
i: byte;
begin
// заполним роторы, коммутационную панель и рефлектор
for i := 1 to 64 do
begin
R1[i] := i;
R2[i] := i;
R3[i] := i;
ComPanel[i] := i;
if i = 32 then
Reflector[i] := 64
else
Reflector[i] := (i + 32) mod 64;
end; // for
// создадим строковые списки OpenText и CloseText
OpenText := TStringList.Create;
OpenText.Clear;
CloseText := TStringList.Create;
CloseText.Clear;
end;
procedure TCrypt.SetByKey;
var
i: byte;
tmpstr: string;
begin
// крутим роторы нужное количество раз
R1 := RollRotorLeft(cR1, GetCharNumber(key[1])-1);
R2 := RollRotorLeft(cR2, GetCharNumber(key[2])-1);
R3 := RollRotorLeft(cR3, GetCharNumber(key[3])-1);
// генерируем новую коммутационную панель
for i := 1 to 64 do
ComPanel[i] := i;
// меняем коммутацию символов согласно ключу
if (length(key) > 4) then
begin
tmpstr := copy(key, 4, length(key)-3);
for i := 0 to Round(length(tmpstr)/2)-1 do
ChangeComPanel(GetCharNumber(tmpstr[2*i+1]), GetCharNumber(tmpstr[2*i+2]));
end;
end;
procedure TCrypt.ChangeComPanel(index1, index2: byte);
var
tmp1, tmp2: byte;
begin
// если изменяется соединение задействованных контактов, сбросить их
tmp1 := ComPanel[index1];
Companel[tmp1] := tmp1;
tmp2 := ComPanel[index2];
Companel[tmp2] := tmp2;
// изменяем способ коммутации
Companel[index1] := index2;
Companel[index2] := index1;
// прорисовываем изменения
fmMain.sgComPanel.Cells[tmp1-1,1] := Alphabet[ComPanel[tmp1]];
fmMain.sgComPanel.Cells[tmp2-1,1] := Alphabet[ComPanel[tmp2]];
fmMain.sgComPanel.Cells[index1-1,1] := Alphabet[ComPanel[index1]];
fmMain.sgComPanel.Cells[index2-1,1] := Alphabet[ComPanel[index2]];
end;
procedure TCrypt.RollRotors(Direction: char);
begin
case Direction of
'L','l':
begin
R1 := RollRotorLeft(R1);
if (textlength mod 7 = 0) then
R2 := RollRotorLeft(R2);
if (textlength mod 13 = 0) then
R3 := RollRotorLeft(R3);
end; // L
'R','r':
begin
R1 := RollRotorRight(R1);
if (textlength mod 7 = 0) then
R2 := RollRotorRight(R2);
if (textlength mod 13 = 0) then
R3 := RollRotorRight(R3);
end; // R
end; // case
end;
function TCrypt.RollRotorLeft(R:Rotor; count: byte =1): Rotor;
var
i, j, tmp: byte;
tmpR: Rotor;
begin
tmpR := R;
// крутим ротор count раз
for i := 1 to count do
begin
// запоминаем первый символ
tmp := tmpR[1];
// смещаем все символы на 1
for j := 1 to 63 do
tmpR[j] := tmpR[j+1];
// присваиваем последнему значение первого
tmpR[64] := tmp;
end;
// выводим результат
Result := tmpR;
end;
function TCrypt.RollRotorRight(R:Rotor; count: byte =1): Rotor;
var
i, j, tmp: byte;
tmpR: Rotor;
begin
tmpR := R;
// крутим ротор count раз
for i := 1 to count do
begin
// запоминаем последний символ
tmp := tmpR[64];
// смещаем все символы на 1
for j := 63 downto 1 do
tmpR[j+1] := tmpR[j];
// присваиваем первому значение последнего
tmpR[1] := tmp;
end;
// выводим результат
Result := tmpR;
end;
function TCrypt.GetCharNumber(chr: char): byte;
begin
Result := POS(chr, Alphabet);
end;
function TCrypt.FindNumber(R: Rotor; Num: byte): byte;
var
i: integer;
begin
// просматриваем все символы алфавита
for i := 1 to 64 do
// если i-тый символ ротора искомый, то останавливаемся и выводим результат
if R[i] = Num then
begin
Result := i;
exit;
end;
Result := 0;
end;
procedure TCrypt.Encrypt;
var
tmp: byte;
i, j: integer;
tmpstr: string;
begin
textlength := 0;
// устанавливаем все параметры по ключу
SetByKey;
for i := 0 to OpenText.Count - 1 do
begin
// используем временную строку для шифрования строки открытого текста
tmpstr := '';
for j := 1 to length(OpenText[i]) do
begin
// увеличиваем счетчик длины текста и крутим роторы
inc(textlength);
RollRotors('L');
// если символ из алфавита, то зашифровываем его
if (POS(OpenText[i][j], Alphabet) <> 0) then
begin
// совершаем переходы по подстановкам
tmp := GetCharNumber(OpenText[i][j]);
tmp := ComPanel[tmp];
tmp := R1[tmp];
tmp := R2[tmp];
tmp := R3[tmp];
tmp := Reflector[tmp];
tmp := FindNumber(R3, tmp);
tmp := FindNumber(R2, tmp);
tmp := FindNumber(R1, tmp);
tmp := ComPanel[tmp];
// выводим зашифрованный символ
tmpstr := tmpstr + Alphabet[tmp];
end // if
// если не из алфавита, то пропускаем
else
tmpstr := tmpstr + OpenText[i][j];
end; // for j
CloseText.Append(tmpstr);
end; // for i
end;
procedure TCrypt.Execute;
begin
case action of
'E', 'e': Encrypt;
end;
end;
constructor TStats.create;
var
i: integer;
begin
// сбросим счетчик частот
for i := 1 to 33 do
counter[i] := 0;
// сбросим счетчики биграмм и длины текста
bscounter := 0;
bcounter := 0;
textlength := 0;
text := TStringList.Create;
text.Clear;
// укажем ожидаемые биграммы
bigramms := 'ал ан ас ат ар ав ак ам ' +
'бо бы бе ба бр бу ' +
'во ва ви вы вс вн вл вр ' +
'го га гр гл ги гв ' +
'де да ди до дн ду др дв ' +
'ен ет ер ес ел ев ем еи ' +
'же жи жд жа жн ' +
'за зн зв зо зм зд ' +
'ис ин ив ии ие им ик из ' +
'ко ка ки кр ку кт кл ке ' +
'ли ле ло ла ль ля лю лу ' +
'ми ме мо му ма мн мп мы ' +
'но на ни не ны нн ну ' +
'ов ос от ор ои од он ом ' +
'по пр пе па пу пи пл ' +
'ра ре ро ри ру ря ры рн ' +
'ст ск со ся се сь сс сн ' +
'то та те ти ть тв тр тс ' +
'ут уп ус уд ун ую уж ' +
'фи фе фо фа фе фо фа ' +
'хо хи хс хн хв хп хр ' +
'ци це ца цы ' +
'че чи чт чн ' +
'ше ши шн ша шо шл ' +
'ще щи ща ' +
'ыл ых ые ым ыи ыв ыс ын ' +
'ьн ьк ьв ьп ьс ье ьо ьи ' +
'эн эт эр эс эк ' +
'юд ют ющ юц юн юп ' +
'яв яс ят яп яд як ям ял';
end;
destructor TStats.destroy;
begin
end;
procedure TStats.UpdateCounter;
// процедура пересчета частот символов в тексте
var
i, j: integer;
begin
if (text.Count >= 0) then
for i := 0 to text.count - 1 do
for j := 1 to length(text[i]) do
case text[i][j] of
'ё','Ё':
begin
inc(textlength);
inc(counter[7]);
continue;
end;
'а'..'я':
begin
inc(textlength);
inc(counter[ord(text[i][j])-223]);
continue;
end;
'А'..'Я':
begin
inc(counter[ord(text[i][j])-191]);
inc(textlength);
end;
end;
end;
procedure TStats.UpdateBCounter;
// процедура пересчета биграмм в тексте
var
i, j: integer;
begin
if (text.Count >= 0) then
for i := 0 to text.count - 1 do
for j := 2 to length(text[i]) do
case text[i][j] of
'А'..'я':
begin
inc(bcounter);
if (POS(text[i][j-1]+text[i][j],bigramms) <> 0) then
inc(bscounter);
end;
end; // case
end;
function TStats.FrequencyAnalysis: Boolean;
var
tmp: longint;
begin
// обозначим самые используемые символы
tmp := counter[1] + counter[3] + counter[6] + counter[10] + counter[11] +
counter[15] + counter[16] + counter[18] + counter[19] + counter[20];
// если эти символы встречаются чаще остальных, то текст похож на правильный
if (tmp > textlength - tmp) then
Result := true
else
Result := false;
end;
function TStats.BigrammsAnalysis: Boolean;
var
tmp: double;
begin
// на случай, если не встретилось символов из алфавита
if bcounter > 0 then
tmp := bscounter/bcounter
else
tmp := 0;
// если ожидаемых биграмм больше 70% то текст можно считать правильным
if (tmp > 0.7) then
Result := true
else
Result := false;
end;
procedure TfmMain.sbDecryptClick(Sender: TObject);
var
DecryptThread: TCrypt;
Stats: TStats;
begin
// нужно запустить несколько таких потоков
DecryptThread := TCrypt.Create(true);
Stats := TStats.create;
// smResultText - Memo
// BruteKey - текущий ключ - строка вида 'xyz'
// ResultTexts - массив TStrings расшифрованных текстов
smResultText.Lines.Clear;
DecryptThread.CreateObjects;
DecryptThread.OpenText := smInputText.Lines;
DecryptThread.key := BruteKey;
DecryptThread.action := 'E';
DecryptThread.Execute;
Stats.text := DecryptThread.CloseText;
Stats.UpdateCounter;
Stats.UpdateBCounter;
if Stats.FrequencyAnalysis and Stats.BigrammsAnalysis then
ResultTexts := DecryptThread.CloseText;
DecryptThread.Terminate;
end;
Шифрование и расшифровка написаны, собственно это одна и та же процедура.
Дешифровка осуществляется по следующему принципу: известно все кроме ключа. Предполагается перебрать все ключи: запускаем процедуру расшифровки с первым ключом, получаем результат, проверяем в нем биграммы и делаем частотный анализ, если он похож на русский текст, то сохраняем в списке расшифрованных текстов. Но здесь как раз возникли проблемы: необходимо перебрать примерно 16кк ключей (64*64*64). Я планировал сделать это с помощью нескольких потоков, но не знаю как осуществить управление между ними, ведь после того как завершил работу первый поток его снова нужно запустить, но уже с новыми параметрами. Собственно вот вопрос: как организовать перебор ключей с помощью нескольких потоков.
Если нужно, мой код:
const
Alphabet = 'абвгдеёжзийклмнопрстуфхц шщъыьэюя0123456789$!.,?;*(){}+=:/[]@\^"';
type
Rotor = array [1..64] of byte;
type
TCrypt = class(TThread)
private
CloseText: TStrings;
OpenText: TStrings;
key: string;
textlength: longword;
R1, R2, R3: Rotor;
ComPanel: Rotor;
Reflector: Rotor;
Action: Char;
procedure CreateObjects;
procedure SetByKey;
procedure ChangeComPanel(index1, index2: byte);
function RollRotorLeft(R:Rotor; count: byte =1): Rotor;
function RollRotorRight(R:Rotor; count: byte =1): Rotor;
procedure RollRotors(Direction: char);
function GetCharNumber(chr: char): byte;
function FindNumber(R: Rotor; Num: byte): byte;
procedure Encrypt;
protected
procedure Execute; override;
end;
type
TStats = class
counter: array [1..33] of integer; // счетчики для частотного анализа
bigramms: string; // список часто встречающихся биграмм
bscounter: integer; // счетчик встретившихся наивероятнейших биграмм
bcounter: int64; // количество исследованных биграмм
text: TStrings;
textlength: longword;
constructor create;
destructor destroy;
procedure UpdateCounter;
procedure UpdateBCounter;
function FrequencyAnalysis: boolean;
function BigrammsAnalysis: boolean;
end;
procedure TCrypt.CreateObjects;
var
i: byte;
begin
// заполним роторы, коммутационную панель и рефлектор
for i := 1 to 64 do
begin
R1[i] := i;
R2[i] := i;
R3[i] := i;
ComPanel[i] := i;
if i = 32 then
Reflector[i] := 64
else
Reflector[i] := (i + 32) mod 64;
end; // for
// создадим строковые списки OpenText и CloseText
OpenText := TStringList.Create;
OpenText.Clear;
CloseText := TStringList.Create;
CloseText.Clear;
end;
procedure TCrypt.SetByKey;
var
i: byte;
tmpstr: string;
begin
// крутим роторы нужное количество раз
R1 := RollRotorLeft(cR1, GetCharNumber(key[1])-1);
R2 := RollRotorLeft(cR2, GetCharNumber(key[2])-1);
R3 := RollRotorLeft(cR3, GetCharNumber(key[3])-1);
// генерируем новую коммутационную панель
for i := 1 to 64 do
ComPanel[i] := i;
// меняем коммутацию символов согласно ключу
if (length(key) > 4) then
begin
tmpstr := copy(key, 4, length(key)-3);
for i := 0 to Round(length(tmpstr)/2)-1 do
ChangeComPanel(GetCharNumber(tmpstr[2*i+1]), GetCharNumber(tmpstr[2*i+2]));
end;
end;
procedure TCrypt.ChangeComPanel(index1, index2: byte);
var
tmp1, tmp2: byte;
begin
// если изменяется соединение задействованных контактов, сбросить их
tmp1 := ComPanel[index1];
Companel[tmp1] := tmp1;
tmp2 := ComPanel[index2];
Companel[tmp2] := tmp2;
// изменяем способ коммутации
Companel[index1] := index2;
Companel[index2] := index1;
// прорисовываем изменения
fmMain.sgComPanel.Cells[tmp1-1,1] := Alphabet[ComPanel[tmp1]];
fmMain.sgComPanel.Cells[tmp2-1,1] := Alphabet[ComPanel[tmp2]];
fmMain.sgComPanel.Cells[index1-1,1] := Alphabet[ComPanel[index1]];
fmMain.sgComPanel.Cells[index2-1,1] := Alphabet[ComPanel[index2]];
end;
procedure TCrypt.RollRotors(Direction: char);
begin
case Direction of
'L','l':
begin
R1 := RollRotorLeft(R1);
if (textlength mod 7 = 0) then
R2 := RollRotorLeft(R2);
if (textlength mod 13 = 0) then
R3 := RollRotorLeft(R3);
end; // L
'R','r':
begin
R1 := RollRotorRight(R1);
if (textlength mod 7 = 0) then
R2 := RollRotorRight(R2);
if (textlength mod 13 = 0) then
R3 := RollRotorRight(R3);
end; // R
end; // case
end;
function TCrypt.RollRotorLeft(R:Rotor; count: byte =1): Rotor;
var
i, j, tmp: byte;
tmpR: Rotor;
begin
tmpR := R;
// крутим ротор count раз
for i := 1 to count do
begin
// запоминаем первый символ
tmp := tmpR[1];
// смещаем все символы на 1
for j := 1 to 63 do
tmpR[j] := tmpR[j+1];
// присваиваем последнему значение первого
tmpR[64] := tmp;
end;
// выводим результат
Result := tmpR;
end;
function TCrypt.RollRotorRight(R:Rotor; count: byte =1): Rotor;
var
i, j, tmp: byte;
tmpR: Rotor;
begin
tmpR := R;
// крутим ротор count раз
for i := 1 to count do
begin
// запоминаем последний символ
tmp := tmpR[64];
// смещаем все символы на 1
for j := 63 downto 1 do
tmpR[j+1] := tmpR[j];
// присваиваем первому значение последнего
tmpR[1] := tmp;
end;
// выводим результат
Result := tmpR;
end;
function TCrypt.GetCharNumber(chr: char): byte;
begin
Result := POS(chr, Alphabet);
end;
function TCrypt.FindNumber(R: Rotor; Num: byte): byte;
var
i: integer;
begin
// просматриваем все символы алфавита
for i := 1 to 64 do
// если i-тый символ ротора искомый, то останавливаемся и выводим результат
if R[i] = Num then
begin
Result := i;
exit;
end;
Result := 0;
end;
procedure TCrypt.Encrypt;
var
tmp: byte;
i, j: integer;
tmpstr: string;
begin
textlength := 0;
// устанавливаем все параметры по ключу
SetByKey;
for i := 0 to OpenText.Count - 1 do
begin
// используем временную строку для шифрования строки открытого текста
tmpstr := '';
for j := 1 to length(OpenText[i]) do
begin
// увеличиваем счетчик длины текста и крутим роторы
inc(textlength);
RollRotors('L');
// если символ из алфавита, то зашифровываем его
if (POS(OpenText[i][j], Alphabet) <> 0) then
begin
// совершаем переходы по подстановкам
tmp := GetCharNumber(OpenText[i][j]);
tmp := ComPanel[tmp];
tmp := R1[tmp];
tmp := R2[tmp];
tmp := R3[tmp];
tmp := Reflector[tmp];
tmp := FindNumber(R3, tmp);
tmp := FindNumber(R2, tmp);
tmp := FindNumber(R1, tmp);
tmp := ComPanel[tmp];
// выводим зашифрованный символ
tmpstr := tmpstr + Alphabet[tmp];
end // if
// если не из алфавита, то пропускаем
else
tmpstr := tmpstr + OpenText[i][j];
end; // for j
CloseText.Append(tmpstr);
end; // for i
end;
procedure TCrypt.Execute;
begin
case action of
'E', 'e': Encrypt;
end;
end;
constructor TStats.create;
var
i: integer;
begin
// сбросим счетчик частот
for i := 1 to 33 do
counter[i] := 0;
// сбросим счетчики биграмм и длины текста
bscounter := 0;
bcounter := 0;
textlength := 0;
text := TStringList.Create;
text.Clear;
// укажем ожидаемые биграммы
bigramms := 'ал ан ас ат ар ав ак ам ' +
'бо бы бе ба бр бу ' +
'во ва ви вы вс вн вл вр ' +
'го га гр гл ги гв ' +
'де да ди до дн ду др дв ' +
'ен ет ер ес ел ев ем еи ' +
'же жи жд жа жн ' +
'за зн зв зо зм зд ' +
'ис ин ив ии ие им ик из ' +
'ко ка ки кр ку кт кл ке ' +
'ли ле ло ла ль ля лю лу ' +
'ми ме мо му ма мн мп мы ' +
'но на ни не ны нн ну ' +
'ов ос от ор ои од он ом ' +
'по пр пе па пу пи пл ' +
'ра ре ро ри ру ря ры рн ' +
'ст ск со ся се сь сс сн ' +
'то та те ти ть тв тр тс ' +
'ут уп ус уд ун ую уж ' +
'фи фе фо фа фе фо фа ' +
'хо хи хс хн хв хп хр ' +
'ци це ца цы ' +
'че чи чт чн ' +
'ше ши шн ша шо шл ' +
'ще щи ща ' +
'ыл ых ые ым ыи ыв ыс ын ' +
'ьн ьк ьв ьп ьс ье ьо ьи ' +
'эн эт эр эс эк ' +
'юд ют ющ юц юн юп ' +
'яв яс ят яп яд як ям ял';
end;
destructor TStats.destroy;
begin
end;
procedure TStats.UpdateCounter;
// процедура пересчета частот символов в тексте
var
i, j: integer;
begin
if (text.Count >= 0) then
for i := 0 to text.count - 1 do
for j := 1 to length(text[i]) do
case text[i][j] of
'ё','Ё':
begin
inc(textlength);
inc(counter[7]);
continue;
end;
'а'..'я':
begin
inc(textlength);
inc(counter[ord(text[i][j])-223]);
continue;
end;
'А'..'Я':
begin
inc(counter[ord(text[i][j])-191]);
inc(textlength);
end;
end;
end;
procedure TStats.UpdateBCounter;
// процедура пересчета биграмм в тексте
var
i, j: integer;
begin
if (text.Count >= 0) then
for i := 0 to text.count - 1 do
for j := 2 to length(text[i]) do
case text[i][j] of
'А'..'я':
begin
inc(bcounter);
if (POS(text[i][j-1]+text[i][j],bigramms) <> 0) then
inc(bscounter);
end;
end; // case
end;
function TStats.FrequencyAnalysis: Boolean;
var
tmp: longint;
begin
// обозначим самые используемые символы
tmp := counter[1] + counter[3] + counter[6] + counter[10] + counter[11] +
counter[15] + counter[16] + counter[18] + counter[19] + counter[20];
// если эти символы встречаются чаще остальных, то текст похож на правильный
if (tmp > textlength - tmp) then
Result := true
else
Result := false;
end;
function TStats.BigrammsAnalysis: Boolean;
var
tmp: double;
begin
// на случай, если не встретилось символов из алфавита
if bcounter > 0 then
tmp := bscounter/bcounter
else
tmp := 0;
// если ожидаемых биграмм больше 70% то текст можно считать правильным
if (tmp > 0.7) then
Result := true
else
Result := false;
end;
procedure TfmMain.sbDecryptClick(Sender: TObject);
var
DecryptThread: TCrypt;
Stats: TStats;
begin
// нужно запустить несколько таких потоков
DecryptThread := TCrypt.Create(true);
Stats := TStats.create;
// smResultText - Memo
// BruteKey - текущий ключ - строка вида 'xyz'
// ResultTexts - массив TStrings расшифрованных текстов
smResultText.Lines.Clear;
DecryptThread.CreateObjects;
DecryptThread.OpenText := smInputText.Lines;
DecryptThread.key := BruteKey;
DecryptThread.action := 'E';
DecryptThread.Execute;
Stats.text := DecryptThread.CloseText;
Stats.UpdateCounter;
Stats.UpdateBCounter;
if Stats.FrequencyAnalysis and Stats.BigrammsAnalysis then
ResultTexts := DecryptThread.CloseText;
DecryptThread.Terminate;
end;