从内存中转储接口对象

Question

我们有一个有趣的。

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  ITestInterface = interface(IInvokable)
    ['{4059D1CD-A342-48EE-B796-84B8B5589AED}']
    function GetPort: string;
    function GetRoot: string;
  end;

  TTestInterface = class(TInterfacedObject, ITestInterface)
  private
    FPort: string;
    FRoot: string;
  public
    constructor Create(FileName: TFileName);
    destructor Destroy; override;

    function GetPort: string;
    function GetRoot: string;
  end;

{ TTestInterface }

constructor TTestInterface.Create(FileName: TFileName);
begin
  FPort := '8080';
  FRoot := 'top';
end;

destructor TTestInterface.Destroy;
begin
  // ^ Place Breakpoint here
  inherited;
end;

function TTestInterface.GetPort: string;
begin
  Result := FPort;
end;

function TTestInterface.GetRoot: string;
begin
  Result := FRoot;
end;

type
  TTestService = class
  protected
    FTest : TTestInterface;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Process;
  end;

{ TTestService }

constructor TTestService.Create;
begin
  FTest := TTestInterface.Create('');
  (FTest as IInterface)._AddRef;
end;

destructor TTestService.Destroy;
begin
  FTest.Free;
  inherited;
end;

procedure TTestService.Process;
begin
  writeln( 'Config Root: ', FTest.GetRoot );
  writeln( 'Config Port: ', FTest.GetPort );
end;

var
  TS : TTestService;
begin
  TS := TTestService.Create;
  try
    TS.Process;
  finally
    TS.Free;
  end;
end.

当此应用程序完成时，它会生成一个无效指针操作。最奇怪的是在析构函数上设置了一个断点，你可以看到它在第一次调用时就产生了错误，这排除了它被释放两次的可能性。几乎就像对象从内存中转储而根本没有调用析构函数一样。

删除 _AddRef 一切正常。

我们设法在 Delphi 6 上制作了这个。任何人都可以在任何其他版本上确认此行为吗？

Answer 1

问题是您手动释放了一个引用计数大于零的接口对象。此处引发异常：

procedure TInterfacedObject.BeforeDestruction;
begin
  if RefCount <> 0 then   {!! RefCount is still 1 - you made it that way!}
    Error(reInvalidPtr);
end;

所以...你可以只需在析构函数中调用 (FTest as IInterface)._Release; 代替 FTest.Free，但这感觉就像通过犯另一个错误来修复一个错误.要么你想要引用计数，要么你不想要 - 如果你这样做，那么你应该以这种方式使用对象（使用接口变量并让范围和变量生命周期管理对象生命周期）。如果您不想引用计数，请禁用它。无论哪种方式，您都应该选择一个生命周期管理模型并以正常方式使用它。

情况 1：禁用引用计数

如果你想禁用自动引用计数并且你使用的是 Delphi 2009 或更高版本，你可以简单地通过继承 TSingletonImplementation 而不是 TInterfacedObject 来实现：

TTestInterface = class(TSingletonImplementation, ITestInterface)
  private
    FPort: string;
    FRoot: string;
  public
    constructor Create(FileName: TFileName);
    destructor Destroy; override;    
    function GetPort: string;
    function GetRoot: string;
end;

否则，您可以通过添加所需的方法自行实现：

TTestInterface = class(TObject, ITestInterface)
  private
    FPort: string;
    FRoot: string;
  { **   Add interface handling methods ** }
  protected
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  { **  ----------------------   ** }
  public
    constructor Create(FileName: TFileName);
    destructor Destroy; override;    
    function GetPort: string;
    function GetRoot: string;
end;

您实现为：

function TTestInterface.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := S_OK
  else
    Result := E_NOINTERFACE;
end;

function TTestInterface._AddRef: Integer;
begin
  Result := -1;
end;

function TTestInterface._Release: Integer;
begin
  Result := -1;
end;

情况二：正常使用接口引用

如果你绝对需要引用计数并且你仍然需要访问具体的 class 成员那么最简单的解决方案是严格使用接口变量，让你的容器 class 固定对象生命周期，并且需要时转换为具体类型。让我们向 class 介绍一些状态：

TTestInterface = class(TInterfacedObject, ITestInterface)
  private
    FPort: string;
    FRoot: string;
  public
    Foo : integer;  { not an interface member...}
    constructor Create(FileName: TFileName);
    destructor Destroy; override;
    function GetPort: string;
    function GetRoot: string;
end;

你的容器 class 然后变成：

type
  TTestService = class
  protected
    FTest : ITestInterface;
  public
    constructor Create;
    procedure Process;
  end;

{ TTestService }

constructor TTestService.Create;
begin
  FTest := TTestInterface.Create('');
end;

procedure TTestService.Process;
begin
  writeln( 'Config Root: ', FTest.GetRoot );
  writeln( 'Config Port: ', FTest.GetPort );
  WriteLn( 'Foo : ', TTestInterface(FTest).Foo);  {Cast to access class members}
end;

请注意，上述 TTestInterface(FTest) 的转换仅适用于 Delphi 2010 及更高版本。对于早于此的版本，您必须保留一个单独的对象引用，如@ArnaudBouchez 的回答。在任何一种情况下，关键是以正常方式使用接口引用来管理对象生命周期，而不是依赖于手动修改引用计数。

Answer 2

使用两个变量：一个用于 class，一个用于接口。

使用接口变量来管理实例生命周期。不要调用free，而是将接口变量设置为nil（或超出范围）让实例运行.
如果需要，使用 class 变量直接访问实例 - 但不应该这样，或者至少让 class 只能从 protected/private 所有者成员 class.

因此您的代码变为：

type
  TTestService = class
  protected
    FTest: ITestInterface;
    FTestInstance : TTestInterface;
  public
    constructor Create;

    procedure Process;
  end;

{ TTestService }

constructor TTestService.Create;
begin
  FTestInstance := TTestInterface.Create('');
  FTest := FTestInstance;
end;

procedure TTestService.Process;
begin
  writeln( 'Config Root: ', FTest.GetRoot );
  writeln( 'Config Port: ', FTest.GetPort );
end;

var
  TS : TTestService;
begin
  TS := TTestService.Create;
  try
    TS.Process;
  finally
    TS.Free;
  end;
end.

从内存中转储接口对象

Interfaced object being dumped from memory

delphi

delphi-7