delphi 2009,界面已经发布

发布时间：2020-12-15 09:20:47 所属栏目：大数据来源：网络整理

导读：我想要有接口的特殊记录. 并且,接口具有子接口和一些类.所以,需要自动释放. 但是,记录中的界面已经发布. 需要帮助,为什么参考计数是错配的？我尝试下一个代码…… // ———————————————— ——————– type IIn = interface procedure SetV

我想要有接口的特殊记录.

并且,接口具有子接口和一些类.所以,需要自动释放.
但是,记录中的界面已经发布.

需要帮助,为什么参考计数是错配的？

我尝试下一个代码……

// ———————————————— ——————–

type
  IIn = interface
    procedure SetValue(v : string);
    function AsString() : string;
    function GetChild() : IIn;
  end;

  RIn = record
    FIn : IIn;

    procedure SetInterface(intf : IIn);
    procedure SetValue(v : string);
    function AsString() : string;
    function GetChild() : RIn;
  end;

  TIn = class(TInterfacedObject,IIn)
  private
    FChild : IIn;
    FValue : string;
  public
    procedure SetValue(v : string);
    function AsString() : string;
    function GetChild() : IIn;
  end;

// ———————————————— ——————–

procedure RIn.SetInterface(intf : IIn);
begin
  FIn := intf;
end;

function RIn.GetChild() : RIn;
var
  childInterface : IIn;
begin
  if FIn = nil then FIn := TIn.Create();
  childInterface := FIn.GetChild();

  Result.SetInterface( childInterface );
end;

procedure RIn.SetValue(v : string);
begin
  if FIn = nil then FIn := TIn.Create();
  FIn.SetValue(v);
end;

function RIn.AsString() : string;
begin
  if FIn = nil then FIn := TIn.Create();

  Result := FIn.AsString();
end;

function RIn.GetRefCnt() : integer;
begin
  if FIn = nil then FIn := TIn.Create();

  Result := FIn.GetRefCnt();
end;

procedure TIn.SetValue(v : string);
begin
  FValue := v;
end;

function TIn.AsString() : string;
begin
  Result := FValue;
end;

function TIn.GetChild() : IIn;
begin
  if FChild = nil then FChild := TIn.Create();

  Result := FChild;
end;

// ———————————————— ——————–

// global var
var
  test : RIn;

// test procedure 1
procedure test1;
begin
  test.GetChild().SetValue('test...');
end;

// test procedure 2
procedure test2;
begin
  ShowMessage(   test.GetChild().AsString    );    <----- Error!! child interface is already released..
end;

解决方法

这是Delphi 2009引用计数错误.我稍微修改了你的代码以输出引用计数器：

program Bug2009;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  IIn = interface
    procedure SetValue(v : string);
    function AsString() : string;
    function GetChild() : IIn;
  end;

  RIn = record
    FIn : IIn;

    procedure SetInterface(intf : IIn);
    procedure SetValue(v : string);
    function AsString() : string;
    function GetChild() : RIn;
  end;

  TIn = class(TInterfacedObject,IIn)
  private
    FChild : IIn;
    FValue : string;
  public
    procedure SetValue(v : string);
    function AsString() : string;
    function GetChild() : IIn;
  end;

procedure RIn.SetInterface(intf : IIn);
begin
  FIn := intf;
end;

function RIn.GetChild() : RIn;
var
  childInterface : IIn;
begin
  if FIn = nil then FIn := TIn.Create();
  childInterface := FIn.GetChild();
  Result.SetInterface( childInterface );
end;

procedure RIn.SetValue(v : string);
begin
  if FIn = nil then FIn := TIn.Create();
  FIn.SetValue(v);
end;

function RIn.AsString() : string;
begin
  if FIn = nil then FIn := TIn.Create();

  Result := FIn.AsString();
end;

procedure TIn.SetValue(v : string);
begin
  FValue := v;
end;

function TIn.AsString() : string;
begin
  Result := FValue;
end;

function TIn.GetChild() : IIn;
begin
  if FChild = nil then FChild := TIn.Create();
    Writeln(FChild._AddRef - 1);
    FChild._Release;
  Result := FChild;
end;

// global var
var
  test : RIn;

// test procedure 1
procedure test1;
begin
  test.GetChild().SetValue('test...');
end;

// test procedure 2
procedure test2;
begin
  Writeln(   test.GetChild().AsString    );   // <----- Error!! child interface is already released..
end;

begin
  try
    test1;
    test2;
  except
    on E: Exception do
      Writeln(E.ClassName,': ',E.Message);
  end;
  readln;
end.

输出(Delphi 2009)是

对Delphi XE输出进行相同的测试

查看不同的参考计数器值

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!