Receiving MS Word's automation events from a Delphi app - delphi

Question

I've been trying to use the technique shown in the answer to this q
Detect when the active element in a TWebBrowser document changes
to implement a DIY version of MS Word's Automation events.
A fuller extract from my app is below, from which you'll be able to see the
declaration of the variables in these methods:
procedure TForm1.StartWord;
var
IU : IUnknown;
begin
IU := CreateComObject(Class_WordApplication);
App := IU as WordApplication;
App.Visible := True;
IEvt := TEventObject.Create(DocumentOpen);
end;
procedure TForm1.OpenDocument;
var
CPC : IConnectionPointContainer;
CP : IConnectionPoint;
Res : Integer;
MSWord : OleVariant;
begin
Cookie := -1;
CPC := App as IConnectionPointContainer;
Res := CPC.FindConnectionPoint(DIID_ApplicationEvents2, CP);
Res := CP.Advise(IEvt, Cookie);
MSWord := App;
WordDoc:= MSWord.Documents.Open('C:\Docs\Test.Docx');
end;
The StartWord routine works fine. The problem is in OpenDocument. The
value of Res returned by Res := CP.Advise(IEvt, Cookie); is $80040200
This isn't present amongst the HResult status codes in Windows.Pas and googling "ole error 80040200"
returns a few hits involving setting up Ado events from Delphi, but nothing
apparently relevant.
Anyway, the upshot of this is that the Invoke method of the EventObject is never
called, so I don't receive notifications of the WordApplication's events.
So, my question is what does this error $80040200 signify and/or how do I avoid it?
Fwiw, I've also tried connecting to the ApplicationEvents2 interface using this code
procedure TForm1.OpenDocument2;
var
MSWord : OleVariant;
II : IInterface;
begin
II := APP as IInterface;
InterfaceConnect(II, IEvt.EventIID, IEvt as IUnknown, Cookie);
MSWord := App;
WordDoc:= MSWord.Documents.Open('C:\Docs\Test.Docx');
end;
That executes without complaint, but again the EventObject's Invoke method is never
called.
If I drop a TWordApplication onto the blank form of a new application, the events
like OnDocumentOpen work fine. I'm mentioning that because it seems to confirm
that Delphi and MS Word (2007) are correctly set up on my machine.
Code:
uses
... Word2000 ...
TForm1 = class(TForm)
btnStart: TButton;
btnOpenDoc: TButton;
procedure FormCreate(Sender: TObject);
procedure btnOpenDocClick(Sender: TObject);
procedure btnStartClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure WordApplication1DocumentOpen(ASender: TObject; const Doc: _Document);
private
procedure DocumentOpen(Sender : TObject; DispID : Integer; var Params);
procedure StartWord; // see above for implementation
procedure OpenDocument; // --"--
procedure OpenDocument2; // --"--
public
WordDoc: OleVariant;
IEvt : TEventObject; // see linked question
Cookie : Integer;
App : WordApplication;
[...]
procedure TForm1.WordApplication1DocumentOpen(ASender: TObject; const Doc:
_Document);
begin
//
end;
I could post an MCVE instead, but it would mostly be just the code from the earlier answer.

Answer 1

This had me scratching my head for a while, I can tell you. Anyway, eventually the penny dropped
that the answer must lie in the difference between the way TEventObject is implemented
and TServerEventDispatch in OleServer.Pas.
The key is that TServerEventDispatch implements a custom QueryInterface
function TServerEventDispatch.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
begin
Result := S_OK;
Exit;
end;
if IsEqualIID(IID, FServer.FServerData^.EventIID) then
begin
GetInterface(IDispatch, Obj);
Result := S_OK;
Exit;
end;
Result := E_NOINTERFACE;
end;
whereas TEventObject does not. Once I'd spotted that, it was straightforward to extend
TEventObject to do likewise, and voila! the error returned by "CP.Advise" went away.
For completeness, I've included the complete source
of the updated TEventObject below. It is the
if IsEquallIID then ...
which makes the difference between
Res := CP.Advise(IEvt, Cookie);
returning the $800040200 error and zero for success. With the "if IsEquallIID then ..."
commented out, the RefCount on IEvt is 48 (!) after "CP.Advise ..." returns, by which time
TEventObject.QueryInterface has been called no less than 21 times.
I hadn't realised
previously (because TEventObject didn't previously have its own version to observe)
that when "CP.Advise ..." is executed, the COM system calls "TEventObject.QueryInterface"
with a succession of different IIDs until it returns S_Ok on one of them. When I have some free time, maybe I'll try to look up what these other IIDs are: as it is, the IID for IDispatch is quite a long way down the list of IIDs that are queried for, which seems strangely sub-optimal seeing as I'd have though that would be the one that IConnectionPoint.Advise would be trying to get.
Code for updated TEventObject is below. It includes a rather rough'n ready customization
of its Invoke() which is specific to handling Word's DocumentOpen event.
type
TInvokeEvent = procedure(Sender : TObject; const Doc : _Document) of object;
TEventObject = class(TInterfacedObject, IUnknown, IDispatch)
private
FOnEvent: TInvokeEvent;
FEventIID: TGuid;
protected
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 QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
public
constructor Create(const AnEvent : TInvokeEvent);
property OnEvent: TInvokeEvent read FOnEvent write FOnEvent;
property EventIID : TGuid read FEventIID;
end;
constructor TEventObject.Create(const AnEvent: TInvokeEvent);
begin
inherited Create;
FEventIID := DIID_ApplicationEvents2;
FOnEvent := AnEvent;
end;
function TEventObject.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL;
end;
function TEventObject.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
Pointer(TypeInfo) := nil;
Result := E_NOTIMPL;
end;
function TEventObject.GetTypeInfoCount(out Count: Integer): HResult;
begin
Count := 0;
Result := E_NOTIMPL;
end;
function TEventObject.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
var
vPDispParams: PDispParams;
tagV : TagVariant;
V : OleVariant;
Doc : _Document;
begin
vPDispParams := PDispParams(#Params);
if (vPDispParams <> Nil) and (vPDispParams^.rgvarg <> Nil) then begin
tagV := vPDispParams^.rgvarg^[0];
V := OleVariant(tagV);
Doc := IDispatch(V) as _Document;
// the DispID for DocumentOpen of Word's ApplicationEvents2 interface is 4
if (DispID = 4) and Assigned(FOnEvent) then
FOnEvent(Self, Doc);
end;
Result := S_OK;
end;
function TEventObject.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
begin
Result := S_OK;
Exit;
end;
if IsEqualIID(IID, EventIID) then
begin
GetInterface(IDispatch, Obj);
Result := S_OK;
Exit;
end;
Result := E_NOINTERFACE;
end;