实现接口的对象真的可以放心地不管理释放问题吗,对接口有研究的大虾来看看 ( 积分: 100 )

  • 主题发起人 主题发起人 张鸿林
  • 开始时间 开始时间

张鸿林

Unregistered / Unconfirmed
GUEST, unregistred user!
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
ITest=interface
['{FB71ACDC-F240-11D9-8395-9C5CE63B7910}']
end;
TTest=class(TInterfacedObject,ITest) //继承自TInterfacedObject,可以自动释放
public
constructor Create;
destructor Destroy;override;
end;
TTest1=class(TComponent,ITest) //继承自TComponent,好像不能自动释放
public
constructor Create (AOwner:TComponent)
override;
destructor Destroy;override;
end;
TForm1 = class(TForm)
CreateTest: TButton;
ReleaseTest: TButton;
CreateTest1: TButton;
ReleaseTest1: TButton;
procedure CreateTestClick(Sender: TObject);
procedure ReleaseTestClick(Sender: TObject);
procedure CreateTest1Click(Sender: TObject);
procedure ReleaseTest1Click(Sender: TObject);
private
{ Private declarations }
FTest:ITest;
FTest1:ITest;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.CreateTestClick(Sender: TObject);
begin
FTest:=TTest.Create;
end;

procedure TForm1.ReleaseTestClick(Sender: TObject);
begin
FTest._Release;
end;

{ TTest }

constructor TTest.Create;
begin
inherited;
showmessage('create');
end;

destructor TTest.Destroy;
begin
showmessage('Free')
// TTest.Destroy触发
inherited;
end;

{ TTest1 }

constructor TTest1.Create(AOwner:TComponent);
begin
inherited;
showmessage('create');
end;

destructor TTest1.Destroy;
begin
showmessage('Free');
inherited;
end;

procedure TForm1.CreateTest1Click(Sender: TObject);
begin
FTest1:=TTest1.Create(nil);

end;

procedure TForm1.ReleaseTest1Click(Sender: TObject);
begin
FTest1._Release
// TTest1.Destroy没有触发

end;

end.

//察看vcl发现,两个_release的工作方式不一样:
function TInterfacedObject._Release: Integer;
begin
Result := InterlockedDecrement(FRefCount);
if Result = 0 then
Destroy;
end;
function TComponent._Release: Integer;
begin
if FVCLComObject = nil then
Result := -1 // -1 indicates no reference counting is taking place
else
Result := IVCLComObject(FVCLComObject)._Release;
end;
 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
ITest=interface
['{FB71ACDC-F240-11D9-8395-9C5CE63B7910}']
end;
TTest=class(TInterfacedObject,ITest) //继承自TInterfacedObject,可以自动释放
public
constructor Create;
destructor Destroy;override;
end;
TTest1=class(TComponent,ITest) //继承自TComponent,好像不能自动释放
public
constructor Create (AOwner:TComponent)
override;
destructor Destroy;override;
end;
TForm1 = class(TForm)
CreateTest: TButton;
ReleaseTest: TButton;
CreateTest1: TButton;
ReleaseTest1: TButton;
procedure CreateTestClick(Sender: TObject);
procedure ReleaseTestClick(Sender: TObject);
procedure CreateTest1Click(Sender: TObject);
procedure ReleaseTest1Click(Sender: TObject);
private
{ Private declarations }
FTest:ITest;
FTest1:ITest;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.CreateTestClick(Sender: TObject);
begin
FTest:=TTest.Create;
end;

procedure TForm1.ReleaseTestClick(Sender: TObject);
begin
FTest._Release;
end;

{ TTest }

constructor TTest.Create;
begin
inherited;
showmessage('create');
end;

destructor TTest.Destroy;
begin
showmessage('Free')
// TTest.Destroy触发
inherited;
end;

{ TTest1 }

constructor TTest1.Create(AOwner:TComponent);
begin
inherited;
showmessage('create');
end;

destructor TTest1.Destroy;
begin
showmessage('Free');
inherited;
end;

procedure TForm1.CreateTest1Click(Sender: TObject);
begin
FTest1:=TTest1.Create(nil);

end;

procedure TForm1.ReleaseTest1Click(Sender: TObject);
begin
FTest1._Release
// TTest1.Destroy没有触发

end;

end.

//察看vcl发现,两个_release的工作方式不一样:
function TInterfacedObject._Release: Integer;
begin
Result := InterlockedDecrement(FRefCount);
if Result = 0 then
Destroy;
end;
function TComponent._Release: Integer;
begin
if FVCLComObject = nil then
Result := -1 // -1 indicates no reference counting is taking place
else
Result := IVCLComObject(FVCLComObject)._Release;
end;
 
弟兄们,没人在意这个问题吗?
 
从TInterfaceObject继承下来的对象就不用关了,生存期问题,TInterfaceObject已经写好了,自己看源码。不过你从其他类继承下来的话,就得自己实现_AddRef和_DelRef两个接口方法自己处理释放问题了。
 
例子中,调用_Release是想看看它是否触发了destroy事件
现在我想知道的是TComponent也实现了_Add.. ,._Release接口方法
它为什么就不象TInterfaceObject一样,帮我们管理对象释放问题了?
 
因为TComponent不是为COM组建设计的,是VCL的一部分,有VCL的需求,如果这个组建也自动释放,那整个VCL框架都会收到严重破坏!如果你真的要从TComponent继承接口控件,那么你就必须覆盖如_Release和_Add两个方法,自己处理释放问题!所以Delphi才提供了个已经做好处理的TInterfaceObject啊!明白不?
 
再帮你顶一下
 
看这个,你就明白真正的含义:
VCL Reference
CreateVCLComObjectProc variable

See also
pecifies a procedure that creates a COM object associated with a component.

Unit

Classes

Category

COM utilities

var CreateVCLComObjectProc: procedure(Component: TComponent) = nil;

Description

Components (TComponent and its descendants) can act as COM objects by delegating to an associated object that supports the IVCLComObject interface, which is defined in the Classes unit. This associated object is the value of the component’s ComObject property.

The procedure specified by CreateVCLComObjectProc creates the associated object for the component specified by the Component parameter. When the CreateVCLComObjectProc variable is not nil, reading a component’s ComObject property causes the component to call the assigned procedure to instantiate the associated object. This object is then used to implement subsequent calls to the component’s _AddRef, _Release, QueryInterface, FreeOnRelease, GetIDsOfNames, GetTypeInfo, GetTypeInfoCount, Invoke, and SafeCallException methods.

By default, CreateVCLComObjectProc is nil. The VCLCom unit assigns a value to this variable to link VCL components into the Delphi ActiveX framework (DAX). The procedure in the VCLCom unit instantiates a COM object that supports a particular threading model such as the apartment (setting up thread apartments) or free-threading model.

Assign a value to CreateVCLComObjectProc to provide your own implementation that lets a component act as a COM object. The assigned procedure should create an object that supports the IVCLComObject interface and assign it to the Component parameter’s VCLComObject property.

Note: Do not assign a value to CreateVCLComObjectProc if you are using the VCLCom unit.
 
//来自:张鸿林, 时间:2005-7-13 12:27:21, ID:3132971
//例子中,调用_Release是想看看它是否触发了destroy事件
跟踪一下就晓得了嘛.
不要问为什么,而应该问如果TComponent象TInterfaceObject一样,会怎么样
 
TComponent固然是和接口帮定的,但是它并没有去实现计数为0自动释放.
因为通过计数器释放是有一定局限性的.最大的问题就在于不能循环引用
两个TComponent对象.
B := XXX .Create(A)
那么B的Owner指向A,A的Compnents(内部通过一个TList实现)又指向B.
那么A和B的引用计数至少为1.永远不会被释放.
再比如TDBGrid.Columns,有一个属性Grid.那么一个TDBGrid对象的计数器永远也不会是0.
所以TComponent没用计数器释放,而是使用拥有者的释放方式,拥有者释放,所有的被拥有者自动会释放.
 
已经作过实验:
覆盖TComponent的_AddRef和_Release,使之象TInterfacedObject一样实现
可以使之自管理生存期
就是不知道会带来什么不良后果
但Delphi文档好象允许这样做

谢谢各位
 
多人接受答案了。
 
后退
顶部