beta 的第四篇心得：一个释放后自动清空实例指针的类 (20分)

声明：本文乃 熊恒(beta) 原创，如要转载请保持文章完整。
一个释放后自动清空实例指针的类 --- by 熊恒(beta)
前面部分比较简单，要是你早就已经懂了，就直接跳到后面看完整代码就可以了：）
如何判断一个对象是否创建，或者说是否释放？最常用的方法当然就是用Assigned(Obj)
函数了，当然，这和使用 Obj <> nil 进行判断是一回事，因此本文仅使用 Assigned 函
数。（注：虽说 Assigned 是函数，但实际上使用它的时候并不产生真正的函数调用（汇
编指令 CALL），而仅仅是进行一个比较而已。）
假设有以下情况：
var
Obj: TTest;
begin
// 第一次判断结果是 False，即 Obj 为空。因为 Obj 还没有创建。
if Assigned(Obj) then
ShowMessage('Assigned')
else
ShowMessage('Not assigned');
Obj := TTest.Create(nil);
//第二次判断结果是 True，即 Obj 不为空。，因为 Obj 已经创建了。
if Assigned(Obj) then
ShowMessage('Assigned')
else
ShowMessage('Not assigned');
Obj.Free;
// 第三次判断，结果是 True。
if Assigned(Obj) then
ShowMessage('Assigned')
else
ShowMessage('Not assigned');
end;

前两次判断结果和原因都很好理解。不过第三次判断的结果，对于没什么经验的人来说，
恐怕就不太好理解了，Obj 明明释放了，为什么还是不为空？关键是要弄清楚，释放了，
并不代表清空了。我们知道，一切对象皆指针，即 Obj 其实是指向其虚方法表的指针。
对于一个指针来说，释放了就意味着它所指向的内存空间被回收了，在那片空间被再次分
配前，不应该对它们进行访问。但是这和指针被清空了是两回事，指针被释放过后，它仍
然指向那片被释放了的空间！就是说，我们的指针现在指向一片被回收了的空间。而指针
为空则代表不指向任何空间。
“好吧，现在我知道了，释放了但是不为空，可是那又怎么样呢？有什么问题吗？”当然
有问题啦，考虑如下代码片断：
begin
...
if Assigned(Obj) then
Obj.Free;
...
end;

这段代码看起来好像没有问题，而且在调用 Obj.Free 前还特意判断了一下 Obj 是否创
建，嗯，很好。可是，其实这段代码隐藏着危机！如果在进入这段代码之前，Obj 尚未
创建，那么没有问题；如果在这之前 Obj 已经创建，而有没有释放，那也没有问题；问
题就出在 Obj 已经创建，但是又已经被释放的时候。如果是这样，根据我们前面的分析，
Assigned(Obj) 肯定能通过，于是就调用 Obj.Free。这就出问题了，调用其方法则会导
致程序从 Obj 所指向的虚方法表取得该方法的实际地址，而现在 Obj 所指向的空间已经
被收回了，于是就会导致异常。
既然已经找到问题的所在了，解决起来也就容易了，在所有调用 Obj.Free 的地方后面紧
跟着加上一句 Obj := nil;
即可。执行过这一句过后，不仅 Obj 所指向的空间释放了，
Obj 本身也不再指向那片空间了。于是 Assigned 所取得的结果就和 Obj 是否已经创建
的结果吻合了。就是说只要 Assigned 返回 True，我们就可以肯定 Obj 已经创建，并可
以使用；反之则代表 Obj 已经释放，不能再使用。
于是，你会觉得每次都要两句一起用，多麻烦，而且还有可能会一不小心漏掉一个，那就
麻烦了。其实，如果你不需要判断 Obj 是否已经释放，那么你也没有必要去清空它。如
果你需要这个判断，那么这个步骤就不能省略了，不过可以简化：FreeAndNil(Obj);
这
一个调用相当于以上两句话，方便。但是如果笔者仅满足于此，就不会有本文了
于是笔者开始寻找一种办法，使得一个对象可以在释放的时候自动清空。方便是其一；关
键是有些时候，必须这样，FreeAndNil 没有办法解决问题。比如你开了一个线程，设置
其 FreeOnTerminate 为 True，在 Execute 完过后自动释放，这样你怎么用 FreeAndNil？
寻找（准确的说是创造）这个办法的过程是曲折的。一开始我就走错了路，我想在析构函
数中做点手脚（基本办法是在函数结束前，将目标函数及其参数进栈，然后手工调用 RET
来实现），使其在完全释放过后调用指定的函数，来清空其指针。结果发现这一切都是徒
劳，因为我忽略了一点，在一个实例里面是不可能知道指向自己的实例指针的。就好像我
是门牌号为 3407 的教室，但是我不可能知道有哪些学生抄了我的门牌号。于是，就算你
们把这教室拆了（收回空间），但是学生手上的卡片上仍然写着“3407”（仍然指向这
里），而要想清空指针只能将学生手上的卡片上的字擦除。
正如我前面所说的，解决问题的关键是找准问题之所在。这个问题的关键就出在，一个实
例不可能知道指向自己的指针，于是解决这个问题的关键就是将这个指针传入实例。
怎么传？创建过后，用一个对象方法传进去当然是可以的，不过这样似乎也麻烦了点吧，
还要单独调用一个方法。当然应该在创建的时候搞定啦。既然是在创建的时候解决，那么
首先应该想到的自然是重载构造函数。可是，我发现这似乎行不通。因为构造函数只是返
回实例的地址，而我们需要的不是实例地址，而是指向实例地址的指针的地址（像是绕口
令）。就好像我们总是这样调用构造函数：
Obj := TTest.Create(nil);
这个语句的右边返回的是新的实例的地址（3409），把它赋给左边的 Obj（写在这张卡片
上）。想一想我们的需求，如果我们能把这张卡片（Obj）放在教室里，那么我们就可以
在拆除教室（释放 Obj 指向的空间）的时候在教室里面将这个卡片的内容擦除（清空指
针）。不过这张卡片一定要由学生拿着（Obj 的地址由定义它的地方决定了，不能改），
但是我们一样可以修理它，我们在教室里再写一张卡片，其内容就是刚才那张卡片的地址
（定义一个指针指向 Obj 的地址）。这样我们就可以在拆教室的时候通过教室里的卡片
找到刚才那张卡片的主人（地址），擦除上面的内容（清空指针）。
于是我们看到上面犯的错误就是把 Obj 放在了表达式的左边，因此位于右边的构造函数
无法获得 Obj 的地址。就是说 Obj 必须位于表达式右边。于是我写了这样一个构造函数：
constructor Create(var Obj: TTest;
AOwner: TComponent);
由于这个构造函数肯定会比基类的构造函数多一个用于传实例指针的参数，无法重载，编
译器老是弹出那该死的 warning，于是我放弃使用构造函数。构造一个对象又不是只能直
接调用构造函数，哼。至少我们可以使用类方法：
class procedure CreateObj(var Obj: TTest;
AOwner: TComponent);
这样，我们可以在这个类方法中调用其构造函数来创建一个实例，而这个实例现在可以通
过变参传回去。慢着，别忘了任务，创建实例过后把指向该实例的指针保存起来，当然也
是保存在这个实例中咯。不过千万不要（也不能）在这个类方法中直接访问成员变量哦，
我们只能通过新创建的实例变量去访问实例中的成员变量（用于保存指针）。因为在类方
法中只能也调用类方法（构造函数可以看作类方法），而不能访问成员变量和其他方法，
当然了，我们还可以访问在这个类方法中定义的变量，而形参又可以看做一个过程的局部
变量，因此我们可以通过在这个类方法中访问 Obj 来访问实例变量。
剩下的事情就简单了，重载析构函数，在释放之前，通过刚才保存的指向实例的指针把实
例指针清空，然后释放。呵呵，可以看到，其实我们这样的实现把刚才的步骤反过来了，
先清空了指针，然后释放空间。不过无所谓，只要能达到目的就可以了（为达目的，不择
手段，至少在写程序的时候是很适用的。你可别去持枪抢劫别人的代码啊）。
完整代码如下：
type
TTest = class(TComponent)
private
FPtr: ^TTest;
public
class procedure CreateObj(var Obj: TTest;
AOwner: TComponent);
destructor Destroy;
override;
end;

class procedure TTest.CreateObj(var Obj: TTest;
AOwner: TComponent);
begin
Obj := Create(AOwner);
// 调用构造函数生成实例
Obj.FPtr := @Obj;
// 将指向实例的指针保存到 Obj 中
end;

destructor TTest.Destroy;
begin
FPtr^ := nil;
// 清空实例指针
inherited;
end;

应用实例：
procedure TForm1.Button1Click(Sender: TObject);
var
Test: TTest;
begin
TTest.CreateObj(Test, nil);
// 创建一个实例
Test.Free;
// 立刻释放
if Assigned(Test) then
// 检验成果
ShowMessage('Assigned')
else
ShowMessage('Not assigned');
// 答案是它，Hooray，成功了！
end;

稍微总结一下：这并不是一个非常简便的办法，通常情况下，直接使用 FreeAndNil 恐怕
要更简单一些。不过咱们总算是实现了“自动清空”啊，呵呵。何况这也不是没有用处，
我说了，要是你需要一个自动清空的线程对象，那么这段代码应该还是很有必要的。
当然，这样还有一个限制，那就是如果你有多个指向这个实例的指针，那么就无法实现多
指针同时清空。
当然，这个问题的关键在于我们之用了一个指针用于保存实例指针，所以释放的时候就无
法得知其他的指向该实例的指针，于是也就无法清空其他实例指针。
既然又找到了问题的关键，那么我们就又可以想办法解决。可以借用 COM 的方法，我们的
私有变量不用一个指针，而是一个 TList：
type
TTest = class(TComponent)
private
FPtrList: TList;
public
class procedure CreateObj(var Obj: TTest;
AOwner: TComponent);
destructor Destroy;
override;
procedure GetRef(var NewRef: TTest);
procedure DelRef(TheRef: TTest);
end;

class procedure TTest.CreateObj(var Obj: TTest;
AOwner: TComponent);
begin
Obj := Create(AOwner);
// 调用构造函数生成实例
Obj.FPtrList := TList.Create;
Obj.FPtrList.Add(@Obj);
// 将指向实例的指针保存到列表中
end;

destructor TTest.Destroy;
var
i: Integer;
begin
for i := 0 to FPtrList.Count - 1do
TObject(FPtrList^) := nil;
FPtrList.Free;
inherited;
end;

procedure TTest.GetRef(var NewRef: TTest);
begin
if FPtrList.IndexOf(@NewRef) < 0 then
begin
NewRef := TTest(FPtrList.First^);
// 到这里，列表中肯定至少有一个
FPtrList.Add(@NewRef);
end;
end;

procedure TTest.DelRef(TheRef: TTest);
begin
FPtrList.Remove(TheRef);
end;

于是，现在如果要将该实例赋值给其他指针，就不能用原来的直接指针赋值的办法了，而
要用我们这个类提供的新的方法—GetRef。这样，不管你有多少个指针指向这个实例，只
要你是用这个方法获得的，都可以在该对象释放的时候被自动清空：
测试代码：
var
Test, Test2: TTest;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Assigned(Test) then
ShowMessage('Assigned')
else
ShowMessage('Not assigned');
TTest.CreateObj(Test, nil);
Test.GetRef(Test2);
if Assigned(Test2) then
ShowMessage('Assigned2')
else
ShowMessage('Not assigned2');
Test2.Free;
// 调用成功，说明至少实现了 Test2 := Test

if Assigned(Test) then
ShowMessage('Assigned')
else
ShowMessage('Not assigned');
if Assigned(Test2) then
// 测试成果
ShowMessage('Assigned2')
else
ShowMessage('Not assigned2');
// 答案是它，Hooray，又成功了！
end;

像这样就可以解决多指针引用的问题：） 看起来好像比较麻烦，不过在特定的时候
这还是很有必要的：）

不知你是否注意我在本文中提到的一个的观点：“解决问题的关键是找准问题之所在”。
希望能在你苦苦思考一个问题的时候对你有所帮助。
本文若有错漏之处，还望多多指教。

好

补充三点：
1.用reintroduce就可以避免编译器警告，因此还是比新作一个方法好
2.正如你所说的问题之关键，因此这个方法只适用于这种极简单的模式，
多一个变量赋值即无效。（除非重载Operator :=，呵呵）
3.虽然有2的问题，但是作为VCL中Application.CreateForm的补充
仍然颇有好处。因为该方法恰好为此形式，这样可以解决一批“RAD患者”
的痛苦 PP

出本书吧

这次beta说错了,
var
Obj: TTest;
begin
// 第一次判断结果是 False，即 Obj 为空。因为 Obj 还没有创建。
if Assigned(Obj) then
ShowMessage('Assigned')
else
ShowMessage('Not assigned');
//以上的执行结果应该为 ShowMessage('Assigned')而不是ShowMessage('Not assigned');
不信可以试试看.

正象温柔一刀说的：
如果有多个指针指向一个实例，上面的办法也不适用了.
看起来还是用接口变量来引用对象比较好.
to www:
那要看Obj被声明成局部变量还是全局变量.

to 温柔一刀:
1.多谢指教。我怎么忘了 reintroduce 这招了：）
不过说实话，如果做到 Create 里面，则实例的赋值直接在表达式右边就
搞定了，再往左边赋值比较多余，看起来有点别扭：
Test := Create(Test, nil);
所以新作一个方法恐怕看起来舒服一点：）
2.这一点算是提到点子上了，这的确是一个限制。多谢
3.说实话，我就是受了 Application.CreateForm 和 COM 类工厂的影响萌生
这个想法的：）
to www:
呵呵，您想一想，既然涉及到不知道是否释放这个问题，那么一般来说，这个
Obj 都应该是一个全局变量吧：） 全局变量是静态的，自动清空，于是那个
判断就是 Not assigned 了。也怪我没有说清楚：）

thx

一个傻问题：
可以不用
Obj.free
改用
FreeAndNil(Obj)
吗？

FreeAndNIl(Obj) 比 Obj.Free更好，完全可以代替它.

抱歉，beta大虾已经解答了，怪我没有看清楚，呵呵。

几篇文章都不错，请继续努力。。。。

哥们，不错。
有时间，我也把自己的学习想大家汇报一下。
得向你学习啊，大富翁精神！

学习

没办法，反正我是这么做的，
不用是就立马把指针给赋为零了
否则那儿内存泄漏都不知道

// 不用是就立马把指针给赋为零了
呵呵，我也经常这样：（ 指不定什么地方就要判断它了：）

..

更简单：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TTest = class(TComponent)
private
FPtr: ^TTest;
public
destructor Destroy;
override;
end;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
// ***** Ttest ********
destructor TTest.Destroy;
begin
FPtr^ := nil;
inherited;
end;
// *** Tform *********
procedure TForm1.Button1Click(Sender: TObject);
var
Test: TTest;
begin
Test:=TTest.Create(nil);
Test.FPtr:=@Test;
Test.Free;
if Assigned(Test) then
ShowMessage('Assigned')
else
ShowMessage('Not assigned');
end;
end.

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TTest = class(TComponent)
private
FPtr: ^TTest;
// <------------ 如果直接将它声明成指针可能更合理。
public
class procedure CreateObj(var Obj: TTest;
AOwner: TComponent);
destructor Destroy;
override;
end;

TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;

var
Form1: TForm1;
implementation
{$R *.DFM}
class procedure TTest.CreateObj(var Obj: TTest;
AOwner: TComponent);
begin
Obj := Create(AOwner);
Obj.FPtr := @Obj;
end;

destructor TTest.Destroy;
begin
FPtr^ := nil;
inherited;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Test,Getit: TTest;
begin
TTest.CreateObj(Test, nil);
Getit:=Test;
// 不是拷贝
Test.Free;
{
if Assigned(Test) then
ShowMessage('Assigned')
else
ShowMessage('Not assigned');
end;
}
if Assigned(Getit) then
// 检验成果
ShowMessage('Assigned') // 答案是它
else
ShowMessage('Not assigned');
end;
end.

Ale.：
你这种做法我已经说过了，和创建过后调用一个方法进行设置是一样的，
不都是多一个步骤嘛。
而我的方法则少了这一个步骤，每次创建的时候都可以少这个步骤：）