多线程程序里定义了一个对象,想在该对象的某个事件中写代码,怎样做? ( 积分: 200 )

  • 主题发起人 主题发起人 willyxia
  • 开始时间 开始时间
W

willyxia

Unregistered / Unconfirmed
GUEST, unregistred user!
我把代码贴出来,hs是HttpScan的一个实例,HttpScan有个事件是onLinkFound(Sender: TObject;
UrlFound, TypeLink,
FromUrl, HostName, UrlPath, UrlPathWithFile, ExtraInfos: String;
var WriteToFile: String;
HrefOrSrc: Char;
CountArea: Integer;
var FollowIfHtmlLink: Boolean);
我怎样在onLinkFound中写入代码?
---------------------程序如下------------------------------------
unit GetThds;
interface
uses
Classes,HttpScan,Windows,SysUtils,StdCtrls;
type
TGetThread = class(TThread)
hs: THttpScan;
private
urlStr : String;
tmpNum : Integer;
tmpM1 : TMemo;
protected
procedure Execute;
override;
public
constructor Create(M1:TMemo;aUrlStr:String;num:Integer);
end;

var
CS:TRTLCriticalSection;
//定义全局临界区

implementation
uses main;
constructor TGetThread.Create(M1:TMemo;aUrlStr:String;num:Integer);
begin
tmpM1 := M1;
urlStr := aUrlStr;
tmpNum := num;
FreeOnTerminate := True;
// 自动删除
//InitializeCriticalSection(CS);
//初始化临界区
inherited Create(false);
end;

procedure TGetThread.Execute;
begin
hs := ThttpScan.Create(nil);
hs.FileOfResults := 'c:/'+inttostr(tmpNum)+'.txt';
hs.TypeFilter := 'htm';
hs.DepthSearchLevel := 1;
hs.TypeFilterEnabled := true;
hs.Retries := 3;
hs.TimeOut := 300;
//EnterCriticalSection(cs);
//进入临界区
hs.Start(urlStr);
//LeaveCriticalSection(CS);
//退出临界区
end;

procedure TGetThread.HsLinkFound(Sender: TObject;
UrlFound, TypeLink,
FromUrl, HostName, UrlPath, UrlPathWithFile, ExtraInfos: String;
var WriteToFile: String;
HrefOrSrc: Char;
CountArea: Integer;
var FollowIfHtmlLink: Boolean);
begin
tmpM1.Lines.Add (Format ('%-4s ', [typelink]) + ' ' + UrlFound);
end;

end.
 
我把代码贴出来,hs是HttpScan的一个实例,HttpScan有个事件是onLinkFound(Sender: TObject;
UrlFound, TypeLink,
FromUrl, HostName, UrlPath, UrlPathWithFile, ExtraInfos: String;
var WriteToFile: String;
HrefOrSrc: Char;
CountArea: Integer;
var FollowIfHtmlLink: Boolean);
我怎样在onLinkFound中写入代码?
---------------------程序如下------------------------------------
unit GetThds;
interface
uses
Classes,HttpScan,Windows,SysUtils,StdCtrls;
type
TGetThread = class(TThread)
hs: THttpScan;
private
urlStr : String;
tmpNum : Integer;
tmpM1 : TMemo;
protected
procedure Execute;
override;
public
constructor Create(M1:TMemo;aUrlStr:String;num:Integer);
end;

var
CS:TRTLCriticalSection;
//定义全局临界区

implementation
uses main;
constructor TGetThread.Create(M1:TMemo;aUrlStr:String;num:Integer);
begin
tmpM1 := M1;
urlStr := aUrlStr;
tmpNum := num;
FreeOnTerminate := True;
// 自动删除
//InitializeCriticalSection(CS);
//初始化临界区
inherited Create(false);
end;

procedure TGetThread.Execute;
begin
hs := ThttpScan.Create(nil);
hs.FileOfResults := 'c:/'+inttostr(tmpNum)+'.txt';
hs.TypeFilter := 'htm';
hs.DepthSearchLevel := 1;
hs.TypeFilterEnabled := true;
hs.Retries := 3;
hs.TimeOut := 300;
//EnterCriticalSection(cs);
//进入临界区
hs.Start(urlStr);
//LeaveCriticalSection(CS);
//退出临界区
end;

procedure TGetThread.HsLinkFound(Sender: TObject;
UrlFound, TypeLink,
FromUrl, HostName, UrlPath, UrlPathWithFile, ExtraInfos: String;
var WriteToFile: String;
HrefOrSrc: Char;
CountArea: Integer;
var FollowIfHtmlLink: Boolean);
begin
tmpM1.Lines.Add (Format ('%-4s ', [typelink]) + ' ' + UrlFound);
end;

end.
 
...
hs.TimeOut := 300;
hs.OnLinkFound := hsLinkFound;
 
事件是方法指针,只要定义相同的方法指针就可以
 
后退
顶部