Delphi中TWebBrowser的用法

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;
&lt;br&gt;假如网页中有这样的语句:&lt;br&gt;&amp;amp;lt;script&amp;amp;gt;&lt;br&gt;var&lt;br&gt; str = &quot;Hello&quot;;&lt;br&gt; i = 99;&lt;br&gt;&amp;amp;lt;/script&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;
&lt;br&gt;假如有这样的脚本:&lt;br&gt;&amp;amp;lt;script&amp;amp;gt;&lt;br&gt;function MB(){ &lt;br&gt; alert('HTML-Js');&lt;br&gt;}&lt;br&gt;&amp;amp;lt;/script&amp;amp;gt;
//判断网页及内部框架网页是否全部下载完毕
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;
&lt;br&gt;假如网页中有这样的内容:&lt;br&gt;&amp;amp;lt;span id=span1&amp;amp;gt;这是 span1 标签中的内容&amp;amp;lt;/span&amp;amp;gt;&lt;br&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">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.ο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(' Hello!');
end;

Delphi中TWebBrowser的用法相关推荐

delphi 中 delete的用法
delete 是删除一个字符串中的某部分字符用法是 delete(str,//被删除的字符串 index,//从第几个字符开始删除 co ...
delphi中pos的用法
1.含义 pos(a,b)函数用法,取出子串a,在父串b中第一次出现的位置. 2.举例 pos('A','DDDAD'),则返回结果是4. 3.应用 nicez在strX字符串中是否存在的判断 if ...
delphi中try的用法1
try...except..end;查询异常 try edHH.Visible := False; ListBox.Visible := not edHH.Visible; listBox.Clear ...
Delphi中TWebBrowser中注入Js
最近帮朋友做一个软件,其中要自动化某网页中的操作,最简的操作是调用自己写的代码. 代码如下: procedure TForm1.Button2Click(Sender: TObject); var ...
delphi中指针的用法
大家都认为,C语言之所以强大,以及其自由性,很大部分体现在其灵活的指针运用上.因此,说指针是C语言的灵魂,一点都不为过.同时,这种说法也让很多人产生误解,似乎只有C语言的指针才能算指针.Basic不支 ...
教程-Delphi中Spcomm使用属性及用法详解
Delphi中Spcomm使用属性及用法详解 Delphi是一种具有功能强大.简便易用和代码执行速度快等优点的可视化快速应用开发工具,它在构架企业信息系统方面发挥着越来越重要的作用,许多程序员愿意选 ...
delphi中move函数的用法
delphi中move函数的用法 -------------------------------------------------------------------------------- 20 ...
Delphi中 StrToIntDef函数的用法
Delphi中 StrToIntDef函数的用法: 比如我要判断一个文本框里输入的字符串能不能转换为integer类型,如果能,则返回转换后的整型数据,如果不能,则返回整数0,那么我就可以用strto ...
Delphi中Messagedlg用法
Delphi中Messagedlg用法 if MessageDlg('即将退出,是否继续?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin ...
在Delphi中FormatDateTime函数的用法
在Delphi中FormatDateTime函数的用法 function FormatDateTime(const Format: string; DateTime: TDateTime): str ...

Delphi中TWebBrowser的用法

Delphi中TWebBrowser的用法相关推荐

最新文章

热门文章