delphi - 从 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 值为 $80040200Windows.Pas 中的 HResult 状态代码中不存在这种情况，并且谷歌搜索“ole error 80040200”返回一些涉及从 Delphi 设置 Ado 事件的命中，但什么也没有显然相关。

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

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

Fwiw，我还尝试使用此代码连接到 ApplicationEvents2 接口(interface)

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 那么...”注释掉后，“CP.Advise ...”返回后，IEvt 上的 RefCount 为 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;