Delphi知识中心
www.delphi.ee
提供Delphi技术知识
与Delphi程序员共同进步


在线服务QQ:99923144 随时恭候您的光临
首页 基础知识 WIN系统 组件使用 组件开发 数据库 ACTIVEX 多媒体技术 网络技术 关于
文章类别:网络技术    你尚未登陆,会员功能无法使用,请从 网站首页 登陆。
  WebBrowser、MSHTML在Delphi中的使用  
 
WebBrowser、MSHTML在Delphi中的使用

1.初始化和终止化

uses ActiveX;

initialization
OleInitialize(nil);
finalization
try
OleUninitialize;
except
end;

2.EmptyParam

EmptyParam是一个公用的Variant空变量,不要对它赋值
var
t:OleVariant;
begin
webbrowser1.Navigate(edit1.text,t,t,t,t);
{这句可以写成webbrowser1.Navigate(edit1.text,EmptyParam,EmptyParam,EmptyParam,EmptyParam);}
end;

3.命令操作

常用的命令操作用ExecWB方法即可完成
procedure ExecWB(cmdID: OLECMDID; cmdexecopt: OLECMDEXECOPT); overload;
procedure ExecWB(cmdID: OLECMDID; cmdexecopt: OLECMDEXECOPT; var pvaIn: OleVariant); overload;
procedure ExecWB(cmdID: rOLECMDID; cmdexecopt: OLECMDEXECOPT; var pvaIn: OleVariant; var pvaOut: OleVariant); overload;

打开:CommandID为OLECMDID_OPEN
另存为:ExecWB(OLECMDID_SAVEAS,OLECMDEXECOPT_DODEFAULT, EmptyParam, EmptyParam);
打印:ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT, EmptyParam, EmptyParam);
打印预览:if QueryStatusWB(OLECMDID_PRINTPREVIEW)=3 then ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT, EmptyParam,EmptyParam);
页面设置:ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_DODEFAULT, EmptyParam, EmptyParam);
剪切:ExecWB(OLECMDID_CUT,OLECMDEXECOPT_DODEFAULT);
复制:ExecWB(OLECMDID_COPY,OLECMDEXECOPT_DODEFAULT);
粘贴:ExecWB(OLECMDID_PASTE,OLECMDEXECOPT_DODEFAULT);
全选:ExecWB(OLECMDID_SELECTALL,OLECMDEXECOPT_DODEFAULT);

A.使用TWebBrowser的QueryStatusWB方法
if(QueryStatusWB(OLECMDID_COPY)=OLECMDF_ENABLED or OLECMDF_SUPPORTED) then
ExecWB(OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT, EmptyParam, EmptyParam);
B.用IHTMLDocument2的QueryCommandEnabled方法
var
Doc: IHTMLDocument2;
begin
Doc :=WebBrowser1.Document as IHTMLDocument2;
if Doc.QueryCommandEnabled('Copy') then
Doc.ExecCommand('Copy',false,EmptyParam);
end;

4.字体大小

类似“字体”菜单上的从“最大”到“最小”五项(对应整数0~4,Largest等假设为五个菜单项的名字,Tag属性分别设为0~4)。

读取当前页面字体大小。
var
t: OleVariant;
Begin
WebBrowser1.ExecWB(OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, EmptyParam,t);
case t of
4: Largest.Checked :=true;
3: Larger.Checked :=true;
2: Middle.Checked :=true;
1: Small.Checked :=true;
0: Smallest.Checked :=true;
end;
end;

设置页面字体大小。
Largest.Checked :=false;
Larger.Checked :=false;
Middle.Checked :=false;
Small.Checked :=false;
Smallest.Checked :=false;
TMenuItem(Sender).Checked :=true;
t :=TMenuItem(Sender).Tag;
WebBrowser1.ExecWB(OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER,t,t);

5.使WebBrowser获得焦点

uses MSHTML;

方法一:
if WebBrowser1.Document <> nil then
IHTMLWindow2(IHTMLDocument2(WebBrowser1.Document).ParentWindow).focus;

方法二:
procedure TForm1.SetFocusToDoc;
begin
if WebBrowser1.Document <> nil then
with WebBrowser1.Application as IOleobject do
DoVerb(OLEIVERB_UIACTIVATE, nil, WebBrowser1, 0, Handle, GetClientRect);
end;

6.点击提交按钮

A.在Delphi 5光盘上的Info\Extras\SendKeys目录下有一个SndKey32.pas文件,其中包含了两个函数SendKeys和AppActivate,我们可以用SendKeys函数来向WebBrowser发送回车键
Sendkeys('~',true);

B.在OnMessage事件中将接受到的键盘消息传递给WebBrowser。
procedure TMainForm.ApplicationEvents1Message(var Msg: TagMSG;
var Handled: Boolean);
const
StdKeys = [VK_TAB, VK_RETURN];
ExtKeys = [VK_DELETE, VK_BACK, VK_LEFT, VK_RIGHT];
fExtended = $01000000;
begin
Handled := False;
with Msg do
if ((Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST)) and
((wParam in StdKeys) or (GetKeyState(VK_Control) < 0) or
(wParam in ExtKeys) and ((lParam and fExtended) = fExtended)) then
try
if IsChild((PCT.ActivePage as TTabs).FMIE.handle, hWnd) then
begin
with (PCT.ActivePage as TTabs).FMIE.Application as IOleInPlaceActiveObject do
Handled := (TranslateAccelerator(Msg) = S_OK);
if not Handled then
begin
Handled := True;
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
except
end;
end;

7.直接从TWebBrowser得到网页源码及Html

IHtmlDocument2(WebBrowser1.Document).Body.OuterHtml;

8.查找功能

var
Doc: IHtmlDocument2;
TxtRange: IHtmlTxtRange;
begin
Doc :=WebBrowser1.Document as IHtmlDocument2;
webbrowser1.ExecWB(OLECMDID_SELECTALL,OLECMDEXECOPT_DODEFAULT);
TxtRange :=Doc.Selection.CreateRange as IHtmlTxtRange;
TxtRange.findText('Text to be searched',0,0);
TxtRange.Select;
end;

9.提取网页中所有链接

procedure TMainForm.GetLinks;
var
doc: IHTMLDocument2;
all: IHTMLElementCollection;
len, i: Integer;
item: OleVariant;
begin
FormLink.lstLink.Clear;
try
doc := ((PCT.ActivePage as TTabs).FMIE.Document) as IHTMLDocument2;
except
Exit;
end;
all := doc.Links;
len := all.Length;
for i := 0 to len - 1 do begin
item := all.item(i, varempty); //EmpryParam亦可
FormLink.lstLink.Items.Add(item);
end;
FormLink.Show;
end;


10.设置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;

11.转入IHTMLDocument接口

uses mshtml;
var doc:IHTMLDocument2;
doc:=webbrowser1.document as IHTMLDocument2;

12.TWebBrowser控件说明

方法:
GoBack 相当于IE的“后退”按钮,使你在当前历史列表中后退一项
GoForward 相当于IE的“前进”按钮,使你在当前历史列表中前进一项
GoHome 相当于IE的“主页”按钮,连接用户默认的主页
GoSearch 相当于IE的“搜索”按钮,连接用户默认的搜索页面
Navigate 连接到指定的URL
Refresh 刷新当前页面
Refresh2 同上,只是可以指定刷新级别,所指定的刷新级别的值来自RefreshConstants枚举表,该表定义在ExDisp.h中,可以指定的不同值如下:
REFRESH_NORMAL 执行简单的刷新,不将HTTP pragma: no-cache头发送给服务器
REFRESH_IFEXPIRED 只有在网页过期后才进行简单的刷新
REFRESH_CONTINUE 仅作内部使用。在MSDN里写着DO NOT USE! 请勿使用
REFRESH_COMPLETELY 将包含pragma: no-cache头的请求发送到服务器
Stop 相当于IE的“停止”按钮,停止当前页面及其内容的载入

属性:
Application 如果该对象有效,则返回掌管WebBrowser控件的应用程序实现的自动化对象(IDispatch)。如果在宿主对象中自动化对象无效,这个程序将返回WebBrowser控件的自动化对象
Parent 返回WebBrowser控件的父自动化对象,通常是一个容器,例如是宿主或IE窗口
Container 返回WebBrowser控件容器的自动化对象。通常该值与Parent属性返回的值相同
Document 为活动的文档返回自动化对象。如果HTML当前正被显示在WebBrowser中,则Document属性提供对DHTML Object Model的访问途径
TopLevelContainer 返回一个Boolean值,表明IE是否是WebBrowser控件顶层容器,是就返回true
Type 返回已被WebBrowser控件加载的对象的类型。例如:如果加载.doc文件,就会返回Microsoft Word Document
Left 返回或设置WebBrowser控件窗口的内部左边与容器窗口左边的距离
Top 返回或设置WebBrowser控件窗口的内部左边与容器窗口顶边的距离
Width 返回或设置WebBrowser窗口的宽度,以像素为单位
Height 返回或设置WebBrowser窗口的高度,以像素为单位
LocationName 返回一个字符串,该字符串包含着WebBrowser当前显示的资源的名称,如果资源是网页就是网页的标题;如果是文件或文件夹,就是文件或文件夹的名称
LocationURL 返回WebBrowser当前正在显示的资源的URL
Busy 返回一个Boolean值,说明WebBrowser当前是否正在加载URL,如果返回true就可以使用stop方法来撤销正在执行的访问操作

事件
BeforeNavigate2 导航发生前激发,刷新时不激发
CommandStateChange 当命令的激活状态改变时激发。它表明何时激活或关闭Back和Forward菜单项或按钮
DocumentComplete 当整个文档完成是激发,刷新页面不激发
DownloadBegin 当某项下载操作已经开始后激发,刷新也可激发此事件
DownloadComplete 当某项下载操作已经完成后激发,刷新也可激发此事件
NavigateComplete2 导航完成后激发,刷新时不激发
NewWindow2 在创建新窗口以前激发
OnFullScreen 当FullScreen属性改变时激发。该事件采用VARIENT_BOOL的一个输入参数来指示IE是全屏显示方式(VARIENT_TRUE)还是普通显示方式(VARIENT_FALSE)
OnMenuBar 改变MenuBar的属性时激发,标示参数是VARIENT_BOOL类型的。VARIANT_TRUE是可见,VARIANT_ FALSE是隐藏
OnQuit 无论是用户关闭浏览器还是开发者调用Quit方法,当IE退出时就会激发
OnStatusBar 与OnMenuBar调用方法相同,标示状态栏是否可见。
OnToolBar 调用方法同上,标示工具栏是否可见。
OnVisible 控制窗口的可见或隐藏,也使用一个VARIENT_BOOL类型的参数
StatusTextChange 如果要改变状态栏中的文字,这个事件就会被激发,但它并不理会程序是否有状态栏
TitleChange 网页标题有效或改变时激发

MSHTML把HTML页面中的元素封装成了IHTMLInputElement、 IHTMLInputButtonElement、IHTMLInputTextElement、IHTMLTextAreaElement、 IHTMLTitleElement、IHTMLFormElement等等组件接口。在程序中可以通过MSHTML提供的IHTMLDocument2 接口得到整个Document对象,IHTMLElementCollection接口得到所有页面元素的集合,通过该接口的Item方法可以得到具体的某个组件,然后设置和读取该组件的属性值。下面是一些常用功能的事例代码.

1. 打开某个页面: web.Navigate(ExtractFilePath(Application.ExeName) + 'Template/login.html');

2. 取出页面中某个HtmlElement的Value属性值:

function GetValueByElementName(web: TWebBrowser; elementName: string; index: integer): string;

begin

result := (((web.Document as IHTMLDocument2).body.all as

IHTMLElementCollection).item(elementName, index) as IHTMLInputElement ).valueend;

3. 给HtmlElement设置Value属性

procedure SetValueTextAreaName(web: TWebBrowser; elementName, value: string;index: integer);

begin(((web.Document as IHTMLDocument2).body.all as IHTMLElementCollection).item(elementName, index) as IHTMLTextAreaElement).value := value;

end;

4.判断页面执行结果是否成功因为Web应用中如果出错的一般是采用错误页面的方式呈现给最终用户,所以我们也无法抓到Http错误,只能通过在 webBeforeNavigate2事件中将URL参数记录到全局变量中, 然后在webDocumentComplete事件中根据URL参数和全局变量中的URL参数来判断执行结果是否正确.

当然,这样需要将页面地址编码到代码中,降低了灵活性,但是这也是我能想到的唯一的方法,如果大家有什么好的方法,请告诉我哦.

5. 屏蔽鼠标右键和某些快捷键本功能需要在webBrowser的窗口中加入ApplicationEvents组件,设置它的OnMessage事件代码如下即可.

procedure TwebAdapterForm.ApplicationEvents1Message(var Msg: tagMSG;

var Handled: Boolean);

const_KeyPressMask = $80000000;

begin//禁用右键

with Msg dobegin if not IsChild(web.Handle, hWnd) then Exit;

Handled := (message = WM_RBUTTONDOWN) or (message = WM_RBUTTONUP) or (message = WM_CONTEXTMENU);

end;

//禁止Ctrl + N//禁止Ctrl + F//禁止Ctrl + A

if Msg.message = WM_KEYDOWN then

begin if ((Msg.lParam and _KeyPressMask) = 0) and (GetKeyState(VK_Control) <0) and ((Msg.wParam = Ord('N')) or (Msg.wParam = Ord('F')) or (Msg.wParam = Ord('A'))) then begin Handled := True;

end;

end;

end;

6. 在页面关闭的时候,同时关掉包含页面的VCL Form.(仅限 InternetExplorer 6.0)本功能需要卸载掉Delphi自带的 WebBrowser组件,安装ActionX组件(Microsoft Internet Controls V1.1),而且以后的程序只能运行在安装有Internet Explorer 6.0 的环境下.具体方法如下:在WebBrowser组件的OnWindowClosing事件中,输入self.close; 代码即可.如果需要阻止窗口的关闭, 设置CanClose参数的值为Flase.

7. 如何将页面中超链接新开的页面窗口包到指定的VCL窗口中.

procedure TForm1.webNewWindow2(Sender: TObject; var ppDisp: IDispatch;var Cancel: WordBool);varform : TForm1;

begin form := TForm1.Create(nil);ppDisp := form.web.DefaultDispatch;form.Show;

end;
8.在WebBrowser加载html页面完成后,在页面顶端插入HTML代码, 下面两种方式斗可以.

{1. ----------------------------------------------------------------}

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;


{2. ----------------------------------------------------------------}

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;

const pDisp: IDispatch; var URL: OleVariant);

var

WebDoc: HTMLDocument;

WebBody: HTMLBody;

begin

WebDoc := WebBrowser1.Document as HTMLDocument;

WebBody := WebDoc.body as HTMLBody;

WebBody.insertAdjacentHTML('BeforeEnd', '

Hello World!

');

end;

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;

11如何在WebBrowser中调用当前页面中的javascript函数SayHello()

WebBrowser1.OleObject.

Document.parentWindow.execScript('SayHello()', 'javascript');

//or

(WebBrowser1.Document as IHTMLDocument2

).parentWindow.execScript('SayHello()', 'javascript')

//or

webrowser1.document.script.SayHello();

 

在线服务QQ:99923144 Delphi程序员QQ群(139442)
Delphi知识中心 www.delphi.ee 最专业的Delphi技术资料网站