Советы по Delphi. Версия 1.4.3 от 1.1.2001

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;
 excepton 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 := 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;