界面是防明小子的那個掃描工具寫的，算是學習多線程的一個例子把

界面圖示：

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

程序和源代碼：

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

使用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;
  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

使用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;
  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

使用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;
  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.