如何在 TWebBrowser IDispatchEvent 中获取自定义事件参数

Question

我试图在 Javascript 和我的TWebBrowser 之间创建某种双向通信。在我的第一次迭代中，我能够注册属性更改事件，以便当标签更改时，Delphi 会获取更改，然后读取触发更改的标签的值。这样我们可以让 Javascript 设置一个隐藏标签，Delphi 会获取更改，然后 Delphi 会读取隐藏标签以获取一个值。这工作正常，但感觉有点hacky。

在第二次迭代中，我试图触发 Javascript 中引发的自定义事件。我能够让它正常工作，但我找不到一种方法来获取传递给自定义事件的参数。这是我创建IDispatch的代码：

constructor TWebBrowserEvent.Create(const OnEvent: TCallback);
begin
   inherited Create;
   FOnEvent := OnEvent;
end;

function TWebBrowserEvent.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
   Result := E_NOTIMPL;
end;

function TWebBrowserEvent.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;
begin
   Result := E_NOTIMPL;
end;

function TWebBrowserEvent.GetTypeInfoCount(out Count: Integer): HResult;
begin
   Result := E_NOTIMPL;
end;

function TWebBrowserEvent.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
var
   Parameters : TDispParams;
begin
   if (Dispid = DISPID_VALUE) then begin
      if Assigned(FOnEvent) then begin
         FOnEvent;
         Result := S_OK;
      end;
   end else begin
      Result := E_NOTIMPL;
   end;
end;

然后为了注册我的自定义事件，我应用了以下代码：

procedure TWebBrowserWrapper.RegisterCustomEvent(EventName : String; CallbackFunction : TCallback);
var
   Target : IEventTarget;
begin
   Target := WebBrowser.Document as IEventTarget;
   Target.addEventListener(EventName, TWebBrowserEvent.Create(CallbackFunction) as IDispatch, true);
end;

基本上我只是获取文档，将其转换为IEventTarget，然后调用addEventListener。我为第一个参数传递事件的名称，然后使用回调函数创建一个IDispatch。我可以成功触发此事件，但我无法弄清楚如何将传递给事件的参数取出。这是我在 javascript 中触发的事件：

我正在尝试在 Delphi 中获取此事件的 details 部分。我想也许调用函数可以将其参数转换为TDispParams，但是当我尝试转换时，此类中的 args 为空。

任何提示或答案将不胜感激。

Answer 1

要在 Delphi 代码中访问 detail 或 CustomEvent，您需要：

1. 在您的事件侦听器中获取引用 IDOMEvent，
2. 从中获取对IDOMCustomEvent的引用，
3. 使用后期绑定浏览detail 属性。

您显然在第 1 步失败了。您是通过IDispatch 实现事件侦听器并将其作为IEventTarget.addEventListener 的第二个参数传递的好方法。此时，您希望在将事件分派给侦听器时根据文档接收一些参数：

listener [输入]

输入：IDispatch

与事件关联的事件处理函数。请注意，事件处理函数本身需要两个参数 - 第一个是事件目标（即调用事件处理函数的对象），第二个是 IDOMEvent 对象。

在注册事件侦听器并在 HTML 中引发事件后，您发现在方法 Invoke 中的参数 Params 中没有收到任何值：

您不是第一个面临此问题的人，寻找根本原因只会产生很少的结果：

• BHO IE 9 AddEventListener
• C++: Accessing IDOMEvent Object in IEventTarget::addEventListener

基于您的侦听器需要实现IDispatchEx，文档未提及。你只需要实现它的InvokeEx 方法并忽略其余的。这是示例实现（我敢于将类重命名为TWebBrowserEventListener 以更好地表达其目的）：

uses
  System.SysUtils, Winapi.Windows, Winapi.ActiveX, MSHTML;

type
  THandleEvent = procedure(const Target: IDispatch; const DOMEvent: IDOMEvent) of object;

  TWebBrowserEventListener = class(TInterfacedObject, IDispatchEx)
  private
    FOnHandleEvent: THandleEvent;
    { IDispatch }
    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;
    { IDispatchEx }
    function GetDispID(const bstrName: TBSTR; const grfdex: DWORD;
       out id: TDispID): HResult; stdcall;
    function InvokeEx(const id: TDispID; const lcid: LCID; const wflags:
       WORD; const pdp: PDispParams; out varRes: OleVariant; out pei:
       TExcepInfo; const pspCaller: PServiceProvider): HResult; stdcall;
    function DeleteMemberByName(const bstr: TBSTR;
       const grfdex: DWORD): HResult; stdcall;
    function DeleteMemberByDispID(const id: TDispID): HResult; stdcall;
    function GetMemberProperties(const id: TDispID; const grfdexFetch:
       DWORD; out grfdex: DWORD): HResult; stdcall;
    function GetMemberName(const id: TDispID; out bstrName: TBSTR):
       HResult; stdcall;
    function GetNextDispID(const grfdex: DWORD; const id: TDispID;
       out nid: TDispID): HResult; stdcall;
    function GetNameSpaceParent(out unk: IUnknown): HResult; stdcall;
  protected
    procedure HandleEvent(const Target: IDispatch; const DOMEvent: IDOMEvent); virtual;
  public
    constructor Create(AOnHandleEvent: THandleEvent);
  end;

constructor TWebBrowserEventListener.Create(AOnHandleEvent: THandleEvent);
begin
  inherited Create;
  FOnHandleEvent := AOnHandleEvent;
end;

function TWebBrowserEventListener.DeleteMemberByDispID(const id: TDispID): HResult;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowserEventListener.DeleteMemberByName(const bstr: TBSTR;
  const grfdex: DWORD): HResult;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowserEventListener.GetDispID(const bstrName: TBSTR; const grfdex: DWORD;
  out id: TDispID): HResult;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowserEventListener.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowserEventListener.GetMemberName(const id: TDispID;
  out bstrName: TBSTR): HResult;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowserEventListener.GetMemberProperties(const id: TDispID;
  const grfdexFetch: DWORD; out grfdex: DWORD): HResult;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowserEventListener.GetNameSpaceParent(out unk: IInterface): HResult;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowserEventListener.GetNextDispID(const grfdex: DWORD; const id: TDispID;
  out nid: TDispID): HResult;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowserEventListener.GetTypeInfo(Index, LocaleID: Integer;
  out TypeInfo): HResult;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowserEventListener.GetTypeInfoCount(out Count: Integer): HResult;
begin
  Result := E_NOTIMPL;
end;

procedure TWebBrowserEventListener.HandleEvent(const Target: IDispatch;
  const DOMEvent: IDOMEvent);
begin
  if Assigned(FOnHandleEvent) then
    FOnHandleEvent(Target, DOMEvent);
end;

function TWebBrowserEventListener.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HResult;
begin
  Result := E_NOTIMPL;
end;

function TWebBrowserEventListener.InvokeEx(const id: TDispID; const lcid: LCID;
  const wflags: WORD; const pdp: PDispParams; out varRes: OleVariant;
  out pei: TExcepInfo; const pspCaller: PServiceProvider): HResult;
var
  DOMEvent: IDOMEvent;
begin
  if (id = DISPID_VALUE) and (pdp^.cArgs = 2) and (pdp^.rgvarg^[0].vt = varDispatch) and
     (pdp^.rgvarg^[1].vt = varDispatch) and Supports(IDispatch(pdp^.rgvarg^[1].dispVal), IDOMEvent, DOMEvent) then
  begin
    HandleEvent(IDispatch(pdp^.rgvarg^[0].dispVal), DOMEvent);
    Result := S_OK;
  end
  else
    Result := E_NOTIMPL;
end;

要测试我是否将此 HTML 加载到 Web 浏览器控件中：

<!DOCTYPE html>
<html>
<head>
  <meta http-equiv="x-ua-compatible" content="IE=edge">
  <script>
    /* Internet Explorer doesn't support CustomEvent() constructor. Polyfill for IE9+ from
       https://developer.mozilla.org/en-US/docs/Web/API/CustomEvent/CustomEvent */
    (function () {
      if ( typeof window.CustomEvent === "function" ) return false;

      function CustomEvent ( event, params ) {
        params = params || { bubbles: false, cancelable: false, detail: null };
        var evt = document.createEvent( 'CustomEvent' );
        evt.initCustomEvent( event, params.bubbles, params.cancelable, params.detail );
        return evt;
      }

      window.CustomEvent = CustomEvent;
    })();

    function triggerPmweTest() {
      var event = new CustomEvent('pmweTest', { detail: { dataPackage: document.getElementById('input-text').value } });
      document.dispatchEvent(event);
    }
  </script>
</head>
<body>
  <input id="input-text" type="text" value="hello Matt" />
  <input id="input-checkbox" type="checkbox" />
  <button id="button" onclick="triggerPmweTest()">Click</button>
</body>
</html>

这就是我注册监听器的方式：

procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
  const pDisp: IDispatch; const URL: OleVariant);
var
  Target : IEventTarget;
  Listener: IDispatchEx;
begin
  Target := WebBrowser1.Document as IEventTarget;
  Listener := TWebBrowserEventListener.Create(WebBrowserEvent);
  Target.addEventListener('change', Listener, True);
  Target.addEventListener('pmweTest', Listener, True);
end;

procedure TForm1.WebBrowserEvent(const Target: IDispatch;
  const DOMEvent: IDOMEvent);
var
  EventInfo: string;
  DOMCustomEvent: IDOMCustomEvent;
begin
  EventInfo := 'Type: ' + DOMEvent.type_ + #13#10'SrcElement: ';
  if Assigned(DOMEvent.srcElement) then
  begin
    EventInfo := EventInfo + DOMEvent.srcElement.tagName;
    if DOMEvent.srcElement.id <> '' then
      EventInfo := EventInfo + '#' + DOMEvent.srcElement.id;
  end
  else
    EventInfo := EventInfo + '#document';
  if (DOMEvent.type_ = 'pmweTest') and Supports(DOMEvent, IDOMCustomEvent, DOMCustomEvent) then
    EventInfo := EventInfo + #13#10'detail.dataPackage: ' + VarToStr(DOMCustomEvent.detail.dataPackage);
  ShowMessage(EventInfo);
end;

上面的代码侦听<input> 元素上的change 事件以及通过单击按钮触发的自定义pmweTest 事件。两种类型都使用相同的侦听器。

当您更改文本字段的值并将焦点移出该字段时，它会显示：

类型：更改
源元素：INPUT#input-text

当你点击复选框时：

类型：更改
源元素：INPUT#input-checkbox

当你点击按钮时：

类型：pmweTest
源元素：#document
detail.dataPackage：你好，马特