[Delphi] DH Spider 1.0

  • 0 Respuestas
  • 3650 Vistas

0 Usuarios y 1 Visitante están viendo este tema.

Desconectado BigBear

  • *
  • Underc0der
  • Mensajes: 543
  • Actividad:
    0%
  • Reputación 3
    • Ver Perfil

[Delphi] DH Spider 1.0

  • en: Noviembre 25, 2016, 11:43:41 am
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 :

Código: You are not allowed to view links. Register or Login
// 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';[/li][/list]
          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 ...';[/li][/list]
            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);[/li][/list]
          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';[/li][/list]
      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 : ' +[/li][/list]
                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);[/li][/list]
          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';[/li][/list]
      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 ...';[/li][/list]
          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);[/li][/list]
            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';[/li][/list]
          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';[/li][/list]
          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.

 

[Sintaxis general de Delphi] By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3359
Último mensaje Febrero 24, 2010, 04:35:15 pm
por ANTRAX
Eliminar acentos y otros agregados de un caracter/cadena Delphi 2009

Iniciado por ANTRAX

Respuestas: 0
Vistas: 5202
Último mensaje Febrero 24, 2010, 04:57:14 pm
por ANTRAX
1er troyano en Delphi By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 5456
Último mensaje Febrero 24, 2010, 04:34:48 pm
por ANTRAX
[Delphi] Creacion de un Troyano de conexion inversa

Iniciado por BigBear

Respuestas: 4
Vistas: 6529
Último mensaje Mayo 05, 2017, 09:10:55 am
por _inicio_cerrarsesión
[Delphi] Project Spartacus 1.0 (Regalo de Navidad)

Iniciado por BigBear

Respuestas: 2
Vistas: 2875
Último mensaje Diciembre 26, 2014, 11:54:34 pm
por n4pst3r