5
51zhan.com
Unregistered / Unconfirmed
GUEST, unregistred user!
unit SearchMailThread;
interface
uses
Classes, DB, ADODB, SysUtils, Forms;
type
TSearchMailThread = class(TThread)
private
Ok : boolean;
protected
procedure SearchMail;
procedure Execute;
override;
public
constructor Create();overload;
destructor destroy;
end;
implementation
uses Main;
{ TSearchMailThread }
constructor TSearchMailThread.Create;
begin
inherited Create(False);
FreeOnTerminate:= True;
end;
destructor TSearchMailThread.destroy;
begin
inherited Destroy;
end;
procedure TSearchMailThread.Execute;
begin
inherited;
FreeOnTerminate := True;
try
while not Terminateddo
begin
synchronize(SearchMail);
Application.ProcessMessages;
//if terminated then
break;
end;
finally
end;
end;
procedure TSearchMailThread.SearchMail;
begin
if not boolean(pos ('://', frmMain.combo_url.Text)) then
frmMain.combo_url.Text := 'http://'+frmMain.combo_url.Text;
frmMain.httpscan1.ProxyAddress:=frmMain.edt_proxy_ipaddress.Text;
frmMain.HttpScan1.ProxyPort:=integer(frmMain.edt_proxy_port.Text);
frmMain.HttpScan1.UserName:=trim(frmMain.edt_proxy_user.Text);
frmMain.HttpScan1.Password:=trim(frmMain.edt_proxy_password.Text);
frmMain.HttpScan1.FileOfResults:=frmMain.edt_searchresults.Text;
frmMain.HttpScan1.Retries:=integer(frmMain.edt_proxy_cs.Text);
frmMain.httpscan1.TimeOut:=integer(frmMain.edt_proxy_timeout.Text);
frmMain.HttpScan1.FileOfResults :=frmMain.edt_searchresults.text;
frmMain.HttpScan1.DepthSearchLevel:=integer(frmMain.edt_leverl.text);
ok:=frmMain.HttpScan1.Start(frmMain.combo_url.Text);
if Ok then
begin
frmMain.CountLinks := 0;
frmMain.combo_url.Text:=frmMain.HttpScan1.StartingUrl;
end;
if Terminated then
exit;
end;
end.
////////////////////////////////
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls,Inifiles,
Buttons, ExtCtrls, IdExplicitTLSClientServerBase, IdSMTPBase, THtScan,
Spin, ShellAPI, SearchMailThread, Grids, Gauges;
type
TfrmMain = class(TForm)
OpenDialog: TOpenDialog;
pgc1: TPageControl;
ts1: TTabSheet;
ts2: TTabSheet;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
Gauge: TGauge;
Label1: TLabel;
Label7: TLabel;
Label8: TLabel;
lblMailNum: TLabel;
lblWinNum: TLabel;
lblFailNum: TLabel;
Button1: TButton;
btnSend: TButton;
Minfo: TMemo;
StringGrid: TStringGrid;
butClose: TButton;
TabSheet2: TTabSheet;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
mmContent: TMemo;
edtFrom: TEdit;
edtSubject: TEdit;
TabSheet3: TTabSheet;
GroupBox1: TGroupBox;
Label2: TLabel;
Label3: TLabel;
edtDns: TEdit;
edtHeader: TEdit;
butSetupOk: TButton;
chk: TCheckBox;
Memo1: TMemo;
Panel2: TPanel;
SpeedButton2: TSpeedButton;
btn_tool_search: TSpeedButton;
sbStop: TSpeedButton;
combo_url: TEdit;
HttpScan1: THttpScan;
pgc2: TPageControl;
ts3: TTabSheet;
ts5: TTabSheet;
Panel1: TPanel;
check_only_mail: TCheckBox;
Panel3: TPanel;
StatusBar1: TStatusBar;
SaveDialog1: TSaveDialog;
edt_proxy_ipaddress: TEdit;
edt_proxy_port: TEdit;
edt_proxy_user: TEdit;
edt_proxy_password: TEdit;
edt_searchresults: TEdit;
edt_proxy_cs: TEdit;
edt_proxy_timeout: TEdit;
edt_leverl: TEdit;
Memo_tmp_mail: TMemo;
SpinEdit1: TSpinEdit;
Label9: TLabel;
Memo2: TMemo;
procedure butCloseClick(Sender: TObject);
procedure HttpScan1LinkFound(Sender: TObject;
UrlFound, TypeLink,
FromUrl, HostName, UrlPath, UrlPathWithFile, ExtraInfos: String;
var WriteToFile: String;
HrefOrSrc: Char;
CountArea: Integer;
var FollowIfHtmlLink: Boolean);
procedure check_only_mailClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
procedure btn_tool_searchClick(Sender: TObject);
procedure sbStopClick(Sender: TObject);
private
{ Private declarations }
TestThread : array of TSearchMailThread;
public
{ Public declarations }
CountLinks: integer;
end;
var
frmMain: TfrmMain;
WHEEL : char;
savefilename:string;
implementation
{$R *.dfm}
Function TurnWheel : char;
begin
case WHEEL of
'/' : WHEEL := '-';
'-' : WHEEL := '/';
'/' : WHEEL := '|';
else
WHEEL := '/';
end;
TurnWheel := WHEEL;
end;
procedure TfrmMain.butCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmMain.HttpScan1LinkFound(Sender: TObject;
UrlFound, TypeLink,
FromUrl, HostName, UrlPath, UrlPathWithFile, ExtraInfos: String;
var WriteToFile: String;
HrefOrSrc: Char;
CountArea: Integer;
var FollowIfHtmlLink: Boolean);
begin
inc(CountLinks);
StatusBar1.SimpleText :=' ( ' + TurnWheel + ' ) ' + IntToStr (CountLinks) + ' 已搜索, 正在搜索:'+UrlFound;
typelink := 'mail';
end;
procedure TfrmMain.check_only_mailClick(Sender: TObject);
var
flext:string[4];
//判断文件扩展名是否为。TXT,
begin
if check_only_mail.Checked then
begin
if SaveDialog1.Execute then
//启用 EMAIL类型过虑
begin
savefilename:= SaveDialog1.FileName ;
flext:=ansilowercase(extractfileext(SaveDialog1.FileName));
end;
if flext<>'.txt' then
begin
savefilename:=savefilename+'.txt';
end;
end;
httpscan1.TypeFilterEnabled:=check_only_mail.Checked;
HttpScan1.TypeFilter := 'mail';
end;
procedure TfrmMain.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
HttpScan1.Stop;
try
Memo_tmp_mail.Lines.SaveToFile(savefilename);
except
end;
end;
procedure TfrmMain.btn_tool_searchClick(Sender: TObject);
var
//TestThread: array[0..255] of TMyThread;
i , m: integer;
begin
m := SpinEdit1.Value;
SetLength(TestThread, m+1);
for i := 0 to mdo
try
TestThread := TSearchMailThread.Create;
except
end;
end;
procedure TfrmMain.sbStopClick(Sender: TObject);
var
i , m: integer;
begin
m := SpinEdit1.Value;
SetLength(TestThread,m+1);
for i := 0 to mdo
begin
try
Memo2.Lines.Add(Format('第%d个线程结束', ));
if Assigned(TestThread) then
begin
TerminateThread(TestThread.Handle,0);
CloseHandle(TestThread.Handle);
TestThread := nil;
end;
except
end;
end;
end;
end.
interface
uses
Classes, DB, ADODB, SysUtils, Forms;
type
TSearchMailThread = class(TThread)
private
Ok : boolean;
protected
procedure SearchMail;
procedure Execute;
override;
public
constructor Create();overload;
destructor destroy;
end;
implementation
uses Main;
{ TSearchMailThread }
constructor TSearchMailThread.Create;
begin
inherited Create(False);
FreeOnTerminate:= True;
end;
destructor TSearchMailThread.destroy;
begin
inherited Destroy;
end;
procedure TSearchMailThread.Execute;
begin
inherited;
FreeOnTerminate := True;
try
while not Terminateddo
begin
synchronize(SearchMail);
Application.ProcessMessages;
//if terminated then
break;
end;
finally
end;
end;
procedure TSearchMailThread.SearchMail;
begin
if not boolean(pos ('://', frmMain.combo_url.Text)) then
frmMain.combo_url.Text := 'http://'+frmMain.combo_url.Text;
frmMain.httpscan1.ProxyAddress:=frmMain.edt_proxy_ipaddress.Text;
frmMain.HttpScan1.ProxyPort:=integer(frmMain.edt_proxy_port.Text);
frmMain.HttpScan1.UserName:=trim(frmMain.edt_proxy_user.Text);
frmMain.HttpScan1.Password:=trim(frmMain.edt_proxy_password.Text);
frmMain.HttpScan1.FileOfResults:=frmMain.edt_searchresults.Text;
frmMain.HttpScan1.Retries:=integer(frmMain.edt_proxy_cs.Text);
frmMain.httpscan1.TimeOut:=integer(frmMain.edt_proxy_timeout.Text);
frmMain.HttpScan1.FileOfResults :=frmMain.edt_searchresults.text;
frmMain.HttpScan1.DepthSearchLevel:=integer(frmMain.edt_leverl.text);
ok:=frmMain.HttpScan1.Start(frmMain.combo_url.Text);
if Ok then
begin
frmMain.CountLinks := 0;
frmMain.combo_url.Text:=frmMain.HttpScan1.StartingUrl;
end;
if Terminated then
exit;
end;
end.
////////////////////////////////
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls,Inifiles,
Buttons, ExtCtrls, IdExplicitTLSClientServerBase, IdSMTPBase, THtScan,
Spin, ShellAPI, SearchMailThread, Grids, Gauges;
type
TfrmMain = class(TForm)
OpenDialog: TOpenDialog;
pgc1: TPageControl;
ts1: TTabSheet;
ts2: TTabSheet;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
Gauge: TGauge;
Label1: TLabel;
Label7: TLabel;
Label8: TLabel;
lblMailNum: TLabel;
lblWinNum: TLabel;
lblFailNum: TLabel;
Button1: TButton;
btnSend: TButton;
Minfo: TMemo;
StringGrid: TStringGrid;
butClose: TButton;
TabSheet2: TTabSheet;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
mmContent: TMemo;
edtFrom: TEdit;
edtSubject: TEdit;
TabSheet3: TTabSheet;
GroupBox1: TGroupBox;
Label2: TLabel;
Label3: TLabel;
edtDns: TEdit;
edtHeader: TEdit;
butSetupOk: TButton;
chk: TCheckBox;
Memo1: TMemo;
Panel2: TPanel;
SpeedButton2: TSpeedButton;
btn_tool_search: TSpeedButton;
sbStop: TSpeedButton;
combo_url: TEdit;
HttpScan1: THttpScan;
pgc2: TPageControl;
ts3: TTabSheet;
ts5: TTabSheet;
Panel1: TPanel;
check_only_mail: TCheckBox;
Panel3: TPanel;
StatusBar1: TStatusBar;
SaveDialog1: TSaveDialog;
edt_proxy_ipaddress: TEdit;
edt_proxy_port: TEdit;
edt_proxy_user: TEdit;
edt_proxy_password: TEdit;
edt_searchresults: TEdit;
edt_proxy_cs: TEdit;
edt_proxy_timeout: TEdit;
edt_leverl: TEdit;
Memo_tmp_mail: TMemo;
SpinEdit1: TSpinEdit;
Label9: TLabel;
Memo2: TMemo;
procedure butCloseClick(Sender: TObject);
procedure HttpScan1LinkFound(Sender: TObject;
UrlFound, TypeLink,
FromUrl, HostName, UrlPath, UrlPathWithFile, ExtraInfos: String;
var WriteToFile: String;
HrefOrSrc: Char;
CountArea: Integer;
var FollowIfHtmlLink: Boolean);
procedure check_only_mailClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
procedure btn_tool_searchClick(Sender: TObject);
procedure sbStopClick(Sender: TObject);
private
{ Private declarations }
TestThread : array of TSearchMailThread;
public
{ Public declarations }
CountLinks: integer;
end;
var
frmMain: TfrmMain;
WHEEL : char;
savefilename:string;
implementation
{$R *.dfm}
Function TurnWheel : char;
begin
case WHEEL of
'/' : WHEEL := '-';
'-' : WHEEL := '/';
'/' : WHEEL := '|';
else
WHEEL := '/';
end;
TurnWheel := WHEEL;
end;
procedure TfrmMain.butCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmMain.HttpScan1LinkFound(Sender: TObject;
UrlFound, TypeLink,
FromUrl, HostName, UrlPath, UrlPathWithFile, ExtraInfos: String;
var WriteToFile: String;
HrefOrSrc: Char;
CountArea: Integer;
var FollowIfHtmlLink: Boolean);
begin
inc(CountLinks);
StatusBar1.SimpleText :=' ( ' + TurnWheel + ' ) ' + IntToStr (CountLinks) + ' 已搜索, 正在搜索:'+UrlFound;
typelink := 'mail';
end;
procedure TfrmMain.check_only_mailClick(Sender: TObject);
var
flext:string[4];
//判断文件扩展名是否为。TXT,
begin
if check_only_mail.Checked then
begin
if SaveDialog1.Execute then
//启用 EMAIL类型过虑
begin
savefilename:= SaveDialog1.FileName ;
flext:=ansilowercase(extractfileext(SaveDialog1.FileName));
end;
if flext<>'.txt' then
begin
savefilename:=savefilename+'.txt';
end;
end;
httpscan1.TypeFilterEnabled:=check_only_mail.Checked;
HttpScan1.TypeFilter := 'mail';
end;
procedure TfrmMain.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
HttpScan1.Stop;
try
Memo_tmp_mail.Lines.SaveToFile(savefilename);
except
end;
end;
procedure TfrmMain.btn_tool_searchClick(Sender: TObject);
var
//TestThread: array[0..255] of TMyThread;
i , m: integer;
begin
m := SpinEdit1.Value;
SetLength(TestThread, m+1);
for i := 0 to mdo
try
TestThread := TSearchMailThread.Create;
except
end;
end;
procedure TfrmMain.sbStopClick(Sender: TObject);
var
i , m: integer;
begin
m := SpinEdit1.Value;
SetLength(TestThread,m+1);
for i := 0 to mdo
begin
try
Memo2.Lines.Add(Format('第%d个线程结束', ));
if Assigned(TestThread) then
begin
TerminateThread(TestThread.Handle,0);
CloseHandle(TestThread.Handle);
TestThread := nil;
end;
except
end;
end;
end;
end.