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

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程序代码被执行了。

转载于:https://www.cnblogs.com/coderush/articles/1184781.html