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

[VSaber]

如何接管ie接口提供的事件属性？
例如：IHTMLElement提供了一个属性OnClick，该属性支持get_onclick方法和put_onclick方法，我想知道如何用自己的处理过程处理onclick事件，也就是如何调用那个put_onclick方法。
delphi的mshtml类型库中，onclick属性是olevariant，msdn的帮助是传递idispatch接口给它，它会调用该接口的默认方法。
如何才能用自己的procedure去处理这个onclick事件（不要采用安装mshtml.dll的方法），而且我看这个不必用IConnectPoint去连接把？

高手请了，解决了的话，分好说：）～～～～～～～～～

[Billy_Chen28]

一个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.

[VSaber]

有人吗？

[yalongsoft]

BHO

[TechnoFantasy]

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”按钮。程序就会弹出消息框提示“你点击了按钮.”

[TechnoFantasy]

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

[smhpnuaa]

楼上的真厉害！

technofantasy(www.applevb.com)同志对这种问题很有研究啊！

一出现这种问题，马上出手，呵呵！

[smhpnuaa]

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

[TechnoFantasy]

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

[smhpnuaa]

在APPLEVB上不是有个包吗？

[VSaber]

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

[VSaber]

up~~

[TechnoFantasy]

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

[VSaber]

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

[VSaber]

没人知道了吗？

[smhpnuaa]

再up

[smhpnuaa]

up

[njbudong]

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

[qiandeng]

帮你提前