delphi 中计数器跟多线程区别(70分)

  • 主题发起人 主题发起人 zwp888
  • 开始时间 开始时间
Z

zwp888

Unregistered / Unconfirmed
GUEST, unregistred user!
delphi 中计数器跟多线程工作原理上什么区别,
能提供多线程在delphi中编程的典型实例最好,谢谢了!
 
计数器是wm_timer系统帮你运行的,也是多线程。
 
编程中怎么决定,什么场合用计数器还是线程,
他们在效率上有什么区别
 
定时器只能在主线程中运行,线程可以独立运行。
 
用多线程比记数器扩展的空间要大一点,虽然机理大致相同!~~
在delphi盒子上有聊天的代码下,一般都用到多线程
 
线程也可以写在主程序中,你学学这个代码,基本上应该符合你的要求了:
//主界面部分
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 - 1do
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 - 1do
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 truedo
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-1do
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 - 1do
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 - 1do
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 truedo
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-1do
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 - 1do
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 - 1do
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 truedo
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-1do
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 - 1do
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 - 1do
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 truedo
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-1do
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.
 
有本质上的不同
定时器:
你只是定一个间隔.让系统到时间了叫你一下.比如 100ms.这样系统每过100ms 就会通知你,到时候了.你做相应的事.而有时系统忙,这个时间就很不准,有时可能会不触发
多线程:
就像生活中你要同时做很多事,做不完,你就叫别人帮你一做一件这样.
至于别人做完了,如何通知你,就是你的事了..
 
多线程中,线程执行完毕,停止后能否自动触发,
计数器事件可以自动循环执行吗,
对于读取高频数据,比如工业计数,实时性要求很高,应该才用哪种方案
 
线程停止了,怎么自动触发?除非一直有一个所谓的监听线程运行,遇到什么情况就触发一个线程来处理,比如socket的原理就是这样,当线程处理完毕,自动释放。计数器事件可以自动循环执行,因为他是周期性的,不需要什么来触发,就是到了那个时间点,他自己就去执行。对于你说的最后一个,我建议你使用多线程,而不是计数器。
 
请发给我你们的QQ,有时间交流一下!!
 
后退
顶部