声明：本文乃 熊恒(beta) 原创，如要转载请保持文章完整。
Delphi 中智能对象的实现 --- by 熊恒(beta)
回想一下，我们中的大部分都应该写过类似这样的代码吧：
procedure TYourClass.SomeMethod(SomeParam: SomeType);
var
SomeObj: TSomeClass;
begin
SomeObj := TSomeClass.Create;
try
SomeObj.DoSomeThing(SomeParam);
finally
SomeObj.Free;
end;
end;
在一个方法（或过程、函数）中，你需要临时创建一个对象，在离开方法前，需要将其
释放掉。于是，我们一次又一次不厌其烦的写着这样的 try-finally-end 的代码。这时
我不由地羡慕起 C++ 程序员来，他们可以吧对象分配在栈上，离开作用域后，对象就会
自动释放，多方便啊：）
可惜，Delphi 中的对象都是分配在堆上的。要是 Delphi 中的对象也可以向 C++ 那样，
在方法中需要时临时创建，使用完了就不用管，离开方法时自动会被释放（无论是否出现
异常，这也很重要），那该多好啊。
但是，Delphi 没有直接提供这样的机制。不过我们还是有办法：）考虑一下，C++ 中的
智能指针是怎么回事？一个指针分配空间后，也像局部对象一样不管了，离开作用域后会
自动释放其分配的空间。实际上就是用了一个局部对象包裹之，在离开作用域之后，局部
对象自动释放，在其析构函数中释放那指针的空间。
那么，在 Delphi 中是否有类似的机制呢？其实是有的，Delphi 中的接口（Interface），
在离开（过程级的）作用域后，会自动释放（其实现对象），我们可在这上面做点文章。
在这里，就可以借用 C++ 中智能指针的思想，用可以自动释放的局部对象以释放特定的
指针；用可以自动释放的接口（的实现对象）以释放特定的对象。只要我们设法把一个需
要自动释放的对象的引用传到一个接口中，那么我们就可以在接口释放时，释放该对象。
关键就在于这个接口和需要自动释放的对象的生命周期应该一致。因为我们要自动释放的
对象是局部变量，这个接口也应该是一个局部变量。
在明确这一点后，实现就相对比较容易了，去掉空行和注释一共不到 40 行，呵呵。那么
先来个例子，看看这个东西是怎么用的，然后给出实现。
program SafeObjTest;
{$APPTYPE CONSOLE}
uses
SysUtils, XhSafeObj;
type
TTest = class
private
FName: string;
public
constructor Create(const Name: string);
destructor Destroy; override;
procedure SayHello;
end;
{ TTest }
constructor TTest.Create(const Name: string);
begin
FName := Name;
end;
destructor TTest.Destroy;
begin
Writeln(FName, ' is gone');
inherited;
end;
procedure TTest.SayHello;
begin
Writeln('Hello, I am ', FName);
end;
procedure Proc1;
var
Test: TTest;
begin
Test := TTest.Create('Tom');
SafeObject(Test);
Test.SayHello;
end;
procedure Proc2;
var
Test: TTest;
begin
Test := TTest.Create('Jim');
SafeObject(Test);
Test.SayHello;
raise Exception.Create('Something wrong');
Test.SayHello;
end;
procedure Proc3;
var
Test: TTest;
begin
SafeCreateObject(TTest.Create('Jerry'), Test);
Test.SayHello;
end;
begin
Proc1;
try
Proc2;
except
Writeln('Catch you');
end;
Proc3;
Writeln('Finished');
Readln;
end.
以下是这个例子的输出：
Hello, I am Tom // Tom 创建
Tom is gone // 在 Jim 创建之前，Tom 释放了
Hello, I am Jim // Jim 创建，这行只出现一次说明异常正确抛出
Jim is gone // 即使出现异常，Jim 还是释放了
Catch you // 而且是在退出 Proc2 之前
Hello, I am Jerry // 演示另一种用法
Jerry is gone // 再次成功 :-)
Finished
以下是具体实现单元文件（XhSafeObj.pas）：
{******************************************************************************}
{ }
{ Beta Code Library }
{ }
{ Copyright (c) 2004-2004 Beta }
{ }
{ Author: Beta Xiong }
{ Creation: 2004-08-25 }
{ Version: 0.01 }
{ File: xhSafeObj.pas }
{ Description: Safe-object that will be destroyed automaticly when }
{ get out of current procedure, like C++ smart pointer. }
{ WebSite: http://www.01cn.net }
{ EMail: beta@01cn.net or xbeta@tom.com }
{ Update: }
{ 2004-08-25 First creation }
{ }
{******************************************************************************}
unit XhSafeObj;
interface
type
ISafeObject = interface(IInterface)
['{4D1E5EFE-BE7A-C0DE-11B3-C0326DA03A05}']
end;
{ Usage:
SomeObj := TSomeClass.Create(SomeParams);
SafeObject(SomeObj);
After that, the SomeObj will be destroyed automaticly when get out of current
procedure.
}
function SafeObject(Instance: TObject): ISafeObject;
{ Usage:
SafeCreateObject(TSomeClass.Create(SomeParams), SomeObj);
After that, the SomeObj will be destroyed automaticly when get out of current
procedure.
}
function SafeCreateObject(Cnstrctor: TObject; out Reference): ISafeObject;
implementation
type
TSafeObject = class(TInterfacedObject, ISafeObject)
private
FInstance: TObject;
public
constructor Create(const Instance: TObject); virtual;
destructor Destroy; override;
end;
{ TSafeObject }
constructor TSafeObject.Create(const Instance: TObject);
begin
FInstance := Instance;
end;
destructor TSafeObject.Destroy;
begin
FInstance.Free;
FInstance := nil;
end;
function SafeObject(Instance: TObject): ISafeObject;
begin
Result := TSafeObject.Create(Instance);
end;
function SafeCreateObject(Cnstrctor: TObject; out Reference): ISafeObject;
begin
Result := TSafeObject.Create(Cnstrctor);
TObject(Reference) := Cnstrctor;
end;
end.
结合前面的例子稍微解释一下：
procedure Proc1;
var
Test: TTest;
begin
Test := TTest.Create('Tom'); // 创建一个实例
SafeObject(Test); // 这里就是关键了，把这个实例指针传给了 SafeObject 函数
// 而 SafeObject 函数创建了一个 TSafeObject 对象，并且
// 把该实例指针保存了起来，那么在这个 TSafeObject 对象
// 释放时，就可以通过其析构函数释放掉这个 TTest 实例了。
// 那么那个 TSafeObject 对象是怎么释放的呢？往后看。
Test.SayHello;
// 要退出函数了，Delphi 管理接口指针是很老实的，对于声明为局部变量的接口
// 指针，在退出函数前是会被自动释放的，呃，实际上是减少其引用计数。等等，
// 局部变量的指针？哪里？别忘了我们刚才调用那个 SafeObject 函数实际上是有
// 返回值的，它返回了一个 ISafeObject 指针（当然了，是由那个 TSafeObject
// 实现的），我们没有保存这个返回值，而是把它丢掉了。这样，Delphi 会把那
// 个返回的接口指针当成一个临时变量，它享有和局部变量同等的待遇，对于这种
// 身为临时变量的接口指针同样会在过程结束时被释放。因此也就能够保证刚才的
// TSafeObject 能释放，也就保证了刚才传入的那个对象的实例能够在过程退出时
// 被释放。
end;
procedure Proc2;
var
Test: TTest;
begin
Test := TTest.Create('Jim'); // 创建一个实例
SafeObject(Test);
Test.SayHello;
// 虽然这里有异常，但是 Delphi 管理接口指针的机制决定了，局部接口指针即使
// 是出现异常，也能自动释放。Delphi 会自动为整个过程增加一 try-finally 的
// 包裹（当然，只在有必要的时候），在出现异常的时候，这个过程级的 fianlly
// 会被执行，其中就包含清除这些局部接口指针的代码。所以即使出现异常，保存
// 的对象实例同样能够被释放。
raise Exception.Create('Something wrong');
Test.SayHello;
end;
也许你已经想到了，在 Delphi 中，离开过程会自动释放的东东不仅仅是接口一个，还有
变体类型 :-) 以下提供了基于变体类型的 SafeObject 实现，就不做解释了，一个道理。
基于变体类型实现的具体单元文件（XhSafeObjVar.pas）：
{******************************************************************************}
{ }
{ Beta Code Library }
{ }
{ Copyright (c) 2004-2004 Beta }
{ }
{ Author: Beta Xiong }
{ Creation: 2004-08-25 }
{ Version: 0.01 }
{ File: XhSafeObjVar.pas }
{ Description: Safe-object that will be destroyed automaticly when }
{ get out of current procedure, like C++ smart pointer. }
{ WebSite: http://www.01cn.net }
{ EMail: beta@01cn.net or xbeta@tom.com }
{ Update: }
{ 2004-08-25 First creation }
{ }
{******************************************************************************}
unit XhSafeObjVar;
interface
uses
Variants;
{ Usage:
SomeObj := TSomeClass.Create(SomeParams);
SafeObject(SomeObj);
After that, the SomeObj will be destroyed automaticly when get out of current
procedure.
}
function SafeObject(const Instance: TObject): Variant;
{ Usage:
SafeCreateObject(TSomeClass.Create(SomeParams), SomeObj);
After that, the SomeObj will be destroyed automaticly when get out of current
procedure.
}
function SafeCreateObject(const Cnstrctor: TObject; out Reference): Variant;
implementation
type
TSafeObjectVariantType = class(TCustomVariantType)
public
procedure Clear(var V: TVarData); override;
end;
TSafeObjectVarData = packed record
VType: TVarType;
Reserved1, Reserved2, Reserved3: Word;
VObject: TObject;
Reserved4: LongInt;
end;
var
SafeObjectVariantType: TSafeObjectVariantType = nil;
{ TSafeObjectVariantType }
procedure TSafeObjectVariantType.Clear(var V: TVarData);
begin
TSafeObjectVarData(V).VObject.Free;
TSafeObjectVarData(V).VObject := nil;
end;
function SafeObject(const Instance: TObject): Variant;
begin
VarClear(Result);
TSafeObjectVarData(Result).VType := SafeObjectVariantType.VarType;
TSafeObjectVarData(Result).VObject := Instance;
end;
function SafeCreateObject(const Cnstrctor: TObject; out Reference): Variant;
begin
VarClear(Result);
TSafeObjectVarData(Result).VType := SafeObjectVariantType.VarType;
TSafeObjectVarData(Result).VObject := Cnstrctor;
TObject(Reference) := Cnstrctor;
end;
initialization
{$WARNINGS OFF}
// no need to implement abstract method TCustomVariantType.Copy, so we turn
// off the "Constructing instance of 'TSafeObjectVariantType' containing
// abstract method 'TCustomVariantType.Copy'" compiler message
SafeObjectVariantType := TSafeObjectVariantType.Create;
{$WARNINGS ON}
finalization
SafeObjectVariantType.Free;
SafeObjectVariantType := nil;
end.
稍做解释：
这是 Delphi 自己规定的 CustomVariant 的实现机制决定的。它将自定义变体类型分为
操作和数据。其中所有对自定义变体的操作都转发到这个 TSafeObjectVariantType 的
Helper 上来，而所有的数据就被塞到一个 TVarData 中。TSafeObjectVariantType 在
创建的时候会自动注册该变体类型，并被分配一个 VType，以后凡事对 VType 为这个值
的变体的操作就会发送到这个 Helper 上来，当然，其中就包括 Clear。
据不严格测试，用接口的实现比用变体型的实现稍微快那么一点点 :-)
其实稍做修改就可以支持类似 BeginUpdate/EndUpdate 这样的自动调用，那仅仅是以一个
方法指针的传递取代对象引用的传递而已，而且又没有太大意义，就不去管了，呵呵。
OK，就写到这里，不管是砖板还是什么都可以扔过来，不过大过节的。。。希望不要人身
攻击，呵呵。