替换网页元素的事件处理函数

IE将网页解析成COM对象集。每个网页元素对象都支持IHTMLElement接口，不同种类元素的COM对象还支持其它相应的接口。比如按钮对象支持IHTMLButtonElement接口，表单输入框对象支持IHTMLInputTextElement接口。通过这些接口可以获取和设置网页元素的属性，比如表单输入框的内容，复选框的状态等等。还可以替换这些元素的事件处理例程（如果元素支持事件的话），比如鼠标单击事件，光标经过事件。看看IHTMLElement接口中与事件处理相关的方法和属性定义，代码来自MSHTML_TLB.pas。

 

  IHTMLElement = interface(IDispatch)
    ['{3050F1FF-98B5-11CF-BB82-00AA00BDCE0B}']   
    procedure Set_onhelp(p: OleVariant); safecall;
    function Get_onhelp: OleVariant; safecall;
    procedure Set_onclick(p: OleVariant); safecall;
    function Get_onclick: OleVariant; safecall;
    procedure Set_ondblclick(p: OleVariant); safecall;
    function Get_ondblclick: OleVariant; safecall;
    procedure Set_onkeydown(p: OleVariant); safecall;
    function Get_onkeydown: OleVariant; safecall;
    procedure Set_onkeyup(p: OleVariant); safecall;
    function Get_onkeyup: OleVariant; safecall;
    procedure Set_onkeypress(p: OleVariant); safecall;
    function Get_onkeypress: OleVariant; safecall;
    procedure Set_onmouseout(p: OleVariant); safecall;
    function Get_onmouseout: OleVariant; safecall;
    procedure Set_onmouseover(p: OleVariant); safecall;
    function Get_onmouseover: OleVariant; safecall;
    procedure Set_onmousemove(p: OleVariant); safecall;
    function Get_onmousemove: OleVariant; safecall;
    procedure Set_onmousedown(p: OleVariant); safecall;
    function Get_onmousedown: OleVariant; safecall;
    procedure Set_onmouseup(p: OleVariant); safecall;
    function Get_onmouseup: OleVariant; safecall;   
    property onhelp: OleVariant read Get_onhelp write Set_onhelp;
    property onclick: OleVariant read Get_onclick write Set_onclick;
    property ondblclick: OleVariant read Get_ondblclick write Set_ondblclick;
    property onkeydown: OleVariant read Get_onkeydown write Set_onkeydown;
    property onkeyup: OleVariant read Get_onkeyup write Set_onkeyup;
    property onkeypress: OleVariant read Get_onkeypress write Set_onkeypress;
    property onmouseout: OleVariant read Get_onmouseout write Set_onmouseout;
    property onmouseover: OleVariant read Get_onmouseover write Set_onmouseover;
    property onmousemove: OleVariant read Get_onmousemove write Set_onmousemove;
    property onmousedown: OleVariant read Get_onmousedown write Set_onmousedown;
    property onmouseup: OleVariant read Get_onmouseup write Set_onmouseup;
end.

 

这些事件属性的类型与Object Pascal的事件属性不同。Object Pascal的为方法类型，而IHTMLElement的事件是OleVariant类型，实际上它们是IDispatch接口。当触发事件时，这个IDispatch接口的Invoke方法会被调用。如果设置这些属性为Null，那么就算html代码里编写了脚本事件处理函数，事件触发时也不会执行任何动作。我们也可以自己编写一个实现IDispatch接口的Pascal类，并创建这个类的对象，然后将此对象的IDispatch接口赋值给IHTMLElement的这些事件属性，这样我们就屏蔽了网页中的事件处理函数，转而执行我们的Pascal程序代码。下面以onclick（鼠标单击事件）为例，编写一段示例代码：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, StdCtrls,MSHTML_TLB,ActiveX;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    Memo1: TMemo;
    procedure WebBrowser1BeforeNavigate2(Sender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    procedure WebBrowser1DocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TMyEvent = class(TObject,IDispatch)
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WebBrowser1BeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
begin
  Button1.Enabled:=False;
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  if not WebBrowser1.Busy then
    Button1.Enabled:=True;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  WebBrowser1.Navigate(ExtractFilePath(Application.ExeName)+'test.htm');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Doc:IHTMLDocument2;
  Elements:IHTMLElementCollection;
  htmlElement:IDispatch;
  Ele:IHTMLElement;
  AEvent:IDispatch;
  I:Integer;
begin
  if WebBrowser1.Document.QueryInterface(IID_IHTMLDocument2,Doc)=S_OK then
  begin
    Elements:=Doc.all;
    for I:=0 to Elements.length-1 do
    begin
      htmlElement:=Elements.item(I,EmptyParam);
      if htmlElement.QueryInterface(IID_IHTMLElement,Ele)=S_OK then
      begin
        AEvent:=TMyEvent.Create;
        Ele.onclick:=AEvent;
      end;
    end;
  end;
end;

{ TMyEvent }

function TMyEvent._AddRef: Integer;
begin

end;

function TMyEvent._Release: Integer;
begin

end;

function TMyEvent.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin

end;

function TMyEvent.GetTypeInfo(Index, LocaleID: Integer;
  out TypeInfo): HResult;
begin

end;

function TMyEvent.GetTypeInfoCount(out Count: Integer): HResult;
begin

end;

function TMyEvent.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HResult;
begin
   ShowMessage('executing pascal program code!');
end;

function TMyEvent.QueryInterface(const IID: TGUID; out Obj): HResult;
begin

end;

end.

代码中的TMyEvent类实现了IDispatch接口，但是除了Invoke方法外，它的其它方法什么都不做。程序运行时TWebBrowser控件加载程序目录下的test.htm网页，这个文件的内容如下：

 

 

<html>
<head>
</head>
<title>测试网页</title>
<body>
<button name="buttontest" onclick="javascript:alert('点击我干嘛')">按钮一</button>
</body>
</html>

页面上有个按钮，并且有一段JavaScript代码与它的单击事件关联。在程序中，我们替换了它的单击事件处理例程。运行程序，单击网页中的按钮，可以看到弹出消息框“executing pascal program code!”，说明我们的Pascal程序代码被执行了。