修改部分用粗体表示,增加了对对象重复加载智能指针的检测
{
******************************************************
*
* 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.
*
* 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.