Twebbrowser控件如果写多线程

 

TDownUrlThread = class(TThread)
private
fDownHtmWay: integer;
FDM: TDM;

FMemo: tmemo;
protected
procedure Execute; override;
public

Furl: string;
FNMHTTP: TNMHTTP;
destructor Destroy; override; //Îö¹¹º¯Êý
constructor Create(lurl: string; LNMHTTP: TNMHTTP; CreateSuspended: boolean; lMemo: tmemo; lDownHtmWay: integer); //¹¹Ô캯Êý
end;

constructor tdownUrlThread.Create(lurl: string; LNMHTTP: TNMHTTP; CreateSuspended: boolean; lMemo: tmemo; lDownHtmWay: integer); //¹¹Ô캯Êý
begin
Furl := lurl;

FNMHTTP := LNMHTTP;
FNMHTTP.InputFileMode := FALSE;
FNMHTTP.OutputFileMode := FALSE;
FNMHTTP.ReportLevel := Status_Basic;
with FNMHTTP.HeaderInfo do
begin
Cookie := '';
LocalMailAddress := '';
LocalProgram := '';
Referer := '';
UserID := '';
Password := '';
end;
FDM := TDM.Create(nil);
FMemo := lmemo;
fDownHtmWay := lDownHtmWay;
FreeOnTerminate := False;
inherited Create(CreateSuspended);
end;

procedure tdownUrlThread.Execute;
var htm, url: string;

begin
while (aConfig_Url_GetMail.CurrentIndex < aConfig_Url_GetMail.EndIndex) and (not Terminated) and (not bCloseSystem) do
begin
url := format(FURL, [INTTOSTR(aConfig_Url_GetMail.CurrentIndex)]);
HTM := '';

if fDownHtmWay = 0 then
begin
try
FNMHTTP.Get(url);
HTM := FNMHTTP.Body;
fmemo.Text := HTM;
except
end;
end
else
begin
if not bCloseSystem then SMTPForm.ie.Navigate(URL);
while (SMTPForm.ie.ReadyState <> READYSTATE_COMPLETE) and (not forms.Application.Terminated) and (not bCloseSystem)
do Forms.Application.ProcessMessages;
try
HTM := (SMTPForm.IE.Document as Ihtmldocument2).body.outerHtml
except
end;
end;
if bCloseSystem then break;
fmemo.Lines.Add(URL);
if not bCloseSystem then aMessageManager.WriteMessage(HTM);
FDM.sq := 'UPDATE T_Config_Url_GetMail SET CurrentIndex=' + INTTOSTR(aConfig_Url_GetMail.CurrentIndex) + ' WHERE IID=' + INTTOSTR(aConfig_Url_GetMail.IID);
FDM.Exe_SQ;

INC(aConfig_Url_GetMail.CurrentIndex);

SLEEP(1000);
end;
end;



destructor tdownUrlThread.Destroy; //Îö¹¹
begin
FDM.ADOConnection1.Connected := FALSE;
FDM.Free;
end;


constructor TDeletepop3mailThread.Create(LStatusBar: TStatusBar; panelsIndex: integer); //¹¹Ô캯Êý
begin
FMailList := tstringlist.create;
FMailList.Clear;
NMPOP31 := TNMPOP3.Create(nil);
NMPOP31.AttachFilePath := '.';
NMPOP31.DeleteOnRead := FALSE;
NMPOP31.ReportLevel := Status_Basic;
NMPOP31.TimeOut := 20000;
NMPOP31.Host := 'pop3.sina.com.cn';
NMPOP31.Port := 110;
NMPOP31.UserID := 'zsp586';
NMPOP31.Password := 'zspsina';
NMPOP31.OnList := NMPOP31onlistList;
FStatusBar := LStatusBar;
FpanelsIndex := panelsIndex;
bStop := false;
self.FreeOnTerminate := true;
inherited Create(False);
end;

zzandyzh 发表于 2005-12-24 10:41:15

大家给看看我写的有什么问题，（刚学，希望大家多多指点！）谢谢！！
＃＃＃＃＃＃＃＃＃线程＃＃＃＃＃＃＃＃＃＃＃
type
TWebThread = class(TThread)
private
webbrowser:TWebBrowser;
number:integer;
Fminnum,Fmaxnum:integer;
Fhost:string;
protected
procedure Execute; override;
procedure WebBrowserDocumentComplete(Sender: TObject;const pDisp: IDispatch; var URL: OleVariant);
function seturl:string;
public
published
constructor Create(minnum,maxnum:integer);
destructor Destroy; override;
end;
implementation
uses unit1;
constructor twebthread.Create(minnum,maxnum:integer);
begin
inherited Create(True);
FreeOnTerminate:=true;
Fminnum:=minnum;
Fmaxnum:=maxnum;
Suspended:=False; end;
destructor TwebThread.Destroy;
begin
CoUninitialize;
inherited destroy;
end;
procedure TWebThread.Execute;
begin
try
CoInitialize(nil);
webbrowser:=TWebbrowser.Create(nil);
Fhost:=seturl;
form1.memo2.text:=form1.memo2.text+fhost;
webbrowser.Navigate(Fhost);
webbrowser.OnDocumentComplete:=WebBrowserDocumentComplete;
while not Terminated do
Application.ProcessMessages;
finally
webbrowser.Free;
end;
end;
function TWebThread.seturl:string;
begin
url:='http://www.google.com.sg/search?q=+%22%E5%A8%B1%E4%B9%90%E5%A4%A7%E7%www.epic.com&hl=zh-CN&lr=&newwindow=1&as_qdr=all&start='+inttostr(Fminnum)+'&sa=N';
Fminnum:=Fminnum+10;
result:=url;
end;
procedure Twebthread.WebBrowserDocumentComplete(Sender: TObject;const pDisp: IDispatch; var URL: OleVariant);
var
doc:IHTMLDocument2;
all:IHTMLElementCollection;
len,i:integer;
item:OleVariant;
begin
if not webbrowser.busy then
begin
doc:=webbrowser.Document as IHTMLDocument2;
all:=doc.Get_Links;
len:=all.length;
for i:=0 to len-1 do
begin
item:=all.item(i,varempty);
if (pos('google',item)=0)and(pos('hl=zh-CN',item)=0)and(pos('article_',item)>0) then
form1.Memo1.Lines.Add(item);
end;
end;
end;
end.

＃＃＃＃＃＃＃调用＃＃＃＃＃
procedure TForm1.Button7Click(Sender: TObject);
var
j:integer;
th:array[0..5] of twebthread;
begin
minnum:=strtoint(form1.Edit1.text) ;
maxnum:=strtoint(form1.Edit2.text);
for j:=0 to 3 do
begin
th[j]:=twebthread.Create(minnum,maxnum) ;
minnum:=minnum+10;
if minnum>=maxnum then
break;
end;
end;

cactus123456 发表于 2005-12-24 21:57:04

问题一：form1.memo2.text:=form1.memo2.text+fhost; 未加保护
问题二：webbrowser:=TWebbrowser.Create(nil);
webbrowser未指定父类，所以你永远不可能得到（all.length）all:=doc.Get_Links;
问题三：webbrowser本身就是多线程下载的，没有必要再放到tthead里面，你在主form上
放置10个webbrowser，点击button里面每个赋值不同的网址，看看是同时下载的，还是一个一个下载的

转自： http://hi.baidu.com/fenghuo521/blog/item/2a4d29f84b9fc70bd9f9fd86.html