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

Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...

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

Автор: Nomadic

Новости геральдики: Барон Билл Гейтс, виконт Редмондский по прозвищу Мелкомягкий. В гербе на зеленом поле четыре окна лежащие пофигообразно. Щит поддерживается двумя фигурами ламеров с мышами в зубах. В тэмборе - виртуальный шлем SFX-1.

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