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;

案例2：正常使用界面参考

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

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;

您的容器类将成为：

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

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

使用接口变量来管理实例生命周期。不要调用free，而是将接口变量设置为nil（或超出范围）以使实例运行。
如果需要，使用类变量对实例进行直接原始访问 - 但不应该是这种情况，或者至少只能从所有者类的受保护/私有成员访问该类。

所以你的代码变成了：

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.

从内存中转储的接口对象

2 个答案: