Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
KANSoftWare

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

Delphi , Технологии , OLE Automation MSOffice

Как отследить открытие и закрытие документов в приложении 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.

Программа Delphi для отслеживания открытия и закрытия документов в Microsoft Word!

Для отслеживания открытия и закрытия документов можно использовать интерфейс DocumentEvents, предоставляемый Microsoft Word. В вашем коде уже реализован объект-адвайзер (TWordConnection), который советует на этом интерфейсе.

Вот, как изменить ваш код для достижения этого:

  1. В процедуре StartWordConnection добавьте два переменных для хранения событий открытия и закрытия документа:
var
  DocumentOpenEvent: IConnectionPoint;
  DocumentCloseEvent: IConnectionPoint;
  1. В той же процедуре, после поиска connection point DocumentEvents, используйте метод FindConnectionPoint для поиска конкретных точек событий открытия и закрытия документа:
OleCheck(WordDoc.QueryInterface(IConnectionPointContainer, PointContainer));
if Assigned(PointContainer) then
begin
  OleCheck(PointContainer.FindConnectionPoint(DocumentEvents, DocumentOpenEvent));
  if Assigned(DocumentOpenEvent) then
    DocumentOpenEvent.Advise((WordSink as IUnknown), WordSink.DocCookie);

  OleCheck(PointContainer.FindConnectionPoint(DocumentEvents, DocumentCloseEvent));
  if Assigned(DocumentCloseEvent) then
    DocumentCloseEvent.Advise((WordSink as IUnknown), WordSink.DocCookie);
end;
  1. В методе Invoke объекта-адвайзера (TWordConnection), обрабатывайте события открытия и закрытия документа, вызывая процедуру LogComment:
function TWordConnection.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word;
  var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
begin
  Result := S_OK;
  case DispID of
    DocumentEvents_docOpen:
      LogComment('Document opened: ' + FWordDoc.Name);
    DocumentEvents_docClose:
      LogComment('Document closed: ' + FWordDoc.Name);
     // Обрабатывайте другие события, если необходимо
  else
    Result := E_INVALIDARG;
  end;
end;
  1. В процедуре btnStartClick, создайте новый экземпляр объекта-адвайзера (TWordConnection) и передайте его в процедуру StartWordConnection:
procedure TmainForm.btnStartClick(Sender: TObject);
begin
  FWordApp := CoApplication_.Create;
  FWordDoc := FWordApp.Documents.Add(EmptyParam, EmptyParam);
  FWordApp.Visible := True;
  StartWordConnection(FWordApp, FWordDoc, FWordSink);
end;

С этими изменениями ваш код должен теперь отслеживать открытие и закрытие документов в Microsoft Word. Процедура LogComment будет вызываться при каждом открытии или закрытии документа, записывая событие в компонент memo формы.

Обратите внимание, что вам нужно изменить процедуру btnExitClick, чтобы освободить объект-адвайзер (FWordSink) при выходе из приложения:

procedure TmainForm.btnExitClick(Sender: TObject);
begin
  FWordApp.Quit(EmptyParam, EmptyParam, EmptyParam);
   // Освободите объект-адвайзер
  FWordSink.Free;
end;

Надеюсь, это поможет! Пожалуйста, дайте мне знать, если у вас есть какие-либо дальнейшие вопросы.

Как отследить открытие и закрытие документов в приложении Microsoft Word с помощью программирования на языке Delphi.


Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.


:: Главная :: OLE Automation MSOffice ::


реклама


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-12-22 20:14:06
2025-02-17 20:53:06/0.0041911602020264/0