Delphi中智能对象的实现－－-by熊恒(beta)

声明：本文乃 熊恒(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，就写到这里，不管是砖板还是什么都可以扔过来，不过大过节的。。。希望不要人身
攻击，呵呵。