ie接口编程高手看过来，应用ie接口事件属性接管事件的问题！

Question

一个IE　COM接口的例子，不知对你有否帮助：
需要建立一个COM对象，实现IDispatch, IObjectWithSite接口，如下
TIEHelper = class(TComObject, IDispatch, IObjectWithSite)
  public
    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;
    function SetSite(const pUnkSite: IUnknown): HResult; stdcall;
    function GetSite(const riid: TIID; out site: IUnknown): HResult; stdcall;
  private
    IE: IWebbrowser2;
    Cookie: Integer;
  end;在SetSite方法中处理与IE的连接：
function TIEHelper.SetSite(const pUnkSite: IUnknown): HResult;
var
  cmdTarget: IOleCommandTarget;
  Sp: IServiceProvider;
  CPC: IConnectionPointContainer;
  CP: ICOnnectionPoint;
begin
  if Assigned(pUnkSite) then begin
    cmdTarget := pUnkSite as IOleCommandTarget;
    Sp := CmdTarget as IServiceProvider;      if Assigned(Sp)then
        Sp.QueryService(IWebbrowserApp, IWebbrowser2, IE);
      if Assigned(IE) then begin
        IE.QueryInterface(IConnectionPointContainer, CPC);
        CPC.FindConnectionPoint(DWEBbrowserEvents2, CP);
        CP.Advise(Self, Cookie)
      end;
  end;
  Result := S_OK;
end;
然后当IE事件引发后，会调用服务器的Invoke事件，在事件中判断DispID并执行
相应的处理：
function TIEHelper.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
type
  POleVariant = ^OleVariant;
var
  dps: TDispParams absolute Params;
  bHasParams: boolean;
  pDispIds: PDispIdList;
  iDispIdsSize: integer;
begin
  Result := DISP_E_MEMBERNOTFOUND;
  pDispIds := nil;
  iDispIdsSize := 0;
  bHasParams := (dps.cArgs > 0);
  if (bHasParams) then
  begin
    iDispIdsSize := dps.cArgs * SizeOf(TDispId);
    GetMem(pDispIds, iDispIdsSize);
  end;
  try
    if (bHasParams) then BuildPositionalDispIds(pDispIds, dps);
    case DispId of
      102:
        begin
          DoStatusTextChange(dps.rgvarg^[pDispIds^[0]].bstrval);
          Result := S_OK;
        end;
      108:
        begin
          DoProgressChange(dps.rgvarg^[pDispIds^[0]].lval, dps.rgvarg^[pDispIds^[1]].lval);
          Result := S_OK;
        end;最后，需要在注册时在注册表中添加附加信息以便IE调用：
type  TIEHelperFactory = class(TComObjectFactory)
  private
    procedure AddKeys;
    procedure RemoveKeys;
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;procedure TIEHelperFactory.AddKeys;
var S: string;
begin
  S := GUIDToString(CLASS_IEHelper);
  with TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    if OpenKey('Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects\' + S, TRUE)
      then CloseKey;
  finally
    free;
  end;
end;procedure TIEHelperFactory.RemoveKeys;
var S: string;
begin
  S := GUIDToString(CLASS_IEHelper);
  with TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    DeleteKey('Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects\' + S);
  finally
    free;
  end;
end;procedure TIEHelperFactory.UpdateRegistry(Register: Boolean);
begin
  inherited UpdateRegistry(Register);
  if Register then AddKeys else RemoveKeys;
end;initialization
  TIEHelperFactory.Create(ComServer, TIEHelper, Class_IEHelper,
    'IEHelper', '', ciMultiInstance, tmApartment);
end.

Answer 1

VB的实现代码：
Option Explicit Public Sub Some_Procedure() 
MsgBox "你点击了按钮." 
End Sub Private Sub Form_Load() 
'下载空页面 
WebBrowser1.Navigate2 "about:blank" 
End Sub Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant) 
'建立事件响应类 
Dim cfForward As clsForward '定义在浏览器中显示的HTML代码，其中包含一个按钮btnMyButton 
Dim sHTML As String 
sHTML = "<P>This is some text.</P>" 
sHTML = sHTML & "<P>And here is a button.</P>" 
sHTML = sHTML & "<BUTTON ID=btnMyButton>" 
sHTML = sHTML & "Click this button.</BUTTON>" '将HTML代码写入浏览器 
WebBrowser1.Document.body.innerHTML = sHTML '将事件响应类连接到页面的按钮btnMyButton上 
Set cfForward = New clsForward 
cfForward.Set_Destination Me, "Some_Procedure" 
WebBrowser1.Document.All("btnMyButton").onclick = cfForward 
End Sub 向工程中添加一个Class Module，Class Module的Name属性设定为clsForward，在clsForward中添加以下代码： Option Explicit Dim oObject As Object 
Dim sMethod As String 
Dim bInstantiated As Boolean Private Sub Class_Initialize() 
bInstantiated = False 
End Sub Public Sub Set_Destination(oInObject As Object, sInMethod As String) 
Set oObject = oInObject 
sMethod = sInMethod 
bInstantiated = True 
End Sub Public Sub My_Default_Method() 
If bInstantiated Then 
CallByName oObject, sMethod, VbMethod 
End If 
End Sub 运行程序，点击Webbrowser中的“Click this button”按钮。程序就会弹出消息框提示“你点击了按钮.”

Answer 2

上面的代码关键是定义了一个类，然后将类的实例赋予OnClick事件：
WebBrowser1.Document.All("btnMyButton").onclick = cfForward 
由于VB对于OLE的支持很好，所以实现起来比较简单，Delphi的方法我一直没有做出来。

Answer 3

楼上的真厉害！technofantasy(www.applevb.com)同志对这种问题很有研究啊！一出现这种问题，马上出手，呵呵！

Answer 4

真佩服！technofantasy(www.applevb.com)好厉害！

Answer 5

有一个很牛的关于IE&Delphi编程的站点：
http://www.euromind.com/iedelphi/
不过我好像没有在这个站点找到这方面的提示，感兴趣的你可以自己找一下。

Answer 6

to technofantasy(www.applevb.com) :
vb我不懂，不过你已经阐明重点了，也就是把onclick属性附一个对象，实际上这个问题很容易让人第一个就想到附一个procedure指针给onclick属性，但是看msdn上要求是一个idispatch接口。
这点我就很不明白，如果我自己定一个类，继承idispatch接口，那么这个onclick接管事件会是哪一个方法呢？msdn上只说到是一个default method，哪一个是default method？

Answer 7

对，这个正是困扰我的问题，我已经实现了一个IDispatch接口，但是什么是它的默认方法呢？在上面的VB代码中：
Public Sub My_Default_Method() 
If bInstantiated Then 
CallByName oObject, sMethod, VbMethod 
End If 
好像就是默认方法，另外：
cfForward.Set_Destination Me, "Some_Procedure" 
我也不知道如何实现，由于最近工作太忙，这个事情就放下了，没有继续研究。

Answer 8

to technofantasy(www.applevb.com):
   过两天发分，看看还有没有人来：）

Answer 9

================================================================
一颗红心向前看，为了革命两茫然，不好意思才囊尽，只能说上一点点。
★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆
★    我踢  我踢   我踢  我踢  我踢  我踢  我踢  我踢  我踢   ★
★    你UP  你UP   你UP  你UP  你UP  你UP  你UP  你UP  你UP   ★
★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆
================================================================