Как отследить открытие и закрытие документов в приложении Microsoft Word?

Nomadic советует:

В копилку. Исходный код, FAQ - желающие могут взять с Internet сами (информация взята с http://www.softmosis.ca, проверено - работает).

Основной модуль, регистрация и вызов

... public { Public declarations } FWordApp: _Application; FWordDoc: _Document; FWordSink: TWordConnection; ...

procedure StartWordConnection(WordApp: _Application;
WordDoc: _Document; var WordSink: TWordConnection); var
PointContainer: IConnectionPointContainer; Point: IConnectionPoint; begin
try // TWordConnection is the COM object which receives the // notifications from Word. Make sure to free WordSink when // you are done with it. WordSink := TWordConnection.Create; WordSink.WordApp := WordApp; WordSink.WordDoc := WordDoc;
// Sink with a Word application OleCheck(WordApp.QueryInterface(IConnectionPointContainer, PointContainer)); if Assigned(PointContainer) then begin OleCheck(PointContainer.FindConnectionPoint(ApplicationEvents, Point)); if Assigned(Point) then Point.Advise((WordSink as IUnknown), WordSink.AppCookie); end;
// Sink with a Word document advise OleCheck(WordDoc.QueryInterface(IConnectionPointContainer, PointContainer)); if Assigned(PointContainer) then begin OleCheck(PointContainer.FindConnectionPoint(DocumentEvents, Point)); if Assigned(Point) then Point.Advise((WordSink as IUnknown), WordSink.DocCookie); end;
except on E: Exception do ShowMessage(E.Message); end; end;

procedure TmainForm.btnStartClick(Sender: TObject);
begin
FWordApp := CoApplication_.Create; FWordDoc := FWordApp.Documents.Add(EmptyParam, EmptyParam); FWordApp.Visible := True; StartWordConnection( FWordApp, FWordDoc, FWordSink ); end;

procedure TmainForm.btnExitClick(Sender: TObject);
begin
FWordApp.Quit(EmptyParam, EmptyParam, EmptyParam); end;

Модуль отслеживания линков

unit ConnectionObject;
interface

uses Word_TLB, dialogs;

type

TWordConnection = class(TObject, IUnknown, IDispatch) protected
{IUnknown} function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; function _AddRef: Integer; stdcall; function _Release: Integer; stdcall;
{ IDispatch } function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall; function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall; function GetTypeInfoCount(out Count: Integer): HResult; stdcall; function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
public WordApp: _Application; WordDoc: _Document; AppCookie, DocCookie: Integer; end;
implementation

{ IUnknown Methods }

uses windows, activex, main;

procedure LogComment(comment: string);
begin
Form1.Memo1.Lines.Add(comment); end;

function TWordConnection._AddRef: Integer;
begin
Result := 2; end;

function TWordConnection._Release: Integer;
begin
Result := 1; end;

function TWordConnection.QueryInterface(const IID: TGUID;
out Obj): HResult; begin
Result := E_NOINTERFACE; Pointer(Obj) := nil; if (GetInterface (IID, Obj)) then Result := S_OK; if not Succeeded (Result) then if (IsEqualIID(IID, DocumentEvents) or IsEqualIID(IID, ApplicationEvents)) then if (GetInterface(IDispatch, Obj)) then Result := S_OK;
end;

{ IDispatch Methods }

function TWordConnection.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; begin
Result := E_NOTIMPL; end;

function TWordConnection.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult; begin
Pointer(TypeInfo) := nil; Result := E_NOTIMPL; end;

function TWordConnection.GetTypeInfoCount(out Count: Integer): HResult;
begin
Count := 0; Result := E_NOTIMPL; end;

function TWordConnection.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; begin
//This is the entry point for Word event sinking Result := S_OK; case DispID of 1: ; // Startup 2: ShowMessage( 'quit' ); // Quit 3: ; // Document change 4: ; // New document 5: ; // Open document 6: ShowMessage( 'close' ); // Close document else Result := E_INVALIDARG; end; end;

end.

[001080]

Содержание раздела