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

使用d7编写，主要部分代码：


//主界面部分
unit1.pas

unit unit1;

interface

uses
windows, messages, sysutils, variants, classes, graphics, controls, forms,
dialogs, stdctrls, tabs, extctrls, comctrls, idhttp, unit2;

type
tform1 = class(tform)
  label1: tlabel;
  edit1: tedit;
  button1: tbutton;
  tabset1: ttabset;
  statusbar1: tstatusbar;
  progressbar1: tprogressbar;
  panel1: tpanel;
  groupbox1: tgroupbox;
  memo1: tmemo;
  edit2: tedit;
  button2: tbutton;
  button3: tbutton;
  button4: tbutton;
  groupbox2: tgroupbox;
  memo2: tmemo;
  groupbox3: tgroupbox;
  memo3: tmemo;
  button5: tbutton;
  opendialog1: topendialog;
  procedure tabset1click(sender: tobject);
  procedure button5click(sender: tobject);
  procedure button2click(sender: tobject);
  procedure button1click(sender: tobject);
  procedure button4click(sender: tobject);
  procedure button3click(sender: tobject);
private
  { private declarations }
  //弹出信息框
  procedure msgbox(strmsg: string);
  procedure threadexit(sender: tobject);
public
  { public declarations }
end;

var
form1: tform1;
thread1: array of t1; // 定义线程数组
n: integer = 0;
bool: boolean = true;

implementation

{$r *.dfm}

procedure tform1.tabset1click(sender: tobject);
begin
if tabset1.tabindex = 0 then
begin
  groupbox2.visible :=true;
  groupbox3.visible :=true;
  groupbox1.visible :=false;
  panel1.visible :=false;
end else
begin
  groupbox2.visible :=false;
  groupbox3.visible :=false;
  groupbox1.visible :=true;
  panel1.visible :=true;
end;

end;

procedure tform1.button5click(sender: tobject);
var
i:integer;
url:string;
begin
if edit1.text='' then
begin
  msgbox('请输入要检测的网站地址！');
  exit;
end;
memo3.clear;
memo2.clear;
progressbar1.min :=0;
progressbar1.max :=memo1.lines.count;
progressbar1.step :=1;
progressbar1.position :=0;
for i:=0 to memo1.lines.count - 1 do
begin
  url :=trim(edit1.text)+memo1.lines;
  memo3.lines.add(url);
  groupbox3.caption :='信息：已检测'+inttostr(memo3.lines.count)+'个页面';
  progressbar1.stepit;
  if checkurl(url) then
  begin
    memo2.lines.add('该url存在! - '+url);
    groupbox2.caption :='存在：共找到'+inttostr(memo2.lines.count)+'条路径';
  end;
end;
end;

procedure tform1.msgbox(strmsg: string);
begin
application.messagebox(pchar(strmsg), '提示信息', mb_iconinformation);
end;

procedure tform1.button2click(sender: tobject);
begin
if trim(edit2.text)<>'' then
  memo1.lines.add(trim(edit2.text));
end;

procedure tform1.button1click(sender: tobject);
var
i: integer;
sum:integer;
begin
if bool then
begin
  memo3.clear;
  memo2.clear;
  n :=0;
  sum :=memo1.lines.count;
  setlength(thread1,sum);   // 动态设置线程的数量
  progressbar1.min :=0;
  progressbar1.max :=sum;
  progressbar1.step :=1;
  progressbar1.position :=0;
  for i := 0 to sum - 1 do
  begin
    thread1 := t1.create(memo1,memo2,memo3,i);
    thread1.onterminate := threadexit;
    //progressbar1.stepit;
    //sleep(30);
  end;
end;
bool := false; // 关闭开关  
end;

procedure tform1.threadexit(sender: tobject);
begin
progressbar1.stepit;
memo3.lines.add(trim(edit1.text)+memo1.lines[n]);
groupbox3.caption :='信息：已检测'+inttostr(memo3.lines.count)+'个页面';
inc(n); // 线程结束后自增1
if n = memo1.lines.count then
begin
  bool := true; // 打开开关
  exit;
end;
end;

procedure tform1.button4click(sender: tobject);
begin
if opendialog1.execute then
  memo1.lines.loadfromfile(opendialog1.filename);
end;

procedure tform1.button3click(sender: tobject);
begin
memo1.lines.delete(memo1.lines.count-1);
end;

end.

//处理线程部分
unit2.pas


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;
  pr