c# webbrowser新窗口 浏览次数：621次悬赏分：50 | 解决时间：2010-4-28 06:58 | 提问者：jeogegxs
我用的是.net2005（C#）中AxSHDocVw.AxWebBrowser的webbrowser控件。
我现在想在点击链接或按钮弹出新窗口时，webbrowser的大小和弹出窗口页面设置的窗口大小一致（如javascript里window.open里写的width=400;height=300这种）。请问如何做才能做到？问题补充：
wei6490，你好。因为每次弹出的窗口大小都可能不一样，所以需要动态获取弹出窗的大小。我想知道怎么才能动态获取弹出窗口大小。
======================================================================
文刀MP，你好。可能我没说清楚。我的webbrowser是放在一个form里的，我想让form的大小适应弹出窗口的大小。webbrowser我已经设为dock=fill了
最佳答案 您好!我直接贴代码吧:
WebBrowser加载完网页后有个事件,那时候可以获得内容网页正确的宽高.
1.为webbrowser控件添加该事件:
wb.DocumentCompleted += new WebBrowserDocumentCompletedEventHandler(wb_DocumentCompleted);
//(注:也可以在属性设计器里面添加事件)
2.在事件里面写代码,获得网页宽高同时调整Form窗体大小:
void wb_DocumentCompleted(object sender, WebBrowserDocumentCompletedEventArgs e)
{
int width=wb.Document.ScrollWidth;
int height=wb.Document.ScrollHeight;
this.Form1.Size=new Size(width,height);
}
以上是我们专案的做法,希望可以帮到您;您可以尝试下再给分.
////////////////////////////////////////////////////////////////////////////
设置 webbroser1 事件 Events (NewWindow2)方法
procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
begin
Cancel:=true; //禁止打开新窗口
end;
////////////////////////////////////////
delphi浏览器新建窗口如何使用 WebBrowser 控件 NewWindow2 事件delphi浏览器 2009-04-08 14:11:23 阅读559 评论0 字号：大中小 订阅
为显示一个资源创建一个新的窗口时发生 NewWindow2 事件。 此事件以响应一个导航目标到一个新的窗口或一个脚本的 window.open 方法例如，之前从 WebBrowser 控件中的一个新的窗口的创建。
此事件的事件处理程序收到两个输出参数：
为了指定则打开一个新的窗口时，应使用您的浏览器应用程序，您设置 ppDisp 为等于一个新的 WebBrowser 您的应用程序创建一个新的窗口中包含的对象。 in this scenario，if user chooses to open Web page in new window，new window in your application will be used to display new Web page。
此外，将 RegisterAsBrowser 属性设置为新创建的 WebBrowser 控件，以便它参与窗口名称解析为 TRUE。 例如，如果在脚本中其他地方使用此窗口名，然后此控件将而不使用新创建的一个因为它打开一个新的窗口之前检查的所有现有的窗口名称。
//try
procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
begin
WebBrowser1.RegisterAsBrowser := True;
ppDisp := WebBrowser1.ControlInterface;
end;
由于项目需要，近来研究了一下WebBrowser组件和MSHTML 在Delphi中的使用,整理了一下这段时间研究的结果,写下来一是方便大家查阅,二也可以加深我自己的记忆.希望能对大家有所帮助… …,同时,如果有更好的处理方式或者我没有提到的问题,请大家也告诉我哦, 咱们一块进步… ...,其中一部分是我从网络中搜集的资料,谢谢那些兄弟们… …
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
).value
end;
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 do
begin
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);
var
form : 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('<br/><b>Hello!</b>');
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', '<h1>Hello World!</h1>');
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();
////////////////////////////////////////////////////////////////////////////////////////////
Delphi WebBrowser编程简述 收藏
< type="text/JavaScript"> alimama_pid="mm_10249644_1605763_4929893"; alimama_titlecolor="0000FF"; alimama_descolor ="000000"; alimama_bgcolor="FFFFFF"; alimama_bordercolor="E6E6E6"; alimama_linkcolor="008000"; alimama_bottomcolor="FFFFFF"; alimama_anglesize="0"; alimama_bgpic="0"; alimama_icon="0"; alimama_sizecode="16"; alimama_width=658; alimama_height=60; alimama_type=2; < src="http://a.alimama.cn/inf.js" type=text/javascript>
Delphi 3开始有了TWebBrowser构件，不过那时是以ActiveX控件的形式出现的，而且需要自己引入，在其后的4.0和5.0中，它就在封装好shdocvw.dll之后作为Internet构件组之一出现在构件面板上了。常常听到有人骂Delphi的帮助做得极差，这次的TWebBrowser又是Microsoft的东东，自然
这里有平时我自己用TWebBrowser做程序的一些心得和上网收集到的部分例子和资料，整理了一下，希望能给有兴趣用TWebBrowser编程的朋友带来些帮助。
-----------------------------------------------------------------
TWebBrowser控件打开本地网页文件，如何让它不弹出警告
TWebBrowser控件打开包含了js代码本地的网页文件就会弹出错误对话框
请问怎么才能去掉这个对话框并且能执行js脚本？< type="text/JavaScript"> alimama_pid="mm_10249644_1605763_5018464"; alimama_type="f"; alimama_sizecode ="tl_1x1_8"; alimama_fontsize=12; alimama_bordercolor="FFFFFF"; alimama_bgcolor="FFFFFF"; alimama_titlecolor="0000FF"; alimama_underline=0; alimama_height=22; alimama_width=0; < src="http://a.alimama.cn/inf.js" type=text/javascript>
网友回复:TWebBrowser控件打开包含了js代码的本地网页文件就会弹出错误对话框
请问怎么才能去掉这个对话框并且能执行js脚本？
看到一些邮件客户端的编辑器就是调用了本地网页文件，但是却不弹出对话框
网友回复:TWebBrowser的OnDownloadComplete事件里面执行
(WebBrowser1.Document as IHTMLDocument2).parentWindow.execScript('window.onerror=function(){return true}','JavaScript');
网友回复:谢谢ideation_shang
------------------------------------------------------------------
注意：
1、CSS对打印的控制：
<!--media=print 这个属性可以在打印时有效-->
<style media=print>
.Noprint{display:none;}
.PageNext{page-break-after: always;}
</style>
Noprint样式可以使页面上的打印按钮等不出现在打印页面上，这一点非常重要，因为它可以用最少的代码完成最需要的功能
PageNext样式可以设置分页，在需要分页的地方<div class="PageNext"></div>就OK了，呵呵
-----------------------------------------------------------------
WebBrowser.ExecWB(1,1) 打开
WebBrowser.ExecWB(2,1) 关闭现在所有的IE窗口，并打开一个新窗口
WebBrowser.ExecWB(4,1) 保存网页
WebBrowser.ExecWB(6,1) 打印
WebBrowser.ExecWB(7,1) 打印预览
WebBrowser.ExecWB(8,1) 打印页面设置
WebBrowser.ExecWB(10,1) 查看页面属性
WebBrowser.ExecWB(15,1) 好像是撤销，有待确认
WebBrowser.ExecWB(17,1) 全选
WebBrowser.ExecWB(22,1) 刷新
WebBrowser.ExecWB(45,1) 关闭窗体无提示
----------------------------------------------------------
１、初始化和终止化（Initialization & Finalization）
大家在执行TWebBrowser的某个方法以进行期望的操作，如ExecWB等的时候可能都碰到过“试图激活未注册的丢失目标”或“OLE对象未注册”等错误，或者并没有出错但是得不到希望的结果，比如不能将选中的网页内容复制到剪贴板等。以前用它编程的时候，我发现ExecWB有时侯起作用但有时侯又不行，在Delphi生成的缺省工程主窗口上加入TWebBrowser，运行时并不会出现“OLE对象未注册”的错误。同样是一个偶然的机会，我才知道OLE对象需要初始化和终止化（懂得的东东实在太少了）。
我用我的前一篇文章《Delphi程序窗口动画&正常排列平铺的解决》所说的方法编程，运行时出了上面所说的错误，我便猜想应该有OleInitialize之类的语句，于是，找到并加上了下面几句话，终于搞定！究其原因，我想大概是由于TWebBrowser是一个嵌入的OLE对象而不算是用Delphi编写的VCL吧。
Initialization
OleInitialize(nil);
finalization
try
OleUninitialize;
except
end;
这几句话放在主窗口所有语句之后，“end.”之前。
-----------------------------------------------------------------------------------
２、EmptyParam
在Delphi 5中TWebBrowser的Navigate方法被多次重载：
procedure Navigate(const URL: WideString); overload;
procedure Navigate(const URL: WideString; var Flags: OleVariant); overload;
procedure Navigate(const URL: WideString; var Flags: OleVariant; var TargetFrameName: OleVariant); overload;
procedure Navigate(const URL: WideString; var Flags: OleVariant; var TargetFrameName: OleVariant; var PostData: OleVariant); overload;
procedure Navigate(const URL: WideString; var Flags: OleVariant; var TargetFrameName: OleVariant; var PostData: OleVariant; var Headers: OleVariant); overload;
而在实际应用中，使用后几种方法调用时，由于我们很少用到后面几个参数，但函数声明又要求是变量参数，一般的做法如下：
var
t:OleVariant;
begin
webbrowser1.Navigate(edit1.text,t,t,t,t);
end;
需要定义变量t（还有很多地方要用到它），很麻烦。其实我们可以用EmptyParam来代替（EmptyParam是一个公用的Variant空变量，不要对它赋值），只需一句话就可以了：
webbrowser1.Navigate(edit1.text,EmptyParam,EmptyParam,EmptyParam,EmptyParam);
虽然长一点，但比每次都定义变量方便得多。当然，也可以使用第一种方式。
Webbrowser1.Navigate(edit1.text)
-----------------------------------------------------------------------------------
３、命令操作 常用的命令操作用ExecWB方法即可完成，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;
打开： 弹出“打开Internet地址”对话框，CommandID为OLECMDID_OPEN（若浏览器版本为IE5.0，则此命令不可用）。
另存为：调用“另存为”对话框。
ExecWB(OLECMDID_SAVEAS,OLECMDEXECOPT_DODEFAULT, EmptyParam,
EmptyParam);
打印、打印预览和页面设置： 调用“打印”、“打印预览”和“页面设置”对话框（IE5.5及以上版本才支持打印预览，故实现应该检查此命令是否可用）。
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);
剪切、复制、粘贴、全选： 功能无须多说，需要注意的是：剪切和粘贴不仅对编辑框文字，而且对网页上的非编辑框文字同样有效，用得好的话，也许可以做出功能特殊的东东。获得其命令使能状态和执行命令的方法有两种（以复制为例，剪切、粘贴和全选分别将各自的关键字替换即可，分别为CUT,PASTE和SELECTALL）：
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;
查找： 参考第九条“查找”功能。
-----------------------------------------------------------------------------------
４、字体大小
类似“字体”菜单上的从“最大”到“最小”五项（对应整数0～4，Largest等假设为五个菜单项的名字，Tag 属性分别设为0～4）。
A、读取当前页面字体大小。
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;
B、设置页面字体大小。
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);
-----------------------------------------------------------------------------------
５、添加到收藏夹和整理收藏夹
const
CLSID_ShellUIHelper: TGUID = '{64AB4BB7-111E-11D1-8F79-00C04FC2FBE1}';
var
p:procedure(Handle: Thandle; Path: Pchar); stdcall;
procedure TForm1.OrganizeFavorite(Sender: Tobject);
var
H: HWnd;
begin
H := LoadLibrary(Pchar('shdocvw.dll'));
if H <> 0 then
begin
p := GetProcAddress(H, Pchar('DoOrganizeFavDlg'));
if Assigned(p) then p(Application.Handle, Pchar(FavFolder));
end;
FreeLibrary(h);
end;
procedure TForm1.AddFavorite(Sender: Tobject);
var
ShellUIHelper: ISHellUIHelper;
url, title: Olevariant;
begin
Title := Webbrowser1.LocationName;
Url := Webbrowser1.LocationUrl;
if Url <> ' then
begin
ShellUIHelper := CreateComObject(CLSID_SHELLUIHELPER) as IShellUIHelper;
ShellUIHelper.AddFavorite(url, title);
end;
end;
用上面的通过ISHellUIHelper接口来打开“添加到收藏夹”对话框的方法比较简单，但是有个缺陷，就是打开的窗口不是模式窗口，而是独立于应用程序的。可以想象，如果使用与OrganizeFavorite过程同样的方法来打开对话框，由于可以指定父窗口的句柄，自然可以实现模式窗口（效果与在资源管理器和IE中打开“添加到收藏夹”对话框相同）。问题显然是这样的，上面两个过程的作者当时只知道shdocvw.dll中DoOrganizeFavDlg的原型而不知道DoAddToFavDlg的原型，所以只好用ISHellUIHelper接口来实现（或许是他不够严谨，认为是否是模式窗口无所谓？）。
下面的过程就告诉你DoAddToFavDlg的函数原型。需要注意的是，这样打开的对话框并不执行“添加到收藏夹”的操作，它只是告诉应用程序用户是否选择了“确定”，同时在DoAddToFavDlg的第二个参数中返回用户希望放置Internet快捷方式的路径，建立.Url文件的工作由应用程序自己来完成。
Procedure TForm1.AddFavorite(IE: TEmbeddedWB);
procedure CreateUrl(AUrlPath, Aurl: Pchar);
var
URLfile: TIniFile;
begin
URLfile := TIniFile.Create(String(AUrlPath));
Rlfile.WriteString('InternetShortcut', 'URL', String(Aurl));
Rlfile.Free;
end;
var
AddFav: function(Handle: Thandle;
UrlPath: Pchar; UrlPathSize: Cardinal;
Title: Pchar; TitleSize: Cardinal;
FavIDLIST: pItemIDList): Bool; stdcall;
Fdoc: IHTMLDocument2;
UrlPath, url, title: array[0..MAX_PATH] of char;
H: HWnd;
pidl: pItemIDList;
FRetOK: Bool;
begin
Fdoc := IHTMLDocument2(IE.Document);
if Fdoc = nil then exit;
StrPCopy(Title, Fdoc.Get_title);
StrPCopy(url, Fdoc.Get_url);
if Url <> ' then
begin
H := LoadLibrary(Pchar('shdocvw.dll'));
if H <> 0 then
begin
SHGetSpecialFolderLocation(0, CSIDL_FAVORITES, pidl);
AddFav := GetProcAddress(H, Pchar('DoAddToFavDlg'));
if Assigned(AddFav) then
FRetOK :=AddFav(Handle, UrlPath, Sizeof(UrlPath), Title, Sizeof(Title), pidl)
end;
FreeLibrary(h);
if FRetOK then
CreateUrl(UrlPath, Url);
end
end;
-----------------------------------------------------------------------------------
６、使WebBrowser获得焦点
TWebBrowser非常特殊，它从TWinControl继承来的SetFocus方法并不能使得它所包含的文档获得焦点，从而不能立即使用Internet Explorer本身具有得快捷键，解决方法如下：<
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
-----------------------------------------------------------------------------------
７、点击“提交”按钮
如同程序里每个窗体上有一个“缺省”按钮一样，Web页面上的每个Form也有一个“缺省”按钮——即属性为“Submit”的按钮，当用户按下回车键时就相当于鼠标单击了“Submit”。但是TWebBrowser似乎并不响应回车键，并且，即使把包含TWebBrowser的窗体的KeyPreview设为True，在窗体的KeyPress事件里还是不能截获用户向TWebBrowser发出的按键。
我的解决办法是用ApplicatinEvents构件或者自己编写Tapplication对象的OnMessage事件，在其中判断消息类型，对键盘消息做出响应。至于点击“提交”按钮，可以通过分析网页源代码的方法来实现，不过我找到了更为简单快捷的方法，有两种，第一种是我自己想出来的，另一种是别人写的代码，这里都提供给大家，以做参考。
A、用SendKeys函数向WebBrowser发送回车键
在Delphi 5光盘上的Info\Extras\SendKeys目录下有一个SndKey32.pas文件，其中包含了两个函数SendKeys和AppActivate，我们可以用SendKeys函数来向WebBrowser发送回车键，我现在用的就是这个方法，使用很简单，在WebBrowser获得焦点的情况下（不要求WebBrowser所包含的文档获得焦点），用一条语句即可：
Sendkeys('~',true);// press RETURN key
SendKeys函数的详细参数说明等，均包含在SndKey32.pas文件中。
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
（此方法来自EmbeddedWB.pas）
-----------------------------------------------------------------------------------
８、直接从TWebBrowser得到网页源码及Html
下面先介绍一种极其简单的得到TWebBrowser正在访问的网页源码的方法。一般方法是利用TWebBrowser控件中的Document对象提供的IPersistStreamInit接口来实现，具体就是：先检查WebBrowser.Document对象是否有效，无效则退出;然后取得IPersistStreamInit接口，接着取得HTML源码的大小，分配全局堆内存块，建立流，再将HTML文本写到流中。程序虽然不算复杂，但是有更简单的方法，所以实现代码不再给出。其实基本上所有IE的功能TWebBrowser都应该有较为简单的方法来实现，获取网页源码也是一样。下面的代码将网页源码显示在Memo1中。
Memo1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).Body.OuterHtml);
同时，在用TWebBrowser浏览HTML文件的时候要将其保存为文本文件就很简单了，不需要任何的语法解析工具，因为TWebBrowser也完成了，如下：
Memo1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).Body.OuterText);
-----------------------------------------------------------------------------------
９、“查找”功能
查找对话框可以在文档获得焦点的时候通过按键Ctrl-F来调出，程序中则调用IOleCommandTarget对象的成员函数Exec执行OLECMDID_FIND操作来调用，下面给出的方法是如何在程序中用代码来做出文字选择，即你可以自己设计查找对话框。
Var
Doc: IHtmlDocument2;
TxtRange: IHtmlTxtRange;
begin
Doc :=WebBrowser1.Document as IHtmlDocument2;
Doc.SelectAll; //此处为简写，选择全部文档的方法请参见第三条命令操作
//这句话尤为重要，因为IHtmlTxtRange对象的方法能够操作的前提是
//Document已经有一个文字选择区域。由于接着执行下面的语句，所以不会
//看到文档全选的过程。
TxtRange :=Doc.Selection.CreateRange as IHtmlTxtRange;
TxtRange.FindText('Text to be searched',0.0);
TxtRange.Select;
end;
还有，从Txt.Get_text可以得到当前选中的文字内容，某些时候是有用的。 -----------------------------------------------------------------------------------
１０、提取网页中所有链接
这个方法来自大富翁论坛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;
-----------------------------------------------------------------------------------
１１、设置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;
１２、从WEBBOWSER中直接存为MHT代码
procedure WB_SaveAs_MHT(WB: TWebBrowser; FileName: string);
var
Msg: IMessage;
Conf: IConfiguration;
Stream: _Stream;
URL: widestring;
{ _Stream定义在ADODB_TLB单元.IMessage和IConfiguration接口代码来自cdosys.dll.
CDO_TLB产生过程：选择菜单PROJECT中的"Import Type Library", 然后选择"C:\WINDOWS\system32\cdosys.dll"
文件，按下"Create unit"按钮.}
begin
if not Assigned(WB.Document) then Exit;
URL := WB.LocationURL;
Msg := CoMessage.Create;
Conf := CoConfiguration.Create;
try
Msg.Configuration := Conf;
Msg.CreateMHTMLBody(URL, cdoSuppressAll, '', '');
Stream := Msg.GetStream;
Stream.SaveToFile(FileName, adSaveCreateOverWrite);
finally
Msg := nil;
Conf := nil;
Stream := nil;
end;
end; (* WB_SaveAs_MHT *) < type=text/JavaScript> < type="text/JavaScript"> alimama_pid="mm_10249644_1605763_5027492"; alimama_type="f"; alimama_sizecode ="tl_1x5_8"; alimama_fontsize=12; alimama_bordercolor="FFFFFF"; alimama_bgcolor="FFFFFF"; alimama_titlecolor="0000FF"; alimama_underline=0; alimama_height=22; alimama_width=0; < src="http://a.alimama.cn/inf.js" type=text/javascript>
/////////////////////////////////////////////////////////////////////////////////////
Delphi中WebBrowser控件的bug及解决方案Delphi中WebBrowser控件的bug及解决方案
简介： Delphi语言，无论是从开发速度、还是运行速度、还是编译速度、还是编译之后的执行文件体积，都是数一数二的。因此被作为共享软件、开发产品、制作“绿色软件”的首选。但是，由于诸多原因，Delphi中，有一些控件，存在一些bu ...
关键字：delphi WebBrowser 控件 Bug 复制 内存 泄漏 javascript close
Delphi语言，无论是从开发速度、还是运行速度、还是编译速度、还是编译之后的执行文件体积，都是数一数二的。因此被作为共享软件、开发产品、制作“绿色软件”的首选。但是，由于诸多原因，Delphi中，有一些控件，存在一些bug。不论广大技术人员如何反应，Delphi官方就是“视而不见”。有问题，人家虽然不给解决，但是，总不能不用这种语言吧，毕竟优点还是大于缺点的。还是“自己动手，丰衣足食”吧。
最近笔者在开发泛东协同管理系统客户端的时候，使用了Delphi中的WebBrowser控件，相信这个控件，是使用最广泛的控件之一，几乎所有与Internet相关的产品，都离不开这个控件。但是这Delphi中的WebBrowser控件，在使用过程中，发现三个Bug。
1、如果打开的页面中，有通过javascript关闭页面的，只会把控件关闭，包含控件的窗口仍然存在，并且手工关闭窗口时，出现问题；
2、打开的页面，通过鼠标选定的内容，不能复制，无论是通过右键菜单复制，还是通过Ctrl+C快捷键复制，都不可以；
3、打开有WebBrowser控件的窗口，关闭窗口之后，内存得不到释放（此Bug在其他语言中也存在）。
以上三个问题，是必须解决的。通过查找资料及自己的试验，终于找到了解决办法，将解决方案总结如下：
问题1解决方案：
先声明消息处理函数：
procedure ApplicationMessage(var Msg: TMsg; var Handled: Boolean);
在form create时
Application.OnMessage := ApplicationMessage;
函数内容如下：
procedure tfrmhtmlbrowser.ApplicationMessage(var Msg: TMsg; var Handled: Boolean);
var
wb: tembeddedwb;
begin
WB := GetVisibleWebBrowser; //取当前webbrowser控件
if (Msg.message = WM_CLOSE) and (Msg.hwnd = Wb.Handle) then
begin
Self.Close ();//关闭webbrowser后，把相应的窗口关闭
end
else
inherited;
end;
问题2解决方案：
引用：uses Activex;
把以下代码放在有WebBrowser控件的窗口最后一个End前面：
initialization
oleinitialize(nil);
finalization
oleuninitialize;
问题3解决方案：
修改Delphi的控件源码：OleCtrls.pas
修改此文件中的函数：GetIDispatchProp、GetIUnknownProp
修改如下：
function TOleControl.GetIDispatchProp(Index: Integer): IDispatch;
var
Temp: TVarData;
begin
GetProperty(Index, Temp);
//Result := IDispatch(Temp.VDispatch);
Pointer(Result) := Temp.VDispatch;
end;
function TOleControl.GetIUnknownProp(Index: Integer): IUnknown;
var
Temp: TVarData;
begin
GetProperty(Index, Temp);
//Result := IUnknown(Temp.VUnknown);
Pointer(Result) := Temp.VUnknown;
end;
修改之后，重新编译。
以上是Delphi中WebBrowser控件Bug的解决办法，希望对大家有帮助！
//////////////////////////////////////////////////////////////////////////////////////
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('<br/><b>Hello!</b>');
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', '<h1>Hello World!</h1>');
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();
///////////////////////////////////////////////////////////////////////////////////////////////////
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;
假如网页中有这样的语句:
<script>
var
str = "Hello";
i = 99;
</script>
--------------------------------------------------------------------------------
//调用网页脚本中的函数:
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.OleObject.document.parentWindow.MB(); //HTML-Js
//如需指定脚本语言, 需要:
WebBrowser1.OleObject.document.parentWindow.execScript('MB()','JavaScript'); //HTML-Js
end;
假如有这样的脚本:
<script>
function MB(){
alert('HTML-Js');
}
</script>
--------------------------------------------------------------------------------
//判断网页及内部框架网页是否全部下载完毕
procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
if WebBrowser1.Application = pDisp then
begin
Text := '网页下载完毕！';
end;
end;
--------------------------------------------------------------------------------
//改变背景色或背景图片:
WebBrowser1.OleObject.document.body.bgcolor := '#FF0000';
WebBrowser1.OleObject.document.body.background := '...图片地址';
--------------------------------------------------------------------------------
//操作有 ID 标签的对象:
var
s: string;
begin
s := WebBrowser1.OleObject.document.getElementByID('span1').innerText;
ShowMessage(s); //这是 span1 标签中的内容
//或者:
s := WebBrowser1.OleObject.document.parentWindow.span1.innerText;
ShowMessage(s); //这是 span1 标签中的内容
//隐藏它:
WebBrowser1.OleObject.document.parentWindow.span1.style.display := 'none';
end;
假如网页中有这样的内容:
<span id=span1>这是 span1 标签中的内容</span>
--------------------------------------------------------------------------------
//获取网页源代码
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;
//获取网页全部源代码
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;
//禁止弹出窗口
procedure TForm1.WebBrowser1NewWindow2(ASender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool);
begin
Cancel := True;
end;
--------------------------------------------------------------------------------
模拟点击网页中的按钮
操作链接
/////////////////////////////////////////////////////////
TWebBrowser 调用的是 IE, 放缩页面是在 IE7 之后才支持的.
准备工作:
1、添加 WebBrowser1、Button1
2、激活窗体的 OnCreate 事件、激活 Button1 的 OnClick 事件.
代码如下:
--------------------------------------------------------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, StdCtrls;
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const
OLECMDID_OPTICAL_ZOOM = 63;
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('http://del.cnblogs.com');
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ZoomIn: OleVariant;
begin
ZoomIn := 150;
WebBrowser1.ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DODEFAULT, ZoomIn);
end;
end.
////////////////////////////////////////////////////////////////////////////
如何缩放页面确实是上面的代码
如何获取当前页面的缩放比率应该是:
var
mystr:string;
begin
mystr:=webbrowser1.OleObject.Document.Body.Style.Zoom;
end;
// 如果一开始浏览时，当前页面的比率是100%，则这个值会为空； 是你改变缩放比率后，这个值就不再为空，这个值是可读可写的。
/////////////////////////////////////////////////////////////////////////////////////////////////////////////
Delphi WebBrowser 实现始终本地打开的一点思路(原创)
时间：2009-09-11 16:28:47 来源：官方 作者：官方
本文原自：http://js.sse6.cn 转载请注明
使用过DELPHI WebBrowser的人可能都会抱怨过，因为webBrowser在处理网页打开新窗口的时候，就会去调用外部默认的浏览器，这样做造成了原窗口和新窗口不在一个session范围内，使得原窗口中保存的用户名和密码信息不能完美的保存到新窗口中。本人希望用一些网络上比较常用的方法向大家介绍一下解决问题的思路，主要是开拓一下大家的视野，如果高手认为有什么不足之处欢迎您的批评指证，互相学习。
本人所使用的解决思路
目前笔者使用的方法是使用代理手段让一个代理WebBrowser将相应的新窗口又传回到原窗口的办法，虽然可以在原窗口中完美的显示新窗口当中的内容。
delphi代码：
//********************************************
//当原窗口打开新页面时所执行的命令，此时使代理AgentWebShowBrowser运行，取代默认IE运行。
//作者：沈家强
//输入值的说明
//Sender
//ppDisp
//Cancel
//RkiSSE6
//********************************************
procedure TFrmLoginEr.OnIENewWindow(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
begin
//当webbrowser打开的新窗口的时候，把新窗口
ppDisp := AgentWebShowBrowser.Application;
end;
//********************************************
//当代理窗口打开自新页面之前，将窗口又传递回原窗口，达到完美的过渡。使原窗口显示新窗口显示的内容
//作者：沈家强
//输入值的说明
//Sender
//ppDisp
//URL
//Flags
//TargetFrameName
//PostData
//Headers
//Cancel
//********************************************
procedure TFrmLoginEr.OnBeforeAgentBrowser(Sender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
begin
WebShowBrowser.Navigate(string(URL)); // 再指回WebBrowser1
Cancel := True
end;
其它解决思路
1.模仿主流浏览器在新窗体里打开窗口
如果你希望和IE或FIREFOX哪样在新标签中打开您可以使用一个新的窗体，在主作体创建之前，新窗体不用初始化，当新窗口调用时，对
新窗体初始化并显示新的窗体的内容。因为主要的思路与上大同小差异所以不在累述了。
2.网上还流行的一段代码
Delphi代码
// Set OnNewWindow Event
FBrowser.OnNewWindow2 := OnIENewWindow;
procedure TfrmBizMain.OnIENewWindow(ASender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
var
FBrowser: TIEBrowser;
begin
if ASender is TIEBrowser then
begin
Cancel := not actNewTab.Execute; // Create A New WebBrowser
if not Cancel then
begin
FBrowser := GetBrowser;// Get The Browser just Created
if Assigned(FBrowser) then
ppDisp := FBrowser.Application;
end;
end;
end;
很可惜的是，这里面的TIEBrowser听说是由老外写的一个比较有名的控件，而我自己没有找到该控件，所以，也不能去验证这段代码的可行性，不过分析代码我们还是可以大约看出它的意思，东倒西就是在新的IEBrowser当中打开新的窗口，具体代码只能推导到这里，后面的只有哪位大侠帮助本人找到这个控件代码，我们看看后再作分析了。
3.Session共享思路
这事实上是本人最初的想法，让webBrowser和IE共享打开的session不就可以达到我们的需求了吗？不过后来网络上查询了一下，目前看来
是不行，主要原因Session是跟浏览器有关，并且每启动一次浏览器，就算一个新有session，为了安全期间每个session都是相互完全独立的。
最少目前来看还没有好的思路可以用来使不同浏览器之间共享session。
4.引申一下思路，利用Cookie来操作
因为cookie是可以多浏览器间共享的，如果共同操作相同的cookie是否可以实现，IE当中打开新窗体时保存相应的数据己测试一下，这种方案的可行性。