使用GetProcAddress调用Delphi包中单例方法时重复创建实例的问题求助

通过GetProcAddress()调用Delphi BPL包内方法时，单例对象会被创建两个独立实例，导致主程序初始化的服务设置丢失。

复现代码 #

单例对象单元（Unit2） #

unit Unit2;

interface

uses System.Classes;

type
 TMyClass = class(TPersistent)
  strict private
    class var FInstance : TMyClass;
  private
    class procedure ReleaseInstance();
  public
    constructor Create;
    class function GetInstance(): TMyClass;
    procedure TheMethod; // 任意方法
  end;

implementation

uses
  Vcl.Dialogs;

{ TMyClass }

constructor TMyClass.Create;
begin
  inherited Create;
end;

class function TMyClass.GetInstance: TMyClass;
begin
 if not Assigned(Self.FInstance) then
   Self.FInstance := TMyClass.Create;
  Result := Self.FInstance;
end;

class procedure TMyClass.ReleaseInstance;
begin
  if Assigned(Self.FInstance) then
    Self.FInstance.Free;
end;

procedure TMyClass.TheMethod;
begin
  ShowMessage('This is a method!');
end;

initialization

finalization
  TMyClass.ReleaseInstance();

end.

BPL包单元（Unit3） #

unit Unit3;

interface

uses Unit2;

procedure CustomMethod;

implementation

procedure CustomMethod;
begin
 TMyClass.GetInstance.TheMethod; // 调用此方法时会创建新实例，丢失主程序的初始设置
end;

exports
  CustomMethod;

begin

end.

主程序代码 #

procedure TForm1.Button1Click(Sender: TObject);
var
  Hdl: HModule;
  P: procedure;
begin
  TMyClass.GetInstance.TheMethod; // 正常初始化单例
  Hdl := LoadPackage('CustomPgk.bpl');
  if Hdl <> 0 then
  begin
    @P := GetProcAddress(Hdl, 'CustomMethod'); // 调用包内方法
    if Assigned(P) then
      P;

    UnloadPackage(Hdl);
  end;
end;

问题原因 #

Delphi的BPL是独立的动态链接模块，主程序与BPL拥有各自独立的内存空间。单例的类变量FInstance属于模块级数据，主程序和BPL会各自维护一份FInstance的副本，因此BPL中调用GetInstance时会创建全新实例，与主程序的实例完全无关。

解决方法 #

方法一：将单例类变量放入共享内存段 #

修改Unit2，把类变量FInstance放在共享数据段中，让主程序和BPL共享同一份变量：

unit Unit2;

interface

uses System.Classes;

{$DEFINE SHARED_INSTANCE}
{$IFDEF SHARED_INSTANCE}
{$SECTION 'SHARED' READWRITE SHARED}
{$ENDIF}

type
 TMyClass = class(TPersistent)
  strict private
    class var FInstance : TMyClass;
  private
    class procedure ReleaseInstance();
  public
    constructor Create;
    class function GetInstance(): TMyClass;
    procedure TheMethod; // 任意方法
  end;

{$IFDEF SHARED_INSTANCE}
{$ENDSECTION}
{$ENDIF}

implementation

uses
  Vcl.Dialogs;

{ TMyClass }

constructor TMyClass.Create;
begin
  inherited Create;
end;

class function TMyClass.GetInstance: TMyClass;
begin
 if not Assigned(Self.FInstance) then
   Self.FInstance := TMyClass.Create;
  Result := Self.FInstance;
end;

class procedure TMyClass.ReleaseInstance;
begin
  if Assigned(Self.FInstance) then
    Self.FInstance.Free;
end;

procedure TMyClass.TheMethod;
begin
  ShowMessage('This is a method!');
end;

initialization

finalization
  TMyClass.ReleaseInstance();

end.

注意：编译主程序和BPL时需统一定义SHARED_INSTANCE宏，且两者要使用相同的内存管理器（例如都引用ShareMem单元）。

方法二：让BPL接收主程序的单例实例指针 #

修改BPL的导出函数，添加参数接收主程序已创建的单例实例：

1. 修改Unit3：

unit Unit3;

interface

uses Unit2;

procedure CustomMethod(ASingleton: TMyClass);

implementation

procedure CustomMethod(ASingleton: TMyClass);
begin
 ASingleton.TheMethod; // 使用主程序传入的实例
end;

exports
  CustomMethod;

begin

end.

2. 修改主程序调用代码：

procedure TForm1.Button1Click(Sender: TObject);
var
  Hdl: HModule;
  P: procedure(ASingleton: TMyClass);
begin
  TMyClass.GetInstance.TheMethod; // 正常初始化单例
  Hdl := LoadPackage('CustomPgk.bpl');
  if Hdl <> 0 then
  begin
    @P := GetProcAddress(Hdl, 'CustomMethod');
    if Assigned(P) then
      P(TMyClass.GetInstance); // 传入主程序的单例实例

    UnloadPackage(Hdl);
  end;
end;

这种方式直接明确，让BPL复用主程序已创建的实例，从根源避免重复实例化。

方法三：将单例所在单元编译为共享运行时包 #

把Unit2放到独立的运行时包中，让主程序和BPL都引用这个包，而非各自编译Unit2的副本。这样主程序和BPL会共享包中的类变量，自然不会出现多个实例。

内容的提问来源于stack exchange，提问作者Dr. T