如何测试一个对象是否在Delphi中被释放

Question

如下所示的两个程序尝试使用这里描述的技术Bad reference to an object already freed来测试一个对象是否被释放。

下面显示的第一个程序如果在Delphi 7下编译，将会正确运行，但如果在Delphi XE和upper下编译则会错误。也就是说，它输出

D7   DXE 
True  True 
True  True 
True  False 
True  True 
False  True 
False  False 

program Project1; 

{$APPTYPE CONSOLE} 

uses 
    SysUtils; 

function ValidateObj(Obj: TObject): Pointer; 
// see { Virtual method table entries } in System.pas 
begin 
    Result := Obj; 
    if Assigned(Result) then 
    try 
     if Pointer(PPointer(Obj)^) <> Pointer(Pointer(Cardinal(PPointer(Obj)^) + Cardinal(vmtSelfPtr))^) then 
     // object not valid anymore 
     Result := nil; 
    except 
     Result := nil; 
    end; 
end; 

function ValidateObj2(Obj: TObject): Pointer; 
type 
    PPVmt = ^PVmt; 
    PVmt = ^TVmt; 
    TVmt = record 
    SelfPtr : TClass; 
    Other : array[0..17] of pointer; 
    end; 
var 
    Vmt: PVmt; 
begin 
    Result := Obj; 
    if Assigned(Result) then 
    try 
     Vmt := PVmt(Obj.ClassType); 
     Dec(Vmt); 
     if Obj.ClassType <> Vmt.SelfPtr then 
     Result := nil; 
    except 
     Result := nil; 
    end; 
end; 

var 
    Obj: TObject; 
begin 
    Obj := TObject.Create; 
    Writeln(BoolToStr(Assigned(Obj), True)); 
    Writeln(BoolToStr(Assigned(ValidateObj(Obj)), True)); 
    Writeln(BoolToStr(Assigned(ValidateObj2(Obj)), True)); 
    Obj.free; 
    Writeln(BoolToStr(Assigned(Obj), True)); 
    Writeln(BoolToStr(Assigned(ValidateObj(Obj)), True)); 
    Writeln(BoolToStr(Assigned(ValidateObj2(Obj)), True)); 
    Readln; 
end. 

第二程序，显式使用FastMM4，如下所示时的Delphi 7或XE和上下编译错误地运行。也就是说，它输出

Expected  D7 DXE 
    False  False False 
    True  True True 
    True  True True 
    True  True False 
    True  False False 
    True  True True 
    False  True True 
    False  True False 

program Project2; 

{$APPTYPE CONSOLE} 

uses 
    FastMM4, 
    SysUtils; 

function ValidateObj(Obj: TObject): Pointer; 
// see { Virtual method table entries } in System.pas 
begin 
    Result := Obj; 
    if Assigned(Result) then 
    try 
     if Pointer(PPointer(Obj)^) <> Pointer(Pointer(Cardinal(PPointer(Obj)^) + Cardinal(vmtSelfPtr))^) then 
     // object not valid anymore 
     Result := nil; 
    except 
     Result := nil; 
    end; 
end; 

function ValidateObj2(Obj: TObject): Pointer; 
type 
    PPVmt = ^PVmt; 
    PVmt = ^TVmt; 
    TVmt = record 
    SelfPtr : TClass; 
    Other : array[0..17] of pointer; 
    end; 
var 
    Vmt: PVmt; 
begin 
    Result := Obj; 
    if Assigned(Result) then 
    try 
     Vmt := PVmt(Obj.ClassType); 
     Dec(Vmt); 
     if Obj.ClassType <> Vmt.SelfPtr then 
     Result := nil; 
    except 
     Result := nil; 
    end; 
end; 

var 
    Obj: TObject; 
begin 
    Obj := TObject.Create;   
    Writeln(BoolToStr(Obj is FastMM4.TFreedObject, True)); 
    Writeln(BoolToStr(Assigned(Obj), True)); 
    Writeln(BoolToStr(Assigned(ValidateObj(Obj)), True)); 
    Writeln(BoolToStr(Assigned(ValidateObj2(Obj)), True)); 
    Obj.free;         
    Writeln(BoolToStr(Obj is FastMM4.TFreedObject, True)); 
    Writeln(BoolToStr(Assigned(Obj), True)); 
    Writeln(BoolToStr(Assigned(ValidateObj(Obj)), True)); 
    Writeln(BoolToStr(Assigned(ValidateObj2(Obj)), True)); 
    Readln; 
end. 

我感到困惑多么错误的行为造成的，并想知道如何测试对象是否被释放德尔福7和Delphi XE和上，尤其是在使用FastMM4？

Answer 1

一般来说，不可能做一个健壮的测试，指针指向一个已被释放的实例。程序员的工作是维护对象的生命周期控制。

Answer 2

无法检查对象是否有效，而是将其指针与NIL进行比较。禁止对象具有多于一个指针，否则如果此对象通过一个指针释放，则引用同一对象上的第二个指针将导致访问冲突。