Delphi中TWebBrowser的用法

最新推荐文章于 2020-09-12 02:15:46 发布
byc6352
最新推荐文章于 2020-09-12 02:15:46 发布
阅读量518
点赞数
分类专栏： delphi 文章标签： twebbrowser
原文链接：https://blog.csdn.net/daiswy/article/details/78900546
版权
delphi 专栏收录该内容
39 篇文章 4 订阅
订阅专栏
                        
                     
 
WebBrowser1.GoHome; //到浏览器默认主页  
WebBrowser1.Refresh; //刷新  
WebBrowser1.GoBack; //后退  
WebBrowser1.GoForward; //前进  
WebBrowser1.Navigate('...'); //打开指定页面  
WebBrowser1.Navigate('about:blank'); //打开空页面  
//打开空页面, 并写入...  
  
WebBrowser1.Navigate('about:<head><title>标题</title><body>页面内容</body>');  
//读取网页脚本中的变量:  
  
procedure TForm1.Button1Click(Sender: TObject);  
var  
s: string;  
i: Integer;  
begin  
s := WebBrowser1.OleObject.document.Script.str;  
i := WebBrowser1.OleObject.document.Script.num;  
ShowMessage(s); //Hello  
ShowMessage(IntToStr(i)); //99  
  
//也可以这样读:  
s := WebBrowser1.OleObject.document.parentWindow.str;  
i := WebBrowser1.OleObject.document.parentWindow.num;  
ShowMessage(s); //Hello  
ShowMessage(IntToStr(i)); //99  
end;  
&amp;lt;br&amp;gt;假如网页中有这样的语句:&amp;lt;br&amp;gt;&amp;amp;amp;lt;script&amp;amp;amp;gt;&amp;lt;br&amp;gt;var&amp;lt;br&amp;gt; str = &amp;quot;Hello&amp;quot;;&amp;lt;br&amp;gt; i = 99;&amp;lt;br&amp;gt;&amp;amp;amp;lt;/script&amp;amp;amp;gt;  
//调用网页脚本中的函数:  
  
procedure TForm1.Button1Click(Sender: TObject);  
begin  
WebBrowser1.OleObject.document.parentWindow.MB(); //HTML-Js  
  
//如需指定脚本语言, 需要:  
WebBrowser1.OleObject.document.parentWindow.execScript('MB()','JavaScript'); //HTML-Js  
end;  
&amp;lt;br&amp;gt;假如有这样的脚本:&amp;lt;br&amp;gt;&amp;amp;amp;lt;script&amp;amp;amp;gt;&amp;lt;br&amp;gt;function MB(){ &amp;lt;br&amp;gt; alert('HTML-Js');&amp;lt;br&amp;gt;}&amp;lt;br&amp;gt;&amp;amp;amp;lt;/script&amp;amp;amp;gt;  
  
  
//判断网页及内部框架网页是否全部下载完毕  
  
procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;  
const pDisp: IDispatch; var URL: OleVariant);  
begin  
if   not(<span style="font-family: Arial, Helvetica, sans-serif;">WebBrowser1</span>.Busy)   then    
  ShowMessage('下载完毕');   
end;  
  
//改变背景色或背景图片:  
WebBrowser1.OleObject.document.body.bgcolor := '#FF0000';  
WebBrowser1.OleObject.document.body.background := '...图片地址';  
//操作有 ID 标签的对象:  
var  
s: string;  
begin  
s := WebBrowser1.OleObject.document.getElementByIdx_x('span1').innerText;  
ShowMessage(s); //这是 span1 标签中的内容  
  
//或者:  
s := WebBrowser1.OleObject.document.parentWindow.span1.innerText;  
ShowMessage(s); //这是 span1 标签中的内容  
  
//隐藏它:  
WebBrowser1.OleObject.document.parentWindow.span1.style.display := 'none';  
end;  
&amp;lt;br&amp;gt;假如网页中有这样的内容:&amp;lt;br&amp;gt;&amp;amp;amp;lt;span id=span1&amp;amp;amp;gt;这是 span1 标签中的内容&amp;amp;amp;lt;/span&amp;amp;amp;gt;&amp;lt;br&amp;gt;  
//获取网页源代码  
var  
s: string;  
begin  
s := WebBrowser1.OleObject.document.body.innerHTML; //body内的所有代码  
s := WebBrowser1.OleObject.document.body.outerHTML; //body内的所有代码, 包含body标签  
s := WebBrowser1.OleObject.document.documentElement.innerHTML; //html内的所有代码  
end;  
</pre><pre name="code" class="delphi"><span style="color: rgb(73, 73, 73); font-family: simsun; font-size: 14px; line-height: 21px;">Memo1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).Body.OuterHtml);</span>  
  
//获取网页全部源代码  
uses ActiveX;  
var  
ms: TMemoryStream;  
begin  
if not Assigned(WebBrowser1.Document) then Exit;  
ms := TMemoryStream.Create;  
(WebBrowser1.Document as IPersistStreamInit).Save(TStreamAdapter.Create(ms), True);  
ms.Position := 0;  
Memo1.Lines.LoadFromStream(ms, TEncoding.UTF8);  
// Memo1.Lines.LoadFromStream(ms, TEncoding.Default); {GB2312 等双字节}  
ms.Free;  
end;  
//WebBrowser 中的右键菜单  
  
//先要添加ApplicationEvents1,指定其Message事件  
  
//屏蔽右键菜单  
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);  
begin  
with Msg do  
begin  
if not IsChild(WebBrowser1.Handle, hWnd) then Exit;  
Handled := (message = WM_RBUTTONDOWN) or (message = WM_RBUTTONUP) or (message = WM_CONTEXTMENU);  
end;  
end;  
  
//替换右键菜单  
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);  
var mPoint: TPoint;  
begin  
if IsChild(WebBrowser1.Handle, Msg.Hwnd) and  
((Msg.Message = WM_RBUTTONDOWN) or (Msg.Message = WM_RBUTTONUP)) then  
begin  
GetCursorPos(mPoint); //得到光标位置  
PopupMenu1.Popup(mPoint.X, mPoint.Y); //弹出popupmenu1的菜单  
Handled:=True;  
end;  
end;  
//新页面写入  
begin  
WebBrowser1.Navigate('about:blank');  
WebBrowser1.OleObject.Document.Writeln('ok');  
end;  
  
//从流中写入:  
var  
ms: TMemoryStream;  
begin  
ms := TMemoryStream.Create;  
Memo1.Lines.SaveToStream(ms);  
ms.Position := 0;  
(WebBrowser1.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms));  
ms.Free;  
end;  
  
//禁止提示脚步错误  
procedure TForm1.WebBrowser1NavigateComplete2(ASender: TObject;  
const pDisp: IDispatch; var URL: OleVariant);  
begin  
WebBrowser1.Silent := True;  
end;  
</pre><pre name="code" class="delphi">方法二  
TWebBrowser的OnDownloadComplete事件里面执行  
(WebBrowser1.Document as IHTMLDocument2).parentWindow.execScript('window.οnerrοr=function(){return true}','JavaScript');  
  
</pre><pre name="code" class="delphi">//禁止弹出窗口  
procedure TForm1.WebBrowser1NewWindow2(ASender: TObject; var ppDisp: IDispatch;  
var Cancel: WordBool);  
begin  
Cancel := True;  
end;  
</pre><pre name="code" class="delphi">//使WebBrowser获得焦点  
　　TWebBrowser非常特殊，它从TWinControl继承来的SetFocus方法并不能使得它所twebbrows setfocu 方法包含的文档获得焦点，从而不能立即使用Internet Explorer本身具有得internet explor 使用快捷键，解决方法如下：<  
　　procedure TForm1.SetFocusToDoc;  
　　begin  
　　　if WebBrowser1.Document <> nil then  
　　　　with WebBrowser1.Application as Ioleobject do  
　　　　　DoVerb(OLEIVERB_UIACTIVATE, nil, WebBrowser1, 0, Handle, GetClientRect);  
　　end;  
　　除此之外，我还找到一种更简单的方法，这里一并列除此之外这里并列出：  
　　if WebBrowser1.Document <> nil then  
　　　IHTMLWindow2(IHTMLDocument2(WebBrowser1.Document).ParentWindow).focus  
　　刚找到了更简单的方法，也许是最简单的：  
　　if WebBrowser1.Document <> nil then  
　　　IHTMLWindow4(WebBrowser1.Document).focus  
　　还有，需要判断文档是否获得焦点这样来做：  
　　if IHTMLWindow4(WebBrowser1.Document).hasfocus then  
</pre><pre name="code" class="delphi">  
//查找内容  
　　查找对话框可以在文档获得焦点的时候通过按键Ctrl-F对话框焦点按键来调出，程序中则调用IOleCommandTarget对象的成员函数Exec执行OLECMDID_FIND操作olecmdid 操作执行来调用，下面给出的方法是如何在程序中用代码来做出文下面方法如何字选择，即你可以自己设计查找对话框。  
　　　Var  
　　　　Doc: IHtmlDocument2;  
　　　　TxtRange: IHtmlTxtRange;  
　　　begin  
　　　　Doc :=WebBrowser1.Document as IHtmlDocument2;  
　　　　Doc.SelectAll;　　　　//此处为简写，选择全部文档的方法selectal 方法文档请参见第三条命令操作  
　　　　　　　　　　　　　　　　//这句话尤为重要，因重要尤为为IHtmlTxtRange对象的方法能够操作的前提是  
　　　　　　　　　　　　　　　　//Document已经有一个文字选document 文字一个择区域。由于接着执行下面的语句，所以不会  
　　　　　　　　　　　　　　　　//看到文档全选的过程看到过程文档。  
　　　　TxtRange :=Doc.Selection.CreateRange as IHtmlTxtRange;  
　　　　TxtRange.FindText('Text to be searched',0.0);  
　　　　TxtRange.Select;  
　　　end;  
　　还有，从Txt.Get_text可以得到当前选中的文字内容，某些得到文字当前时候是有用的。  
  
</pre><pre name="code" class="delphi">//点击“提交”按钮  
　　如同程序里每个窗体上有一个“缺省”按钮一样，Web一样按钮每个页面上的每个Form也有一个“缺省”按钮——即属性为“Submitsubmit form 按钮”的按钮，当用户按下回车键时就相当于鼠标单击了“Submitsubmit 回车键相当”。但是TWebBrowser似乎并不响应回车键，并且，即使把包含TWebBrowser的twebbrows 回车键似乎窗体的KeyPreview设为True，在窗体的KeyPress事件里还是不能截获用户向keypreview keypress 事件TWebBrowser发出的按键。  
　　我的解决办法是用ApplicatinEvents构件或者自己编写Tapplication对象的OnMessage事onmessag tapplic 构件件，在其中判断消息类型，对键盘消息做出响应。至于点至于响应判断击“提交”按钮，可以通过分析网页源代码的方法来实现源代码网页方法，不过我找到了更为简单快捷的方法，有两种，第一种是更为不过方法我自己想出来的，另一种是别人写的代码，这里都提供给自己这里出来大家，以做参考。  
　　A、用SendKeys函数向WebBrowser发送回车键  
　　　 在Delphi5光盘上的Info/Extras/SendKeys目录下有一个SndKey32.pas文件，sendkei delphi sndkei其中包含了两个函数SendKeys和AppActivate，我们可以用SendKeys函数来向WebBrowser发appactiv webbrows sendkei送回车键，我现在用的就是这个方法，使用很简单，在WebBrowserwebbrows 回车键使用获得焦点的情况下（不要求WebBrowser所包含的文档获得焦点），webbrows 焦点包含用一条语句即可：  
　　　Sendkeys('~',true);// press RETURN key  
　　　SendKeys函数的详细参数说明等，均包含在SndKey32.pas文件中sendkei sndkei 参数。  
　　B、在OnMessage事件中将接受到的键盘消息传递给WebBrowser。  
　　　Procedure TForm1.ApplicationEvents1Message(var Msg: TMsg; var Handled: Boolean);  
　　　{fixes the malfunction of some keys within webbrowser control}  
　　　const  
　　　　StdKeys = [VK_TAB, VK_RETURN]; { standard keys }  
　　　　ExtKeys = [VK_DELETE, VK_BACK, VK_LEFT, VK_RIGHT]; { extended keys }  
　　　　fExtended = $01000000; { extended key flag }  
　　　begin  
　　　　Handled := False;  
　　　　with Msg do  
　　　　if ((Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST)) and  
　　　　　((wParam in StdKeys) or  
　　　　　{$IFDEF VER120}(GetKeyState(VK_CONTROL) < 0) or {$ENDIF}  
　　　　　(wParam in ExtKeys) and  
　　　　　((lParam and fExtended) = fExtended)) then  
　　　　try  
　　　　　if IsChild(Handle, hWnd) then { handles all browser related messages }  
　　　　　begin  
　　　　　　with {$IFDEF VER120}Application_{$ELSE}Application{$ENDIF} as  
　　　　　　　　IOleInPlaceActiveObject do  
　　　　　　　Handled := TranslateAccelerator(Msg) = S_OK;  
　　　　　　　if not Handled then  
　　　　　　　begin  
　　　　　　　　Handled := True;  
　　　　　　　　TranslateMessage(Msg);  
　　　　　　　　DispatchMessage(Msg);  
　　　　　　　end;  
　　　　　　　end;  
　　　　except  
　　　　end;  
　　　end; // MessageHandler  
</pre><pre name="code" class="delphi">  
</pre><pre name="code" class="delphi">10、提取网页中所有链接  
　　这个方法来自大富翁论坛hopfield朋友的对一个问题的回答hopfield 自大问题，我本想自己试验，但总是没成功。  
　　Var  
　　　doc:IHTMLDocument2;  
　　　all:IHTMLElementCollection;  
　　　len,I:integer;  
　　　item:OleVariant;  
　　begin  
　　　doc:=WebBrowser1 .Document as IHTMLDocument2;  
　　　all:=doc.Get_links;　　　　　　　　　　　　　//doc.Links亦可  
　　　len:=all.length;  
　　　for I:=0 to len-1 do begin  
　　　　item:=all.item(I,varempty);　　　　　　　　//EmpryParam亦可  
　　　　memo1.lines.add(item.href);  
　　　end;  
　　end;  
-----------------------------------------------------------------------------------  
11、设置TWebBrowser的编码  
　　为什么我总是错过很多机会？其实早就该想到的，但为什么错过想到是一念之差，便即天壤之别。当时我要是肯再多考虑一下一念之差天壤之别当时，多试验一下，这就不会排到第１１条了。下面给出一个下面试验一个函数，搞定，难以想象的简单。  
　　Procedure SetCharSet(AWebBrowser: TWebBrowser; ACharSet: String);  
　　var  
　　　RefreshLevel: OleVariant;  
　　Begin  
　　　IHTMLDocument2(AWebBrowser.Document).Set_CharSet(ACharSet);  
　　　RefreshLevel :=7;　　　　　　　　　　　　　　//这个7应该从这个应该注册表来，帮助有Bug。  
　　　AWebBrowser.Refresh2(RefreshLevel);  
　　End;  
  
</pre><pre name="code" class="delphi">9．将页面中显示的内容全部选中,然后粘贴到Word文档中.  
WebBrowser1.ExecWB(OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT);//全选网页  
WebBrowser1.ExecWB(OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT);     //复制网页  
WordDocu.Range.Paste;            //word文档粘贴  
WebBrowser1.ExecWB(OLECMDID_UNDO, OLECMDEXECOPT_DODEFAULT);    //取消全选  
注:WebBrowser的Document属性值和WordDocument的Document属性值必须都不为nil.  
10．如何解决网页不响应回车事件  
public  
    { Public declarations }  
    procedure MsgHandle(var Msg :TMsg; var Handled :Boolean);  
end;  
var  
Form1: TForm1;  
FOleInPlaceActiveObject :IOleInPlaceActiveObject;  
implementation  
{$R *.DFM}  
procedure TForm1.MsgHandle(var Msg :TMsg; var Handled :Boolean);  
var  
iOIPAO :IOleInPlaceActiveObject;  
Dispatch :IDispatch;  
begin  
if WebBrowser1 =nil then  
begin  
Handled :=False;  
Exit;  
end;  
Handled :=(IsDialogMessage(WebBrowser1.Handle, Msg) =True);  
if (Handled) and (not WebBrowser1.Busy) then  
begin  
if FOleInPlaceActiveObject =nil then  
begin  
   Dispatch :=WebBrowser1.Application;  
   if Dispatch <>nil then  
   begin  
    Dispatch.QueryInterface(IOleInPlaceActiveObject, iOIPAO);  
    if iOIPAO <>nil then  
     FOleInPlaceActiveObject :=iOIPAO;  
   end;  
end;  
end;  
if FOleInPlaceActiveObject <>nil then  
if ((Msg.message =WM_KEYDOWN) or (Msg.Message =WM_KEYUP)) and ((Msg.wParam =VK_BACK) or (Msg.wParam =VK_LEFT) or (Msg.wParam =VK_RIGHT)) then  
else  
   FOleInPlaceActiveObject.TranslateAccelerator(Msg);  
end;  
procedure TForm1.FormCreate(Sender: TObject);  
begin  
Application.OnMessage :=MsgHandle;  
end;  
procedure TForm1.FormDestroy(Sender: TObject);  
begin  
FOleInPlaceActiveObject :=nil;  
end;  
  
</pre><pre name="code" class="delphi">//在WebBrowser加载html页面完成后,在页面顶端插入HTML代码  
procedure TForm1.Button1Click(Sender: TObject);  
var  
Range: IHTMLTxtRange;  
begin  
Range := ((WebBrowser1.Document as IHTMLDocument2).body as  
    IHTMLBodyElement).createTextRange;  
Range.collapse(False);  
Range.pasteHTML('<br/><b>Hello!</b>');  
end; 