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

Question

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

在第二次迭代中，我试图触发 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 部分。我想也许 invoke 函数可以将其参数转换为 TDispParams 但是当我尝试转换时 class 中的参数是空的。

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

Answer 1

要使用 Delphi 代码访问 CustomEvent 的 detail，您需要：

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

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

listener [in]

Type: IDispatch

The event handler function to associate with the event. Be aware that the event handler function itself requires two parameters - the first is the event target (that is, the object on which the event handler function is being invoked) and the second is the IDOMEvent object.

在 HTML 中注册事件侦听器并引发事件后，您发现在方法 Invoke:

中的参数 Params 中没有收到任何值

您不是第一个遇到此问题的人，搜索根本原因只会产生很少的结果：

基于此，您的侦听器需要实现 IDispatchEx，文档未提及。你只需要实现它的 InvokeEx 方法并忽略其余部分。这是示例实现（我敢于将 class 重命名为 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 事件。两种类型使用相同的侦听器。

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

Type: change
SrcElement: INPUT#input-text

单击复选框时：

Type: change
SrcElement: INPUT#input-checkbox

当您点击按钮时：

Type: pmweTest
SrcElement: #document
detail.dataPackage: hello Matt

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

How to get custom event parameters in a TWebBrowser IDispatchEvent

delphi

delphi-2010

mshtml

twebbrowser