Ereignisse MS Word Automatisierung Empfangen von einem Delphi App

Question

ich in der Antwort auf diese q

Detect when the active element in a TWebBrowser document changes

zu implementieren eine DIY-Version von MS Word Automation gezeigt, um die Technik zu verwenden, habe versucht, Veranstaltungen.

Ein voller Auszug aus meiner app ist unten, von dem Sie in der Lage, die Deklaration der Variablen in diesen Methoden, um zu sehen:

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; 

Die StartWord Routine funktioniert gut. Das Problem ist in OpenDocument. Der Wert von Res von Res := CP.Advise(IEvt, Cookie); zurückgekehrt ist $ 80.040.200 Dieses unter dem HResult Statuscodes in Windows.pas nicht vorhanden ist und „ole Fehler 80040200“ googeln ein paar Hits zurück Einbeziehung der Einrichtung Ado Ereignisse von Delphi, aber nichts offenbar relevant .

Wie auch immer, das Ergebnis ist, dass die Invoke-Methode des EventObject nie aufgerufen wird, so dass ich keine Benachrichtigungen über die Ereignisse der WordApplication erhalten.

Also, meine Frage ist, was bedeutet dieser Fehler $ 80040200 und/oder wie kann ich es vermeiden?

FWIW, ich habe auch versucht, auf die ApplicationEvents2 Schnittstelle verbindet mit diesem Code

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; 

, die ohne Beanstandung führt, aber auch hier event Invoke Methode ist nie genannt. Wenn ich ein TWordApplication auf das leere Formular einer neuen Anwendung ablegen, funktionieren die Ereignisse wie OnDocumentOpen einwandfrei Ich erwähne das, weil es scheint, zu bestätigen, dass Delphi und MS Word (2007) richtig auf meinem Computer eingerichtet sind.

Code:

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; 

Ich konnte eine MCVE stattdessen schreiben, aber es wäre meist nur der Code aus der früheren Antwort.

Answer 1

Das hat mich für eine Weile am Kopf kratzen lassen, das kann ich dir sagen. Wie auch immer, irgendwann fiel der Penny , dass die Antwort in dem Unterschied zwischen der Art und Weise, in der TEventObject und TServerEventDispatch in OleServer.Pas implementiert ist, liegen muss.

Der Schlüssel ist, dass TServerEventDispatch implementiert ein benutzerdefiniertes Query-Interface

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; 

während TEventObject nicht. Sobald ich das entdeckt hatte, war es einfach, TEventObject zu erweitern, um das zu tun, und voila! Der Fehler von "CP.Advise" ist verschwunden.

Der Vollständigkeit halber habe ich die vollständige Quelle des aktualisierten TEventObject unten aufgeführt.Es ist die

if IsEquallIID then ... 

, die zwischen

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

Rückkehr der $ 800.040.200 Fehler und Null für den Erfolg macht den Unterschied. Mit dem "if IsEquallIID then ..." auskommentiert, ist der RefCount auf IEvt 48 (!) Nach "CP.Advise ..." zurückgibt, bis zu dem Zeitpunkt TEventObject.QueryInterface nicht weniger als 21 mal aufgerufen wurde.

ich vorher nicht realisiert hatte (weil TEventObject zuvor seine eigene Version tat es nicht zu beachten hat) , dass, wenn „CP.Advise ...“ ausgeführt wird, ruft das COM-System „TEventObject.QueryInterface“ mit eine Folge von verschiedenen IIDs, bis sie S_Ok auf einem von ihnen zurückgibt. Wenn ich etwas Freizeit habe, werde ich vielleicht versuchen, nachzuschlagen, was diese anderen IIDs sind: so wie es ist, ist die IID für IDispatch ziemlich weit unten in der Liste der IIDs, die abgefragt werden, was seltsam suboptimal erscheint Sehen, als hätte ich das, wäre das, was IConnectionPoint.Advise versuchen würde zu bekommen.

Code für aktualisierte TEventObject ist unten. Es enthält eine ziemlich grobe Anpassung seiner Invoke(), die speziell für die Behandlung von Word DocumentOpen-Ereignis ist.

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;