Twebbrowser控件如果写多线程? ( 积分: 100 )

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

zzandyzh

Unregistered / Unconfirmed
GUEST, unregistred user!
如题!希望大家能给个例子或源码,谢谢!!
 
如题!希望大家能给个例子或源码,谢谢!!
 
你的多线程指的说明?每个线程跑个wb?还是一个wb多个线程?
wb本身就是多线程下载资源的。
 
我说的是每个线程跑一个WB ,因为我要分析一系列网页的源码!
 
你就在每个线程里Twebbrowser.create不就可以了。线程退出的时候free
 
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.HeaderInfodo
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;
//&amp;Icirc;&amp;ouml;&amp;sup1;&amp;sup1;
begin
FDM.ADOConnection1.Connected := FALSE;
FDM.Free;
end;

constructor TDeletepop3mailThread.Create(LStatusBar: TStatusBar;
panelsIndex: integer);
//&amp;sup1;&amp;sup1;&amp;Ocirc;ì&amp;ordm;&amp;macr;&amp;Ecirc;&amp;yacute;
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;
 
大家给看看我写的有什么问题,(刚学,希望大家多多指点!)谢谢!!
#########线程###########
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 Terminateddo
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&amp;hl=zh-CN&amp;lr=&amp;newwindow=1&amp;as_qdr=all&amp;start='+inttostr(Fminnum)+'&amp;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
do
c:=webbrowser.Document as IHTMLDocument2;
all:=doc.Get_Links;
len:=all.length;
for i:=0 to len-1do
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 3do
begin
th[j]:=twebthread.Create(minnum,maxnum) ;
minnum:=minnum+10;
if minnum>=maxnum then
break;
end;
end;
 
问题一:form1.memo2.text:=form1.memo2.text+fhost;
未加保护
问题二:webbrowser:=TWebbrowser.Create(nil);
webbrowser未指定父类,所以你永远不可能得到(all.length)all:=doc.Get_Links;
问题三:webbrowser本身就是多线程下载的,没有必要再放到tthead里面,你在主form上
放置10个webbrowser,点击button里面每个赋值不同的网址,看看是同时下载的,还是一个一个下载的
 
to cactus123456
不好意思,我刚学写多线程,不明白怎么写,可否讲的清楚点,该如何写!谢谢!
1.怎么加保护?
2.Webbrowser怎么指定父类?
 
1,Synchronize
2,就是webbrowser.parent:=form1;
其实就是让webbrowser有个绘制的地方,否则就不下载,但是在线程中指定parent为form1是不对的,因为这样右有保护的问题了,只要是保护,就会在主线程中运行,就起不到线程的作用了
 
正确的做法应该是用idhttp或socket,把它放到线程中
 
idhttp或socket,把它放到线程中 session 好像得不到了 会丢掉了
 
后退
顶部