一个多线程后台扫描的程序和源代码[4]

r/>unit unit2;

interface

uses
classes,stdctrls,windows,sysutils,wininet,idhttp;

var
cs:trtlcriticalsection;   //定义全局临界区

type
t1 = class(tthread)
private
  tmpm1,tmpm2,tmpm3: tmemo;
  tmpnum: integer;
  str :string;
  procedure datamemo;
protected
  procedure execute; override;
public
  constructor create(m1,m2,m3: tmemo; num: integer);
end;

function get(url: string): boolean;
function checkurl(url: string; timeout: integer = 5000): boolean;

implementation

uses unit1;

{ t1 }

constructor t1.create(m1,m2,m3: tmemo; num: integer);
begin
tmpnum := num; // 传递参数
tmpm1 :=m1;   // 绑定控件
tmpm2 :=m2;
tmpm3 :=m3;
freeonterminate := true; // 自动删除
initializecriticalsection(cs); //初始化临界区
inherited create(false); // 直接运行
end;

function get(url: 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 idhttp.responsecode=200 then
    result :=true;
  except
  end;
finally
  idhttp.free;
end;
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 t1.datamemo;
begin
tmpm2.lines.add(str+getbackspacecount(str)+'线程'+inttostr(tmpnum+1)+'检测结果');
form1.groupbox2.caption :='存在：共找到'+inttostr(tmpm2.lines.count)+'条路径';
end;

procedure t1.execute;
begin
str :=trim(form1.edit1.text) + tmpm1.lines[tmpnum];
entercriticalsection(cs);       //进入临界区
if checkurl(str) then
begin
  synchronize(datamemo); // 同步
end;
leavecriticalsection(cs);     //退出临界区
//sleep(20); // 线程挂起;
end;

end.

界面是防明小子的那个扫描工具写的，算是学习多线程的一个例子把

界面图示：

http://www.wrsky.com/attachment/3_1875.jpg

程序和源代码：

http://downloads.2ccc.com/general/internet_lan/hnxyy_scan.rar