delphidelphi-2010mshtmltwebbrowser

How to get custom event parameters in a TWebBrowser IDispatchEvent

I was attempting to create some kind of two way communication between Javascript and my TWebBrowser. In my first iteration I was able to register property change events so that when a tag changes, Delphi picks up the change and then reads the value of the tag that triggered the change. This way we could have the Javascript set a hidden tag, Delphi would pick up the change, then Delphi would read the hidden tag to get out a value. This worked properly but felt a bit hacky.

In this second iteration I am attempting to trigger on custom events thrown in Javascript. I was able to get this working properly but I cannot find a way to get the argument that was passed to the custom event. Here is my code to create a 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;

Then to register my custom events I applied this code:

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;

Essentially I just get the document, cast it to a IEventTarget and then call addEventListener. I pass the name of the event for the first param and then create a IDispatch using the callback function. I can successfully trigger this event but I can't figure out how to get the parameters passed into the event out. This is my event triggering in javascript: Event

I am attempting to get the details section of this event out in Delphi. I thought maybe the invoke function could cast its parameters to a TDispParams but the args in this class were empty when I tried to cast.

Any hints or answers would be much appreciated.

Solution

  • To get access to detail of CustomEvent in Delphi code you need to:

    1. obtain reference IDOMEvent in your event listener,
    2. get reference to IDOMCustomEvent from it,
    3. use late binding to navigate through detail property.

    You obviously failed at step #1. You were on a good way to implement event listener via IDispatch and pass it as the second parameter of IEventTarget.addEventListener. At this point you expected to receive some parameters as per the documentation when an event is dispatched to the listener:

    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.

    After registering the event listener and raising the event in HTML you discovered that you didn't receive any values in parameter Params in method Invoke:

    Debug Inspector of TDispParams(Params)

    You're not the first one facing this issue and searching for the root cause yields only few results:

    Based upon that your listener needs to implement IDispatchEx, which the documentation doesn't mention. You just need to implement its InvokeEx method and ignore the rest. Here's sample implementation (I dared to rename the class to TWebBrowserEventListener to better express its purpose):

    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;

    To test that I loaded this HTML into the web browser control:

    <!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>

    And this is how I registered the listener:

    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;

    The code above listens for change events on <input> elements as well as custom pmweTest event that is triggered by clicking the button. The same listener is used for both types.

    When you change the value of text field and focus out of the field then it displays:

    Type: change
    SrcElement: INPUT#input-text

    When you click the checkbox:

    Type: change
    SrcElement: INPUT#input-checkbox

    When you click the button:

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