Twebbrowser控件如果写多线程
2011-07-27 15:49
183 查看
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
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
相关文章推荐
- 多线程调试如果遇到访问冲突尤其是堆问题,最好重启机器
- 回发或回调参数无效。在配置中使用 或在页面中使用 启用了事件验证。出于安全目的,此功能验证回发或回调事件的参数是否来源于最初呈现这些事件的服务器控件。如果数据有效并且是预期的,则使用 ClientScriptManager.RegisterForEvent
- 回发或回调参数无效。在配置中使用 或在页面中使用 启用了事件验证。出于安全目的,此功能验证回发或回调事件的参数是否来源于最初呈现这些事件的服务器控件。如果数据有效并且是预期的,则使用 ClientScriptManager.RegisterForEventValidation 方法来注册回发或回调数据以进行验证。
- WinForm中多线程操作控件
- [原]多线程控件返回主线程时显示文本
- 多线程监听按钮控件(源代码)
- c++多线程读写窗体控件_自定义消息的实现
- 解决方案:带格式化文本控件( RichText)的模板如果在InfoPath的浏览器中加载可能出现 COM 组件的80040154错误
- C# 多线程控件处理
- 如果在SmarGrid控件中创建DropDownList列。
- 多线程中 用委托 操作 窗体的控件
- 回发或回调参数无效。在配置中使用 或在页面中使用 启用了事件验证。出于安全目的,此功能验证回发或回调事件的参数是否来源于最初呈现这些事件的服务器控件。如果数据有效并且是预期的,则使用 ClientScriptManager.RegisterForEventValidation 方法来注册回发或回调数据以进行验证。
- C# 多线程控制控件实例(例程简单,注释详细)
- 如何在多线程中调用winform窗体控件(续)
- c# 多线程调用窗体上的控件 示例
- C#多线程操作控件的两种安全方式(委托方式和BackgroundWorker控件方式)
- atl 标准控件在用多线程发消息时VC可以接收但网页无法接收的问题
- asp.net 包含动态创建控件的容器如果要切换显示/隐藏不要用 Visible 属性
- ,避免造成混乱。 设想1:拿ListView为例,如果ListView的ItemView复用机制,所有的ItemView复用同一个,如果在多线程下载图片的情况下,可能最终只有最后一个View显示图片
- 多线程操作控件C#