一、弊端
在此先要感謝網友裝配腦袋的提醒，在我關於Delphi中實現智能指針的第一篇文章“Delphi2009初體驗 - 語言篇 - 智能指針的實現”裡，裝配腦袋給我提出了這麼個問題：
“管這個叫智能指針未免名不副實了一點，實際上class型的對象引用與指針的語義有跟大的不同。而C++的智能指針就是為了在語義上獲得方便性的一種機制。 ”
後來我想了想，確實存在裝配腦袋所表述的問題
。在原來的代碼中，我進行了如下約束：
IAutoPtr<T:class>=interface(IInterface)
我將T類型規定為必須為一個類類型（class型），如果使用TAutoPtr包囊class型的TObject，那麼TAutoPtr只能算是一個“智能對象”，而不是“智能指針”。在此，我們把T: class的約束class去掉，此處就能傳入非class型的類型了，當然也包括指針類型。
二、提出問題
然而，把約束: class去掉，會帶來一些問題：
首先貼出原來的代碼：
1 type
2 IAutoPtr<T: class> = interface(IInterface)
3 ['{BD098FDB-728D-4CAC-AE40-B12B8B556AD3}']
4 function Get: T;
5 function Release: T;
6 procedure Reset(aObj: T);
7 end;
8
9 TAutoPtr<T: class> = class(TInterfacedObject, IAutoPtr<T>)
10 private
11 fObj: T;
12 public
13 class function New(aObj: T): IAutoPtr<T>;
14 constructor Create(aObj: T); virtual;
15 destructor Destroy; override;
16 function Get: T;
17 function Release: T;
18 procedure Reset(aObj: T);
19 end;
20
21 implementation
22
23 { TAutoPtr<T> }
24
25 constructor TAutoPtr<T>.Create(aObj: T);
26 begin
27 fObj := aObj;
28 end;
29
30 class function TAutoPtr<T>.New(aObj: T): IAutoPtr<T>;
31 begin
32 Result := TAutoPtr<T>.Create(aObj) as IAutoPtr<T>; // 注意：此處如果不加as IAutoPtr<T>，程序運行時會報錯，第一次我沒有加as IAutoPtr<T>程序運行一切正常，到後面就不行了，不知道是為什麼
33 end;
34
35 function TAutoPtr<T>.Release: T;
36 begin
37 Result := fObj;
38 fObj := nil;
39 end;
40
41 procedure TAutoPtr<T>.Reset(aObj: T);
42 begin
43 if aObj <> fObj then
44 begin
45 FreeAndNil(fObj);
46 fObj := aObj;
47 end;
48 end;
49
50 destructor TAutoPtr<T>.Destroy;
51 begin
52 if fObj <> nil then
53 begin
54 FreeAndNil(fObj);
55 end;
56
57 inherited;
58 end;
59
60 function TAutoPtr<T>.Get: T;
61 begin
62 Result := fObj;
63 end;
1、在Release方法內的“fObj := nil”，編譯器將不支持，因為fObj為T類型，T可以為值類型，值類型賦值為nil是不允許的。
2、在Reset(aObj: T)方法內的“aObj <> fObj”，編譯器將不支持，雖然aObj和fObj都為T類型，但是泛型T為任意類型，並不是任何類型都支持“<>”比較運算符的。
3、Destroy方法內的“if fObj = nil then”不被支持，原因和第一點一樣。
4、Destroy方法內的“FreeAndNil(fObj)”不被支持，因為T可能是值類型，原因和第一點一樣。
三、解決問題
在解決問題之前，我們先進行如下的規定：
TAutoPtr<T>中的T智能傳入Class類型或指針類型，不能傳入如Integer、record這樣的保存在棧上的類型，因為這樣是沒有意義的。如果能有這樣的約束：“TAutoPtr<T: class or Pointer>”就好了
解決問題：
1、“fObj := nil”，fObj為指針，我們可以改成“Integer((@fObj)^) := 0;”
2、“aObj <> fObj”，有了第一點，第二點也好改了：“Integer((@aObj)^) <> Integer((@fObj)^)”
3、“if fObj = nil then” ，改為：“if Integer((@fObj)^) <> 0 then”
4、這一點比較麻煩，因為我們即使按照約定T必須為class或Pointer，fObj必須為一個指針，也不能擁有像c++一樣的delete函數。 雖然Delphi擁有Dispose函數，但是Dispose函數不能夠實現Free方法。
所以，我們必須根據T的類型分別處理，如果是class型則Free，如果是指針類型則用另外一種方法處理。
首先，我們通過如下方法獲取T的類型信息：
uses
TypInfo;
var
fTypeInfo:PTypeInfo;
begin
//獲取泛型的類型
fTypeInfo:=TypeInfo(T);
end;
1）針對於class類型，我們可以這樣處理：
if fTypeInfo.Kind = tkClass then
TObject((@fObj)^).Free;
2）由於Pointer不包含類型信息，如果T為Pointer，則fTypeInfo為nil。然而，釋放指針有兩種方法，Dispose和FreeMem。關於Dispose和Freemem的區別，請閱讀以下文章《Delphi的指針》。
通過查看System.pas中的代碼我發現，Delphi在Dispose的時候已經調用了FreeMem方法：
PUSH EAX
CALL _Finalize
POP EAX
CALL _FreeMem
而_Finalize方法是做對有類型的指針（如：PGUID）所指向的結構體變量的一些“善後工作”，如果為純Pointer，_Finalize方法內將不執行：
asm
{ ECX number of elements of that type }
CMP ECX, 0 { no array -> nop }
JE @@zerolength
...
@@zerolength:
end;
所以，我們就可以放心的使用Dispose方法了：
if fTypeInfo = nil then
//FreeMem(Pointer((@fObj)^))
// 此處應該調用Dispose，因為Dispose內部已經實現FreeMem：
// PUSH EAX
// CALL _Finalize
// POP EAX
// CALL _FreeMem
Dispose(Pointer((@fObj)^));
四、改進New方法
在方法New中，我們將指針傳入智能指針內部，由智能指針來管理指針的自動釋放。在翻譯Java的Json-RPC的時候，為了實現類似於Java的垃圾回收功能，我使用到了智能指針。當翻譯到JSONObject的時候，我發現New方法非常的麻煩：
fMyHashMap:=TAutoPtr<TDictionary<string,IAutoPtr<TObject>>>.New(TDictionary<string,IAutoPtr<TObject>>.Create);
我已經告訴TAutoPtr<T>，T的類型為TDictionary<string,IAutoPtr<TObject>>，我能不能寫一個New的重載方法，讓它自動實現對T的創建呢？如果T的約束為T: class或T: constructor，則很好實現：T.Create即可。現在，T沒有任何約束，如果加了T.Create編譯器是不支持的。我研究出了一種可行的方法，代碼如下：
class function TAutoPtr<T>.New: IAutoPtr<T>;
var
typInfo: PTypeInfo;
obj: TObject;
objNew: T;
begin
typInfo := TypeInfo(T);
// 在此處只能創建class型的指針，不能創建無類型指針
// 因為指針在Delphi中有兩種初始化方式
// 1、GetMem(p, 100);
// 2、New(p);
if (typInfo <> nil) and (typInfo.Kind = tkClass) then
begin
// 獲取T的類型並調用默認構造函數創建對象
obj := GetTypeData(typInfo).ClassType.Create;
// 使用以下方法強制轉換
objNew := T((@obj)^);
Exit(New(objNew));
end;
raise Exception.Create('只能構造class型的對象。');
end;
原理在代碼的注釋中寫得很清楚了，這裡只能針對class型的類型做構造，Pointer型的類型會拋出異常。
五、完整代碼
{******************************************************
*
* Delphi Smart Pointer class
* AutoPtr
* Version 0.2 beta
* Yang Qinqing @ http://www.cnblogs.com/felixyeou
*
*******************************************************}
unit AutoPtr;
interface
uses
SysUtils,
TypInfo;
type
IAutoPtr<T> = interface
['{86DB82D6-9A32-4A6A-9191-2E0DFE083C38}']
function Get: T;
function Release: T;
procedure Reset(aObj: T);
end;
TAutoPtr<T> = class(TInterfacedObject, IAutoPtr<T>)
private
fObj: T;
fTypeInfo: PTypeInfo;
procedure FreeObj;
public
class function New(aObj: T): IAutoPtr<T>; overload;
class function New: IAutoPtr<T>; overload;
constructor Create(aObj: T); virtual;
destructor Destroy; override;
function Get: T;
function Release: T;
procedure Reset(aObj: T);
end;
implementation
{ TAutoPtr<T> }
constructor TAutoPtr<T>.Create(aObj: T);
begin
fObj := aObj;
// 獲取泛型的類型
fTypeInfo := TypeInfo(T);
end;
class function TAutoPtr<T>.New(aObj: T): IAutoPtr<T>;
begin
Result := TAutoPtr<T>.Create(aObj) as IAutoPtr<T>;
end;
function TAutoPtr<T>.Release: T;
begin
Result := fObj;
// fObj := nil
Integer((@fObj)^) := 0;
end;
procedure TAutoPtr<T>.Reset(aObj: T);
begin
// aObj <> fObj then
if Integer((@aObj)^) <> Integer((@fObj)^) then
begin
FreeObj;
fObj := aObj;
end;
end;
destructor TAutoPtr<T>.Destroy;
begin
// if fObj = nil then..
if Integer((@fObj)^) <> 0 then
FreeObj;
fTypeInfo := nil;
inherited;
end;
procedure TAutoPtr<T>.FreeObj;
begin
// 此處如果TypeInfo為空，則說明T為Pointer
// 此處只要簡單的釋放內存即可
if fTypeInfo = nil then
//FreeMem(Pointer((@fObj)^))
// 此處應該調用Dispose，因為Dispose內部已經實現FreeMem：
// PUSH EAX
// CALL _Finalize
// POP EAX
// CALL _FreeMem
Dispose(Pointer((@fObj)^))
else
begin
case fTypeInfo.Kind of
tkClass:
// 調用Object.Free，進而調用Destructor Dispose（virtual）方法
// 實現在對象樹上的遍歷釋放
TObject((@fObj)^).Free;
tkArray, tkDynArray:
// 數組和動態數組無需釋放
end;
end;
// fobj := nil;
Integer((@fObj)^) := 0;
end;
function TAutoPtr<T>.Get: T;
begin
Result := fObj;
end;
class function TAutoPtr<T>.New: IAutoPtr<T>;
var
typInfo: PTypeInfo;
obj: TObject;
objNew: T;
begin
typInfo := TypeInfo(T);
// 在此處只能創建class型的指針，不能創建無類型指針
// 因為指針在Delphi中有兩種初始化方式
// 1、GetMem(p, 100);
// 2、New(p);
if (typInfo <> nil) and (typInfo.Kind = tkClass) then
begin
// 獲取T的類型並調用默認構造函數創建對象
obj := GetTypeData(typInfo).ClassType.Create;
// 使用以下方法強制轉換
objNew := T((@obj)^);
Exit(New(objNew));
end;
raise Exception.Create('只能構造class型的對象。');
end;
end.
