Перебор ключей [Delphi]

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by StealthMaster, 17 Nov 2009.

  1. StealthMaster

    StealthMaster Member

    Joined:
    3 Dec 2008
    Messages:
    52
    Likes Received:
    11
    Reputations:
    0
    Здравствуйте, пишу программу по шифрованию, расшифровке и дешифровке текста по алгоритму Энигмы (несколько изменяющихся на каждом следующем шаге шифрования подстановок).

    Шифрование и расшифровка написаны, собственно это одна и та же процедура.
    Дешифровка осуществляется по следующему принципу: известно все кроме ключа. Предполагается перебрать все ключи: запускаем процедуру расшифровки с первым ключом, получаем результат, проверяем в нем биграммы и делаем частотный анализ, если он похож на русский текст, то сохраняем в списке расшифрованных текстов. Но здесь как раз возникли проблемы: необходимо перебрать примерно 16кк ключей (64*64*64). Я планировал сделать это с помощью нескольких потоков, но не знаю как осуществить управление между ними, ведь после того как завершил работу первый поток его снова нужно запустить, но уже с новыми параметрами. Собственно вот вопрос: как организовать перебор ключей с помощью нескольких потоков.

    Если нужно, мой код:
    Code:
    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;