Question

我一直在尝试使用此q的答案中显示的技术

Detect when the active element in a TWebBrowser document changes

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

我的应用程序的更全面的摘录在下面，您将从中看到在这些方法中声明变量：

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返回的Res := CP.Advise(IEvt, Cookie);的值为$ 80040200 这在Windows中的HResult状态代码中不存在.Pas和谷歌搜索“ole error 80040200” 返回一些涉及从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也这样做，瞧！＆＃34; CP.Advise＆＃34;返回的错误走了。

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

if IsEquallIID then ...

区别于

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

返回$ 800040200错误，为成功返回零。使用＆＃34; if IsEquallIID然后......＆＃34; 注释掉，IEvt上的RefCount在＆＃34; CP.Advise ...＆＃34;之后是48（！）返回，到时候 TEventObject.QueryInterface的调用次数不少于21次。

我没有意识到以前（因为TEventObject以前没有自己的版本可以观察）当＆＃34; CP.Advise ...＆＃34;执行后，COM系统调用＆＃34; TEventObject.QueryInterface＆＃34; 一系列不同的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;

从Delphi应用程序

1 个答案: