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

Озеров Валентин

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;

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