[Delphi] DH Spider 1.0

Un programa en Delphi para buscar emails en Google,Bing o en un wordlist con paginas.

Se pueden guardar los resultados en logs , usa threads para ser mas rapido y borra repetidos en los resultados.

Una imagen :



El codigo :

// DH Spider 1.0
// (C) Doddy Hackman 2016

unit spider;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.ExtCtrls, Vcl.ComCtrls,
  Vcl.StdCtrls, Vcl.Styles.Utils.Menus, Vcl.Styles.Utils.SysStyleHook,
  Vcl.Styles.Utils.SysControls, Math, Vcl.Imaging.pngimage,
  Vcl.ImgList, DH_Searcher, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP, PerlRegex, OtlThreadPool, OtlComm, OtlTask,
  OtlTaskControl;

type
  TFormHome = class(TForm)
    imgLogo: TImage;
    pcMenu: TPageControl;
    tsLinks: TTabSheet;
    tsSpider: TTabSheet;
    status: TStatusBar;
    gbLinks: TGroupBox;
    lvLinks: TListView;
    gbEmailsFound: TGroupBox;
    lvEmailsFound: TListView;
    odOpenFile: TOpenDialog;
    sdSaveLogs: TSaveDialog;
    ilIconos: TImageList;
    ilIconos2: TImageList;
    tsSearcher: TTabSheet;
    tsAbout: TTabSheet;
    gbSearcher: TGroupBox;
    lblDork: TLabel;
    txtDork: TEdit;
    lblPages: TLabel;
    txtPages: TEdit;
    udPages: TUpDown;
    lblOption: TLabel;
    cmbOption: TComboBox;
    btnStartSearch: TButton;
    btnStopSearch: TButton;
    btnStartScan: TButton;
    btnStopScan: TButton;
    gbAbout: TGroupBox;
    about: TImage;
    panelAbout: TPanel;
    labelAbout: TLabel;
    pmLinksOptions: TPopupMenu;
    ItemLoadFromFile: TMenuItem;
    ItemSaveLinks: TMenuItem;
    ItemClearListLinks: TMenuItem;
    pmEmailsOptions: TPopupMenu;
    ItemSaveEmails: TMenuItem;
    ItemClearListEmails: TMenuItem;
    lblThreads: TLabel;
    txtThreads: TEdit;
    udThreads: TUpDown;
    procedure FormCreate(Sender: TObject);
    procedure btnStartSearchClick(Sender: TObject);
    procedure btnStopSearchClick(Sender: TObject);
    procedure btnStartScanClick(Sender: TObject);
    procedure btnStopScanClick(Sender: TObject);
    procedure ItemLoadFromFileClick(Sender: TObject);
    procedure ItemSaveEmailsClick(Sender: TObject);
    procedure ItemClearListLinksClick(Sender: TObject);
    procedure ItemClearListEmailsClick(Sender: TObject);
    function toma(page: string): string;
    procedure ItemSaveLinksClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    stop: boolean;
  end;

var
  FormHome: TFormHome;

implementation

{$R *.dfm}
// Functions

function message_box(title, message_text, type_message: string): string;
begin
  if not(title = '') and not(message_text = '') and not(type_message = '') then
  begin
    try
      begin
        if (type_message = 'Information') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONINFORMATION);
        end
        else if (type_message = 'Warning') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONWARNING);
        end
        else if (type_message = 'Question') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONQUESTION);
        end
        else if (type_message = 'Error') then
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONERROR);
        end
        else
        begin
          MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
            MB_ICONINFORMATION);
        end;
        Result := '[+] MessageBox : OK';
      end;
    except
      begin
        Result := '[-] Error';
      end;
    end;
  end
  else
  begin
    Result := '[-] Error';
  end;
end;

function savefile(archivo, texto: string): bool;
var
  open_file: TextFile;
begin
  try
    begin
      AssignFile(open_file, archivo);
      FileMode := fmOpenWrite;

      if FileExists(archivo) then
      begin
        Append(open_file);
      end
      else
      begin
        Rewrite(open_file);
      end;

      Write(open_file, texto);
      CloseFile(open_file);
      Result := True;
    end;
  except
    Result := False;
  end;
end;

//

procedure TFormHome.FormCreate(Sender: TObject);
begin
  UseLatestCommonDialogs := False;
  odOpenFile.InitialDir := GetCurrentDir;
  odOpenFile.Filter := 'TXT files (*.txt)|*.TXT';
  sdSaveLogs.InitialDir := GetCurrentDir;
  sdSaveLogs.Filter := 'TXT files (*.txt)|*.TXT';
end;

procedure TFormHome.btnStartSearchClick(Sender: TObject);
var
  searcher: T_DH_Searcher;
  links: other_array_searcher;
  i: integer;
  dork: string;
  count: integer;
  counter: integer;
begin
  counter := 0;
  dork := txtDork.Text;
  count := StrToInt(txtPages.Text);
  if not(dork = '') and (count > 0) then
  begin
    GlobalOmniThreadPool.MaxExecuting := StrToInt(txtThreads.Text) *
      System.CPUCount;
    searcher := T_DH_Searcher.Create();

    CreateTask(
      procedure(const task: IOmniTask)
      var
        dork_to_load: string;
        pages_to_load: integer;
      begin

        dork_to_load := task.Param['dork'].AsString;
        pages_to_load := task.Param['pages'].AsInteger;

        status.Panels[0].Text := '[+] Searching ...';
        FormHome.Update;

        if (cmbOption.Text = 'Google') then
        begin
          links := searcher.search_google(dork, count);
        end;
        if (cmbOption.Text = 'Bing') then
        begin
          links := searcher.search_bing(dork, count);
        end;

      end).SetParameter('dork', dork).SetParameter('pages', count)
      .Unobserved.Schedule;

    while GlobalOmniThreadPool.CountExecuting +
      GlobalOmniThreadPool.CountQueued > 0 do
    begin
      Application.ProcessMessages;
    end;

    For i := Low(links) to High(links) do
    begin
      with lvLinks.Items.Add do
      begin
        Caption := links[i];
        Inc(counter);
      end;
    end;
    searcher.Free();
    gbLinks.Caption := 'Links Found : ' + IntToStr(counter);
    if (counter > 0) then
    begin
      status.Panels[0].Text := '[+] Links Found : ' + IntToStr(counter);
      FormHome.Update;
      message_box('DH Spider 1.0', 'Links Found : ' + IntToStr(counter),
        'Information');
    end
    else
    begin
      status.Panels[0].Text := '[-] Links not found';
      FormHome.Update;
      message_box('DH Spider 1.0', 'Links not found', 'Warning');
    end;
  end
  else
  begin
    message_box('DH Spider 1.0', 'Complete the form', 'Warning');
  end;
end;

procedure TFormHome.btnStopSearchClick(Sender: TObject);
begin
  GlobalOmniThreadPool.CancelAll;
  status.Panels[0].Text := '[+] Stopped';
  FormHome.Update;
  message_box('DH Spider 1.0', 'Scan Stopped', 'Information');
end;

function TFormHome.toma(page: string): string;
var
  nave: TIdHTTP;
  code: string;
begin
  code := '';
  try
    begin
      nave := TIdHTTP.Create(nil);
      nave.Request.UserAgent :=
        'Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:25.0) Gecko/20100101 Firefox/25.0';
      code := nave.Get(page);
      nave.Free();
    end;
  except
    begin
      //
    end;
  end;
  Result := code;
end;

procedure TFormHome.btnStartScanClick(Sender: TObject);
var
  page, code, email: string;
  emails: TStringList;
  links: TStringList;
  link: string;
  i, j: integer;
  regex: TPerlRegEx;
  new_item: TListItem;
  counter: integer;
begin
  GlobalOmniThreadPool.MaxExecuting := StrToInt(txtThreads.Text) *
    System.CPUCount;
  counter := 0;
  i := 0;
  j := 0;
  emails := TStringList.Create();
  links := TStringList.Create();
  if (lvLinks.Items.count > 0) then
  begin
    for i := 0 to lvLinks.Items.count - 1 do
    begin
      Application.ProcessMessages;
      page := lvLinks.Items[i].Caption;

      CreateTask(
        procedure(const task: IOmniTask)
        var
          page_to_load: string;
        begin

          page_to_load := task.Param['page'].AsString;

          status.Panels[0].Text := '[+] Checking page : ' +
            page_to_load + ' ...';
          FormHome.Update;

          code := toma(page_to_load);

          regex := TPerlRegEx.Create();

          regex.regex := '[A-Z0-9._%+-]+\@[A-Z0-9.-]+\.[A-Z]{2,4}';
          regex.options := [preCaseLess];
          regex.Subject := code;

          while regex.MatchAgain do
          begin
            Inc(counter);
            new_item := lvEmailsFound.Items.Add;
            new_item.Caption := regex.Groups[0];
            new_item.SubItems.Add(page_to_load);
          end;

          regex.Free();

        end).SetParameter('page', page).Unobserved.Schedule;

    end;

    while GlobalOmniThreadPool.CountExecuting +
      GlobalOmniThreadPool.CountQueued > 0 do
    begin
      Application.ProcessMessages;
    end;

    if (counter > 0) then
    begin
      gbEmailsFound.Caption := 'Emails Found : ' + IntToStr(counter);
      status.Panels[0].Text := '[+] Emails Found : ' + IntToStr(counter);
      FormHome.Update;
      message_box('DH Spider 1.0', 'Emails Found : ' + IntToStr(counter),
        'Information');
    end
    else
    begin
      status.Panels[0].Text := '[-] Emails not found';
      FormHome.Update;
      message_box('DH Spider 1.0', 'Emails not found', 'Warning');
    end;
  end
  else
  begin
    message_box('DH Spider 1.0', 'Links not found', 'Warning');
  end;
end;

procedure TFormHome.btnStopScanClick(Sender: TObject);
begin
  GlobalOmniThreadPool.CancelAll;
  stop := True;
  status.Panels[0].Text := '[+] Stopped';
  FormHome.Update;
  message_box('DH Spider 1.0', 'Scan Stopped', 'Information');
end;

procedure TFormHome.ItemClearListEmailsClick(Sender: TObject);
begin
  gbEmailsFound.Caption := 'Emails Found';
  lvEmailsFound.Items.Clear;
  message_box('DH Spider 1.0', 'List Cleaned', 'Information');
end;

procedure TFormHome.ItemClearListLinksClick(Sender: TObject);
begin
  gbLinks.Caption := 'Links Found';
  lvLinks.Items.Clear();
  message_box('DH Spider 1.0', 'List Cleaned', 'Information');
end;

procedure TFormHome.ItemLoadFromFileClick(Sender: TObject);
var
  filename: string;
  lineas: TStringList;
  i: integer;
  counter: integer;
begin
  counter := 0;
  if (odOpenFile.Execute) then
  begin
    filename := odOpenFile.filename;
    if (FileExists(filename)) then
    begin
      status.Panels[0].Text := '[+] Loading file ...';
      FormHome.Update;
      lineas := TStringList.Create();
      lineas.Loadfromfile(filename);
      for i := 0 to lineas.count - 1 do
      begin
        with lvLinks.Items.Add do
        begin
          Caption := lineas[i];
          Inc(counter);
        end;
      end;
      lineas.Free;
      gbLinks.Caption := 'Links Found : ' + IntToStr(counter);
      if (counter > 0) then
      begin
        status.Panels[0].Text := '[+] Links Found : ' + IntToStr(counter);
        FormHome.Update;
        message_box('DH Spider 1.0', 'Links Found : ' + IntToStr(counter),
          'Information');
      end
      else
      begin
        status.Panels[0].Text := '[-] Links not found';
        FormHome.Update;
        message_box('DH Spider 1.0', 'Links not found', 'Warning');
      end;
    end
    else
    begin
      message_box('DH Spider 1.0', 'File not found', 'Warning');
    end;
  end;
end;

procedure TFormHome.ItemSaveEmailsClick(Sender: TObject);
var
  i: integer;
  i2: integer;
  emails: TStringList;
begin
  if (lvEmailsFound.Items.count > 0) then
  begin
    if (sdSaveLogs.Execute) then
    begin

      emails := TStringList.Create();

      for i := 0 to lvEmailsFound.Items.count - 1 do
      begin
        emails.Add(lvEmailsFound.Items[i].Caption);
      end;

      emails.Sorted := True;

      for i2 := 0 to emails.count - 1 do
      begin
        savefile(sdSaveLogs.filename, emails[i2] + sLineBreak);
      end;

      emails.Free();

      status.Panels[0].Text := '[+] Logs saved';
      FormHome.Update;

      message_box('DH Spider 1.0', 'Emails saved', 'Information');
    end
    else
    begin
      message_box('DH Spider 1.0', 'File not found', 'Warning');
    end;
  end
  else
  begin
    message_box('DH Spider 1.0', 'Emails not found', 'Warning');
  end;
end;

procedure TFormHome.ItemSaveLinksClick(Sender: TObject);
var
  i: integer;
  i2: integer;
  links: TStringList;
begin
  if (lvLinks.Items.count > 0) then
  begin
    if (sdSaveLogs.Execute) then
    begin

      links := TStringList.Create();

      for i := 0 to lvLinks.Items.count - 1 do
      begin
        links.Add(lvLinks.Items[i].Caption);
      end;

      links.Sorted := True;

      for i2 := 0 to links.count - 1 do
      begin
        savefile(sdSaveLogs.filename, links[i2] + sLineBreak);
      end;

      links.Free();

      status.Panels[0].Text := '[+] Logs saved';
      FormHome.Update;

      message_box('DH Spider 1.0', 'Links saved', 'Information');
    end
    else
    begin
      message_box('DH Spider 1.0', 'File not found', 'Warning');
    end;
  end
  else
  begin
    message_box('DH Spider 1.0', 'Links not found', 'Warning');
  end;
end;

end.

// The End ?

Si quieren bajar el programa lo pueden hacer de aca :

You are not allowed to view links. Register or Login.
You are not allowed to view links. Register or Login.

Eso seria todo.