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.

 

转载于:https://www.cnblogs.com/felixYeou/archive/2008/09/15/1290965.html