delphi中webbrowser的用法

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;
//调用网页脚本中的函数:
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.OleObject.document.parentWindow.MB(); //HTML-Js
//如需指定脚本语言, 需要:
WebBrowser1.OleObject.document.parentWindow.execScript('MB()','JavaScript'); //HTML-Js
end;
//判断网页及内部框架网页是否全部下载完毕
procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
if not(WebBrowser1.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;
//获取网页源代码
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">Memo1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).Body.OuterHtml);
//获取网页全部源代码
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.onerror=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(' Hello!');
end;

posted on 2016-10-21 17:46 萌萌哒的大宝宝阅读(612) 评论(3) 编辑收藏举报

会员力量，点亮园子希望

刷新页面返回顶部

萌萌哒的大宝宝

公告