Акжан в сети - На уровень вверх(ActiveX) Как отследить открытие и закрытие документов в приложении Microsoft Word?

В копилку. Исходный код, 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.

Боpисов Олег Hиколаевич

zb@telecom.tmn.ru
http://ntserv.tgma.tmn.ru/zb/
(2:5077/5)