Fatal编程技术网
  • delphi/
  • 接收MS Word'；来自Delphi应用程序的s自动化事件

接收MS Word'；来自Delphi应用程序的s自动化事件

delphi ms-word

接收MS Word'；来自Delphi应用程序的s自动化事件,delphi,ms-word,delphi-7,delphi-10-seattle,Delphi,Ms Word,Delphi 7,Delphi 10 Seattle,我一直在尝试使用这个问题答案中显示的技巧 实现微软Word自动化事件的DIY版本 下面是我的应用程序的更完整摘录，您可以从中看到 这些方法中变量的声明： procedure TForm1.StartWord; var IU : IUnknown; begin IU := CreateComObject(Class_WordApplication); App := IU as WordApplication; App.Visible := True; IEvt := TEve

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

实现微软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.advice（IEvt，Cookie）返回的
Res
值是80040200美元
这在Windows.Pas和谷歌搜索“ole错误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方法永远不会被调用
打电话来


如果我把一个应用程序放到一个新的应用程序的空白窗体上，事件
像
OnDocumentOpen
一样工作正常。我提到这一点是因为它似乎证实了这一点
Delphi和MS Word（2007）在我的机器上设置正确

代码：


我可以发布一个MCVE，但大部分都是前面答案中的代码。
我可以告诉你，这让我挠头了一段时间。不管怎样，最终硬币掉了
答案必须在于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没有。一旦我发现了这一点，就可以直接进行扩展
我也不想这样做，瞧！“CP.advice”返回的错误消失了

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


if IsEquallIID then ... 


这两者之间有什么区别


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


返回$800040200错误，成功返回零。“如果是Isequallid那么…”
注释掉，IEvt上的RefCount在返回“CP.advice…”后为48（！），此时
TeventoObject.QueryInterface已被调用不少于21次

我没有意识到
以前（因为TEventObject以前没有自己的版本可供观察）
当执行“CP.advice…”时，COM系统调用“TEventObject.QueryInterface”
一系列不同的IID，直到其中一个恢复正常。当我有空闲时间时，也许我会尝试查找其他IID是什么：事实上，IDispatch的IID在被查询的IID列表中有很长的一段路要走，这似乎是一个奇怪的次优IID，因为我认为这将是IConnectionPoint.Advice试图获取的IID

更新后的TeventoObject代码如下。它包括一个相当粗略的定制
特定于处理Word的DocumentOpen事件的Invoke（）


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;



类型
TInvokeEvent=对象的过程（发送方：TObject；const Doc:_Document）；
TEventObject=类（TInterfacedObject、IUnknown、IDispatch）
私有的
FOnEvent:TInvokeEvent；
feventid:TGuid；
受保护的
函数GetTypeInfoCount（out Count:Integer）：HResult；stdcall；
函数GetTypeInfo（Index，LocaleID:Integer；out-TypeInfo）：HResult；stdcall；
函数GetIDsOfNames（常量IID:TGUID；名称：指针；
NameCount，LocaleID:Integer；DispIDs:Pointer）：HResult；stdcall；
函数调用（DispID:Integer；const IID:TGUID；LocaleID:Integer；
Flags:Word；var参数；VarResult、ExcepInfo、ArgErr:Pointer）：HResult；stdcall；
函数查询接口（const IID:TGUID；out Obj）：HResult；stdcall；
公众的
构造函数创建（const AnEvent:TInvokeEvent）；
属性OnEvent:TInvokeEvent read FOnEvent write FOnEvent；
属性EventIID:TGuid read feventid；
结束；
构造函数TEventObject.Create（constantanevent:TInvokeEvent）；
开始
继承创造；
feventid:=DIID_ApplicationEvents2；
FOnEvent:=一个事件；
结束；
函数TEventObject.GetIDsOfNames（常量IID:TGUID；名称：指针；
NameCount，LocaleID:Integer；DispIDs:Pointer）：HResult；
开始
结果：=E_NOTIMPL；
结束；
函数TEventObject.GetTypeInfo（索引，LocaleID:Integer；
输出类型信息）：HResult；
开始
指针（TypeInfo）：=nil；
结果：=E_NOTIMPL；
结束；
函数TEventObject.GetTypeInfoCount（out Count:Integer）：HResult；
开始
计数：=0；
结果：=E_NOTIMPL；
结束；
函数TEventObject.Invoke（DispID:Integer；const IID:TGUID；
LocaleID:Integer；标志：Word；var参数；VarResult，ExcepInfo，
ArgErr：指针）：HResult；
变量
vPDispParams:PDispParams；
tagV:TagVariant；
V：油变异体；
文件：_文件；
开始
vPDispParams:=PDispParams（@Params）；
如果（vPDispParams Nil）和（vPDispParams^.rgvarg Nil），则开始
tagV:=vPDispParams^.rgvarg^[0]；
V:=油变异体（tagV）；
文件：=IDispatch（V）作为文件；
//Word的ApplicationEvents2接口DocumentOpen的DispID为4
如果（DispID=4）和赋值（FOnEvent），则
FOnEvent（Self，Doc）；
结束；
结果：=S_正常；
结束；
函数TEventObject.QueryInterface（常量IID:TGUID；out Obj）：HResult；
开始
如果获取接口（IID，Obj），则
开始
结果：=S_正常；
出口
结束；
如果IsEqualIID（IID，EventIID），则
开始
GetInterface（IDispatch，Obj）；
结果：=S_正常；
出口
结束；
结果：=E_NOINTERFACE；
结束；

Crikey，我的回答又回到了我的脑海中。我看看能不能复制你的80040200。后来。。。

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;