Delphi2009智能指针0.21b版

修改部分用粗体表示，增加了对对象重复加载智能指针的检测

{******************************************************
*
* Delphi Smart Pointer class
* AutoPtr
* Version 0.21 beta
* Yang Qinqing @ http://www.cnblogs.com/felixyeou
*
*******************************************************}

unit AutoPtr;

interface

uses
    SysUtils,
    TypInfo,
    Generics.Collections;

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;
    protected
           constructor Create(aObj: T); virtual;
    public
           class function New(aObj: T): IAutoPtr<T>; overload;
        class function New: IAutoPtr<T>; overload;
           destructor Destroy; override;
        function Get: T;
        function Release: T;
        procedure Reset(aObj: T);
    end;

var
    // 对象图，用来存放对象实体与智能对象的指针的对应关系
    // Key存放对象，Value存放智能指针
    fObjMap: TDictionary<Pointer, Pointer> = nil;
    pair: TPair<Pointer, Pointer>;

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>;
var
    p: Pointer;
begin
    // 此处不能简单的使用.Create创建智能指针
    // 因为aObj的智能指针可能已经创建
    // 直接在创建aObj的智能指针，释放时可能会导致两次释放
    // 从而出错，所以此处要判断aObj是否被创建过智能指针

    // 获取aObj指针
    p := Pointer((@aObj)^);

    // 判断图中是否有对象存在
    if fObjMap.ContainsKey(p) then
        // 直接返回智能指针
        Result := TAutoPtr<T>(fObjMap.Items[p]) as IAutoPtr<T>
    else
        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;
    typData: PTypeData;
begin
    typInfo := TypeInfo(T);

    // 在此处只能创建class型的指针，不能创建无类型指针
    // 因为指针在Delphi中有两种初始化方式
    // 1、GetMem(p, 100);
    // 2、New(p);
    if (typInfo <> nil) and (typInfo.Kind = tkClass) then
    begin
        typData := GetTypeData(typInfo);
        Writeln(typData.ClassType.ClassName);
        TClass.Create;

        // 获取T的类型并调用默认构造函数创建对象
        obj := GetTypeData(typInfo).ClassType.Create;

        // 使用以下方法强制转换
        objNew := T((@obj)^);
        Exit(New(objNew));
    end;

    raise Exception.Create('只能构造class型的对象。');
end;

initialization

fObjMap := TDictionary<Pointer, Pointer>.Create;

finalization

fObjMap.Free;

end.