从 Delphi 应用程序接收 MS Word 的自动化事件

Question

我一直在尝试使用这个问题的答案中显示的技术

Detect when the active element in a TWebBrowser document changes

实现 MS Word 的自动化事件的 DIY 版本。

下面是我的应用程序的更完整摘录，您可以从中看到 在这些方法中声明变量：

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;

StartWord 例程运行良好。问题出在OpenDocument。这 Res := CP.Advise(IEvt, Cookie); 返回的 Res 的值是 $80040200 这在 Windows.Pas 和谷歌搜索“ole error 80040200”中的 HResult 状态代码中不存在 返回一些涉及从 Delphi 设置 Ado 事件的点击，但没有 显然相关。

反正这样的结果就是EventObject的Invoke方法永远不会 调用，所以我没有收到有关 WordApplication 事件的通知。

那么，我的问题是这个错误 $80040200 意味着什么和/或如何避免它？

Fwiw，我也尝试使用此代码连接到 ApplicationEvents2 接口

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;

执行起来毫无怨言，但 EventObject 的 Invoke 方法永远不会 调用。

如果我将 TWordApplication 拖放到新应用程序的空白表单上，事件 像OnDocumentOpen 工作正常。我提到这一点是因为它似乎证实了 Delphi 和 MS Word (2007) 在我的机器上正确设置。

代码：

  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;

我可以发布一个 MCVE，但它主要是早期答案中的代码。

Answer 1

我可以告诉你，这让我摸不着头脑。不管怎样，最后一分钱掉了 答案一定在于 TEventObject 实现方式的区别 和 OleServer.Pas 中的 TServerEventDispatch。

关键是TServerEventDispatch实现了一个自定义的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;

而 TEventObject 没有。一旦我发现了这一点，就可以直接扩展 TEventObject 也这样做，瞧！ “CP.Advise”返回的错误消失了。

为了完整起见，我已经包含了完整的源代码 下面更新的 TEventObject。这是

if IsEquallIID then ... 

这两者之间的区别

Res := CP.Advise(IEvt, Cookie);

返回 $800040200 错误，成功返回零。使用“如果 IsEqualIID 则 ...” 注释掉，IEvt 上的 RefCount 在“CP.Advise ...”返回后为 48（！），此时 TEventObject.QueryInterface 已被调用不少于 21 次。

我没有意识到 以前（因为 TEventObject 以前没有自己的版本来观察） 当执行“CP.Advise ...”时，COM系统调用“TEventObject.QueryInterface” 使用一系列不同的 IID，直到其中一个返回 S_Ok。当我有一些空闲时间时，也许我会尝试查找这些其他 IID 是什么：事实上，IDispatch 的 IID 在查询的 IID 列表中很远，这似乎是次优的就像我想的那样，这将是 IConnectionPoint.Advise 试图获得的那个。

更新 TEventObject 的代码如下。它包括一个相当粗糙的定制 它的 Invoke() 专门用于处理 Word 的 DocumentOpen 事件。

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;