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 : [Enlace externo eliminado para invitados].
[Enlace externo eliminado para invitados].
Eso seria todo.