interface 

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, ActiveX; type
IDocHostShowUI = interface(IUnknown)
['{c4d244b0-d43e-11cf-893b-00aa00bdce1a}']
function ShowMessage(hwnd: THandle; lpstrText: POLESTR; lpstrCaption: POLESTR;dwType: longint; lpstrHelpfile: POLESTR; dwHelpContext: longint;var plResult: LRESULT): HRESULT; stdcall;
function ShowHelp(hwnd: THandle; pszHelpfile: POLESTR; uCommand: integer;dwData: longint; ptMouse: TPoint; var pDispatchObjectHit: IDispatch): HRESULT; stdcall;
end; TWebBrowser = class(SHDocVw.TWebBrowser,IDocHostShowUI)
protected
function ShowMessage(hwnd: THandle; lpstrText: POLESTR; lpstrCaption: POLESTR;dwType: longint; lpstrHelpfile: POLESTR; dwHelpContext: longint;var plResult: LRESULT): HRESULT; stdcall;
function ShowHelp(hwnd: THandle; pszHelpfile: POLESTR; uCommand: integer;dwData: longint; ptMouse: TPoint; var pDispatchObjectHit: IDispatch): HRESULT; stdcall;
end; type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end; var
Form1: TForm1; implementation {$R *.dfm} { TWebBrowser } function TWebBrowser.ShowHelp(hwnd: THandle; pszHelpfile: POLESTR; uCommand,
dwData: Integer; ptMouse: TPoint; var pDispatchObjectHit: IDispatch): HRESULT;
begin
Result := S_FALSE;
end; function TWebBrowser.ShowMessage(hwnd: THandle; lpstrText,
lpstrCaption: POLESTR; dwType: Integer; lpstrHelpfile: POLESTR;
dwHelpContext: Integer; var plResult: LRESULT): HRESULT;
begin
//plResult := MessageBoxW(hwnd,PWChar(lpstrText),'Title',);//这里屏蔽了alert
Result := S_OK;
end; procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('E:/alert.htm');
end; end.

方法是实现了IDocHostShowUI接口,重写了弹出消息的方法。

Delphi中WebBrowser拦截网页Alert对话框消息(转)的更多相关文章

  1. Delphi中WebBrowser控件打开部分网站报"Invalid floating point operation”解决

    Delphi中WebBrowser控件打开部分网站报"Invalid floating point operation”解决 EmbeddedWBWebBrowserDelphi  最近用E ...

  2. delphi中webbrowser的用法

    WebBrowser1.GoHome; //到浏览器默认主页 WebBrowser1.Refresh; //刷新 WebBrowser1.GoBack; //后退 WebBrowser1.GoForw ...

  3. winform中webBrowser模拟网页操作中遇到的问题

    我们通过网页上传一些特殊数据的时候,由于必填项众多,数量量大的时候,会发现工作相当繁琐,前段时间做了一个winform内嵌webBrowser模拟网页上传文档的小工具,发现了许多问题,总结一下: 先说 ...

  4. 在Delphi中调用"数据链接属性"对话框设置ConnectionString

    项目需要使用"数据链接属性"对话框来设置ConnectionString,查阅了一些资料,解决办法如下: 1.Delphi 在Delphi中比较简单,步骤如下: 方法1: use ...

  5. delphi中WEBBrowser网页html相互调用(一)

    1.基本操作1.1.激活 var doc,url:Olevariant ; begin url:='about:blank' ;//或者一个有实际意义的url WebBrowser1.Navigate ...

  6. delphi中Webbrowser疑难问题集锦<转>

    1.获得网页中变量值      htm中<script> var currID=123</script>      程序中可以这么调用 id := Form1.WebBrows ...

  7. delphi中WebBrowser的parent改变时变成空白问题的解决(覆盖CreateWnd和DestroyWnd)

    这段时间在做一个delphi界面打开网页的功能,且此网页所在窗口可完整显示,可缩小到另一个窗口的panel上显示 可是在改变网页所在窗口时,WebBrowser控件变成了空白 上网google了半天, ...

  8. C# Winform中WebBrowser给网页中的input控件赋值/设置值

    订阅WebBrowser的DocumentCompleted事件,在里面写入 private void browser_DocumentCompleted(object sender, WebBrow ...

  9. delphi 中如何查看网页POSTDATA

    procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;  var ppDisp: IDispatch; var Cancel: WordBool ...

随机推荐

  1. Javascript线程及定时机制

    setTimeout.setInterval的使用 Javascript api文档中定义setTimeout和setInterval第二个参数意义分别为间隔多少毫秒后回调函数被执行和每隔多少毫秒回调 ...

  2. php运用curl触发后台脚本不超时执行某项任务

    运用curl 设置超时,触发后台脚本执行 例如一些需要长时间等待的任务,如创建数据库,下载网络图片等 $ch = curl_init();//$ch资源可以请求多个连接 curl_setopt($ch ...

  3. windows 基础及基本软件测试环境搭建

  4. ruby 中文支持设置

    学习Ruby的过程中,对于于涉及中文的的代码的时候,需要添加如下代码在首行 # encoding: utf-8 或者EMAC写法 # -*- coding : utf-8 -*- 因为Ruby编译器会 ...

  5. CALayer 为什么选择 cg 开头 而 不选择 UI 开头

    CALayer  的属性  为什么选择 cg 开头  而 不选择 UI 开头 , 也就是说  为啥要选择 比如 .CGColor      等

  6. RestKit:iOS开发必备,告别众多无聊代码

    http://www.csdn.net/article/2014-04-15/2819312-RestKit-frameworkRestKit是一款专为iOS设计的Objective-C框架,旨在与R ...

  7. NEURAL NETWORKS, PART 1: BACKGROUND

    NEURAL NETWORKS, PART 1: BACKGROUND Artificial neural networks (NN for short) are practical, elegant ...

  8. Tomcat 架构 (一)

    在实践过程中,从WebSphere中实现一个EJB的容器以及从WebLogic中实现一个JMS几乎都是不可能的,然而来自Apache基金会的servlet容器Tomcat至少在理论上是可能做到的. 请 ...

  9. Hadoop上结合opencv\javacv

    mac上安装opencv 1. 去 http://opencv.org 下载最新版OpenCV for Linux/Mac源文件,目前版本是2.4.3.下载后解压.2. 去 http://www.cm ...

  10. [FJSC2014]折线统计

    [题目描述] 二维平面上有n 个点(xi, yi),现在这些点中取若干点构成一个集合S,对它们按照x 坐标排序,顺次连接,将会构成一些连续上升.下降的折线,设其数量为f(S).如下图中,1->2 ...