Delphi 中的接口引用计数支持函数

Interface reference counting in Delphi Supports function

我有 class THuman 实现接口 ICanTalk

但是每当我尝试检查人类是否可以说话时,Supports 函数会破坏对象实例,尽管代码中有引用。

我误会了什么?

procedure TForm1.Button1Click(Sender: TObject);
var
 Obj:TInterfacedObject;
begin
 Obj:=THuman.Create('Great guy');
 // if Supports(Obj, ICanTalk) then //Object destroyed here if uncommented
   (Obj as  ICanTalk).TalkTo(Memo1.Lines);
end;

实施

ICanTalk = interface
  ['{57E5EF90-EB11-421C-AAFB-18CD789C0956}']
    procedure TalkTo(List:TStrings);
  end;

THuman = class(TInterfacedObject, ICanTalk)
  private
    FName: string;
  public
    procedure TalkTo(List:TStrings);
    property Name:string read FName;
    constructor Create(const AName:string);
end;

constructor THuman.Create(const AName: string);
begin
 FName:=AName;
end;

procedure THuman.TalkTo(List: TStrings);
begin
 List.Add(Name+' says Hello World!');
end;

这是意料之中的。当您阅读有关 Supports 函数的文档时,您会发现:

Warning

With the exception of the overload that checks whether a TClass implements an interface, all the other versions of Supports will extract an interface reference either from an object or from another interface reference, causing the reference count of the underlying object to be incremented, and then will release the interface upon exit (decrementing the reference count). For objects that have a reference count of zero, this will result in the object destruction.

var 
  Obj: TInterfacedObject;
begin
  Obj := TInterfacedObject.Create;
  if Supports(Obj, IInterface) then { ... at this point Obj will be freed }
end;

你写了,

despite the reference in the code(in visible area)

没有,没有参考资料。您将 Obj 声明为 TInterfacedObject(class 实例变量——而不是接口变量),因此没有引用计数。

如果您改为使用接口类型的变量,它将使用引用计数:

var
  Obj: IInterface;

这种行为真让我恼火。为什么 Embarcadero 没有将内部变量声明为 [unsafe]。在下面的示例中,对象仅通过 FreeAndNil 释放。或者,您可以使用 TInterfacedPersistent 而不是 TInterfacedObject。然后你总是要自己释放对象。

program Project3;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

type
ICanTalk = interface
  ['{57E5EF90-EB11-421C-AAFB-18CD789C0956}']
    procedure TalkTo;
  end;

  THuman = class(TInterfacedObject, ICanTalk)
  public
    destructor Destroy; override;
  private
    FName: string;
  public
    procedure TalkTo;
 end;

procedure THuman.TalkTo;
begin
end;

destructor THuman.Destroy;
begin
  inherited;
end;

var
  o      : THuman;
  [unsafe]
  intf   : IInterface;

begin
  try
    o := THuman.Create;
    Supports(o, ICanTalk, intf);
    Intf := nil;   //Didn't call destructor cause of [unsafe]!
    FreeAndNil(o); //Call destructor!
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.