DELPHI 网站后台扫描例子

希望大家可以写出VB 版本，VC 版本

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, WinHTTP, StdCtrls, ExtCtrls, ComCtrls, TFlatSplitterUnit,shellapi,
WinSkinData;

type
TForm1 = class(TForm)
Edurl: TEdit;
Label1: TLabel;
GroupBox1: TGroupBox;
Memoht: TMemo;
GroupBox2: TGroupBox;
Buttonstart: TButton;
Buttonstop: TButton;
Buttonclose: TButton;
Label2: TLabel;
Label3: TLabel;
Edhost: TEdit;
Edscan: TEdit;
GroupBox3: TGroupBox;
Memoguocheng: TMemo;
GroupBox4: TGroupBox;
WinHTTP1: TWinHTTP;
Timer1: TTimer;
TrackBar1: TTrackBar;
Label4: TLabel;
Label5: TLabel;
Buttonasp: TButton;
Buttonphp: TButton;
Buttonaspx: TButton;
Buttonself: TButton;
OpenDialog1: TOpenDialog;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
StatusBar1: TStatusBar;
ProgressBar1: TProgressBar;
SkinData1: TSkinData;
ListView1: TListView;
Edit1: TEdit;
Button1: TButton;
procedure WinHTTP1HeaderInfo(Sender: TObject; ErrorCode: Integer;
const RawHeadersCRLF, ContentType, ContentLanguage,
ContentEncoding: String; ContentLength: Integer;
const Location: String; const Date, LastModified, Expires: TDateTime;
const ETag: String; var ContinueDownload: Boolean);
procedure ButtonstartClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure ButtonaspClick(Sender: TObject);
procedure ButtonphpClick(Sender: TObject);
procedure ButtonaspxClick(Sender: TObject);
procedure ButtonstopClick(Sender: TObject);
procedure ButtoncloseClick(Sender: TObject);
procedure ButtonselfClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure WinHTTP1HostUnreachable(Sender: TObject);
procedure ListView1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
n:integer; //后台地址某一行
i:integer; //后台地址行数
dir:string; //当前文件路径
implementation

{$R *.dfm}

procedure TForm1.WinHTTP1HeaderInfo(Sender: TObject; ErrorCode: Integer; //接收头信息
const RawHeadersCRLF, ContentType, ContentLanguage,
ContentEncoding: String; ContentLength: Integer; const Location: String;
const Date, LastModified, Expires: TDateTime; const ETag: String;
var ContinueDownload: Boolean);
var
h:integer; //HTTP status codes
S:string; //全部头信息
begin
S:=RawHeadersCRLF; //全部头信息
h:=errorcode; //HTTP status codes
memoguocheng.lines.Add(edurl.Text+memoht.lines[n]+' → '+copy(S,1,12));
if h=200 then
begin
with listview1.Items.Add do
begin
caption:=edurl.Text+memoht.lines[n];
subitems.add('页面存在！');
end;
end
else
if h=403 then
begin
with listview1.Items .add do
begin
caption:=edurl.Text +memoht.lines[n];
subitems.add('目录存在！');
end;
end;
n:=n+1; //后台地址下一行
end;

procedure TForm1.ButtonstartClick(Sender: TObject);
var
x:integer; //滑块条位置
begin
n:=0; //后台地址初始行为0，既第一行
i:=memoht.Lines.Count; //后台地址行数
ProgressBar1.Position :=0; //进度条初始位置
listview1.Items .Clear ; //清除listview1中内容
edit1.Text :=''; //清空edit1
button1.Enabled :=false; //‘打开’按钮不可用
if edurl.Text='' then
begin
showmessage('请输入要扫描的网址！');
exit;
end;
x:=trackbar1.position; //滑块条位置
case x of
0:timer1.interval:=1; //位置为0时timer1延时为1毫秒
1:timer1.interval:=10;
2:timer1.interval:=100;
3:timer1.interval:=200;
4:timer1.interval:=400;
5:timer1.Interval:=600;
6:timer1.Interval :=800;
7:timer1.interval:=1000;
8:timer1.interval:=2000;
9:timer1.interval:=3000;
10:timer1.interval:=5000;
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
url:string; //扫描页面地址
begin
i:=memoht.lines.Count ;
if nbegin
url:=edurl.Text +memoht.lines[n];
winhttp1.URL :=url;
edhost.Text :=winhttp1.HostName ; //主机地址
edscan.Text :=memoht.lines[n];
winhttp1.Read;
end
else
begin
memoguocheng.Lines.Add('扫描完毕！');
edscan.text:='Scan Over！';
edit1.text:='扫描完成,找到'+inttostr(listview1.Items .count)+'个地址！';
timer1.Interval:=0;
end;
progressbar1.Position :=round(n/i*100); //进度条位置
end;

procedure TForm1.ButtonaspClick(Sender: TObject);
begin
memoht.Lines .loadfromfile(dir+'/asp.txt'); //导入ASP后台文件
end;

procedure TForm1.ButtonphpClick(Sender: TObject);
begin
memoht.lines.loadfromfile(dir+'/php.txt'); //导入PHP后台文件
end;

procedure TForm1.ButtonaspxClick(Sender: TObject);
begin
memoht.lines.loadfromfile(dir+'/aspx.txt'); //导入ASPX文件
end;

procedure TForm1.ButtonstopClick(Sender: TObject);
begin
timer1.Interval :=0; //停止
end;

procedure TForm1.ButtoncloseClick(Sender: TObject);
begin
close;
end;

procedure TForm1.ButtonselfClick(Sender: TObject);
begin
if opendialog1.Execute then
memoht.lines.loadfromfile(opendialog1.FileName);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
dir:=extractfiledir(application.exename); //取当前文件路径
opendialog1.InitialDir :=dir; //文件打开对话框的默认路径，这里取本程序所在目录
//showmessage(dir);
memoht.lines.LoadFromFile(dir+'/asp.txt');//程序打开后自动载入asp.txt
ProgressBar1.Parent :=StatusBar1; //把进度条加入到状态条里
progressbar1.Top :=2;
end;

procedure TForm1.WinHTTP1HostUnreachable(Sender: TObject); //找不到主机时的响应
begin
showmessage('对不起，找不到主机！请检查是否输入有误？请确保网址末尾有“/”');
timer1.Interval :=0;
end;

procedure TForm1.ListView1Click(Sender: TObject);
begin
try
edit1.Text :=listview1.Items[listview1.itemindex].Caption ; //把找到的地址写到edit1中
button1.Enabled :=true; //‘打开’按钮激活
except;
exit;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
shellexecute(handle,'open',pchar(edit1.Text),nil,nil,sw_show);
end;

end.