Новости геральдики: Барон Билл Гейтс, виконт Редмондский по прозвищу Мелкомягкий. В гербе на зеленом поле четыре окна лежащие пофигообразно. Щит поддерживается двумя фигурами ламеров с мышами в зубах. В тэмборе - виртуальный шлем 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;
begintry// 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) thenbegin
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) thenbegin
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.Quit(EmptyParam, EmptyParam, EmptyParam);
end;
Модуль отслеживания линков
unit ConnectionObject;
interfaceuses 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;
ifnot Succeeded(Result) thenif (IsEqualIID(IID, DocumentEvents) or IsEqualIID(IID, ApplicationEvents))
thenif (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;
caseDispIDof
1: ; // Startup
2: ShowMessage('quit'); // Quit
3: ; // Document change
4: ; // New document
5: ; // Open document
6: ShowMessage('close'); // Close documentelse
Result := E_INVALIDARG;
end;
end;
end.
Программа Delphi для отслеживания открытия и закрытия документов в Microsoft Word!
Для отслеживания открытия и закрытия документов можно использовать интерфейс DocumentEvents, предоставляемый Microsoft Word. В вашем коде уже реализован объект-адвайзер (TWordConnection), который советует на этом интерфейсе.
Вот, как изменить ваш код для достижения этого:
В процедуре StartWordConnection добавьте два переменных для хранения событий открытия и закрытия документа:
В той же процедуре, после поиска connection point DocumentEvents, используйте метод FindConnectionPoint для поиска конкретных точек событий открытия и закрытия документа:
В методе Invoke объекта-адвайзера (TWordConnection), обрабатывайте события открытия и закрытия документа, вызывая процедуру LogComment:
functionTWordConnection.Invoke(DispID:Integer;constIID:TGUID;LocaleID:Integer;Flags:Word;varParams;VarResult,ExcepInfo,ArgErr:Pointer):HResult;beginResult:=S_OK;caseDispIDofDocumentEvents_docOpen:LogComment('Document opened: '+FWordDoc.Name);DocumentEvents_docClose:LogComment('Document closed: '+FWordDoc.Name);// Обрабатывайте другие события, если необходимоelseResult:=E_INVALIDARG;end;end;
В процедуре btnStartClick, создайте новый экземпляр объекта-адвайзера (TWordConnection) и передайте его в процедуру StartWordConnection:
С этими изменениями ваш код должен теперь отслеживать открытие и закрытие документов в Microsoft Word. Процедура LogComment будет вызываться при каждом открытии или закрытии документа, записывая событие в компонент memo формы.
Обратите внимание, что вам нужно изменить процедуру btnExitClick, чтобы освободить объект-адвайзер (FWordSink) при выходе из приложения:
Надеюсь, это поможет! Пожалуйста, дайте мне знать, если у вас есть какие-либо дальнейшие вопросы.
Как отследить открытие и закрытие документов в приложении Microsoft Word с помощью программирования на языке Delphi.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.