从 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 状态代码中 returns 一些涉及从 Delphi 设置 Ado 事件的点击，但没有显然相关。

无论如何，这样做的结果是永远不会调用 EventObject 的 Invoke 方法已调用，所以我没有收到 WordApplication 事件的通知。

所以，我的问题是这个错误 $80040200 意味着什么 and/or 我该如何避免它？

顺便说一句，我也试过使用这段代码连接到 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;

我可以 post 一个 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 错误，成功返回零。随着 "if IsEquallIID then ..." 注释掉，IEvt 上的 RefCount 在 "CP.Advise ..." returns 之后是 48 (!)，这时候 TEventObject.QueryInterface 已被调用不少于 21 次。

我还没有意识到以前（因为 TEventObject 以前没有自己的版本可以观察）当 "CP.Advise ..." 被执行时，COM 系统调用 "TEventObject.QueryInterface" 具有一系列不同的 IID，直到它 returns 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;

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

Receiving MS Word's automation events from a Delphi app

delphi

ms-word

delphi-7

delphi-10-seattle