Lazarus/FreePascal下LibreOffice自动化事件监听问题求助

针对你遇到的FreePascal缺少IConnectionPoint/IConnectionPoints接口导致Delphi代码无法移植的问题，我们可以绕过Delphi的COM框架，直接实现IDispatch接口对接LibreOffice的OLE事件模型，不需要依赖注册表或类型库资源。

核心思路 #

LibreOffice通过OLE自动化触发事件时，仅会调用事件接收器的两个方法：notifyEvent（传递文档事件）和disposing（清理通知）。我们只需实现一个简化的IDispatch类，处理这两个方法的调用即可，无需完整实现COM连接点容器。

完整代码实现 #

1. 定义事件类型与监听器类 #

unit LibreOfficeEventListener;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, ActiveX, Variants;

type
  TLibreEvent = procedure(const Source: OleVariant) of object;

  TLibreOfficeEventListener = class(TInterfacedObject, IDispatch)
  private
    FOnUnload: TLibreEvent;
    FOnModifyChanged: TLibreEvent;
    FOnPrepareUnload: TLibreEvent;
    // IDispatch 接口方法
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  protected
    procedure HandleNotifyEvent(const Event: OleVariant);
  public
    property OnUnload: TLibreEvent read FOnUnload write FOnUnload;
    property OnModifyChanged: TLibreEvent read FOnModifyChanged write FOnModifyChanged;
    property OnPrepareUnload: TLibreEvent read FOnPrepareUnload write FOnPrepareUnload;
  end;

implementation

{ TLibreOfficeEventListener }

function TLibreOfficeEventListener.GetTypeInfoCount(out Count: Integer): HResult;
begin
  Count := 0;
  Result := S_OK;
end;

function TLibreOfficeEventListener.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;
begin
  TypeInfo := nil;
  Result := E_NOTIMPL;
end;

function TLibreOfficeEventListener.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
var
  NamesArray: ^PWideChar;
  i: Integer;
begin
  NamesArray := Names;
  Result := S_OK;
  for i := 0 to NameCount - 1 do
  begin
    if WideCompareStr(NamesArray^, 'notifyEvent') = 0 then
      PDWord(DispIDs)^ := 1
    else if WideCompareStr(NamesArray^, 'disposing') = 0 then
      PDWord(DispIDs)^ := 2
    else
    begin
      Result := DISP_E_UNKNOWNNAME;
      Exit;
    end;
    Inc(NamesArray);
    Inc(PDWord(DispIDs));
  end;
end;

function TLibreOfficeEventListener.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
var
  ParamArray: PVariantArgList;
begin
  Result := S_OK;
  case DispID of
    1: // 处理notifyEvent调用
      begin
        ParamArray := @Params;
        HandleNotifyEvent(ParamArray^[0].Varg);
      end;
    2: // 处理disposing调用（可按需添加清理逻辑）
      begin
      end;
    else
      Result := DISP_E_MEMBERNOTFOUND;
  end;
end;

procedure TLibreOfficeEventListener.HandleNotifyEvent(const Event: OleVariant);
var
  EventName: string;
begin
  EventName := Event.EventName;
  if EventName = 'OnModifyChanged' then
  begin
    if Assigned(FOnModifyChanged) then
      FOnModifyChanged(Event.Source);
  end
  else if EventName = 'OnPrepareUnload' then
  begin
    if Assigned(FOnPrepareUnload) then
      FOnPrepareUnload(Event.Source);
  end
  else if EventName = 'OnUnload' then
  begin
    if Assigned(FOnUnload) then
      FOnUnload(Event.Source);
  end;
end;

end.

2. 在主程序中使用监听器 #

unit MainForm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  LibreOfficeEventListener, ActiveX, Variants;

type

  { TMainForm }

  TMainForm = class(TForm)
    btnOpenCalc: TButton;
    procedure btnOpenCalcClick(Sender: TObject);
  private
    FEventListener: IDispatch; // 持有监听器引用，防止被提前释放
    procedure OnDocumentModifyChanged(const Source: OleVariant);
    procedure OnDocumentPrepareUnload(const Source: OleVariant);
    procedure OnDocumentUnload(const Source: OleVariant);
  public

  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

{ TMainForm }

procedure TMainForm.btnOpenCalcClick(Sender: TObject);
var
  libreMgr, libreDsk, libreDoc: OleVariant;
  Listener: TLibreOfficeEventListener;
begin
  // 初始化OLE
  CoInitialize(nil);
  try
    // 获取LibreOffice服务与桌面对象
    libreMgr := CreateOleObject('com.sun.star.ServiceManager');
    libreDsk := libreMgr.createInstance('com.sun.star.frame.Desktop');
    // 创建新的Calc文档
    libreDoc := libreDsk.loadComponentFromURL('private:factory/scalc', '_blank', 0, VarArrayCreate([0, -1], varVariant));

    // 创建事件监听器
    Listener := TLibreOfficeEventListener.Create;
    FEventListener := Listener as IDispatch; // 保存接口引用
    // 绑定事件处理函数
    Listener.OnModifyChanged := @OnDocumentModifyChanged;
    Listener.OnPrepareUnload := @OnDocumentPrepareUnload;
    Listener.OnUnload := @OnDocumentUnload;

    // 注册监听器到文档
    libreDoc.addEventListener(FEventListener);
  finally
    // 不要在这里释放OLE，否则LibreOffice会被关闭
    // CoUninitialize;
  end;
end;

procedure TMainForm.OnDocumentModifyChanged(const Source: OleVariant);
begin
  ShowMessage('文档内容已修改');
end;

procedure TMainForm.OnDocumentPrepareUnload(const Source: OleVariant);
begin
  ShowMessage('文档即将开始卸载流程');
end;

procedure TMainForm.OnDocumentUnload(const Source: OleVariant);
begin
  ShowMessage('文档已完成卸载');
  // 可在此处清理监听器引用
  FEventListener := nil;
end;

end.

关键注意事项 #

• 监听器引用持有：必须将监听器的IDispatch接口保存到全局或窗体字段（如示例中的FEventListener），否则监听器对象会被立即销毁，无法接收事件。
• OLE初始化：调用CoInitialize(nil)初始化OLE环境，注意不要在文档关闭前调用CoUninitialize，否则会强制关闭LibreOffice进程。
• 事件扩展：如果需要监听更多事件（如OnSave、OnSaveDone），只需在HandleNotifyEvent方法中添加对应的EventName判断即可。

内容的提问来源于stack exchange，提问作者Chris Morgan