autoptr.pas

在Delphi2009中实现类似于STL中auto_ptr的智能指针！关于此智能指针的原理及解释请进入以下网址： http://www.cnblogs.com/felixYeou/archive/2

{******************************************************
*
* 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.