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

Question

如下所示的两个程序尝试测试一个对象是否被释放，使用这里描述的技术来引用一个已经释放的对象。

如下所示的第一个程序如果在Delphi 7下编译可以正确运行，但如果在Delphi XE和更高版本下编译就会出错。也就是说，它输出

 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.

我很困惑错误的行为是如何引起的，并想知道如何测试对象是否为Delphi 7和Delphi XE和更高版本释放，特别是使用FastMM4时?

Answer 1

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

Answer 2

没有办法检查对象是否有效，只能将其指针与NIL进行比较。禁止对象拥有一个以上的指针，否则如果该对象被一个指针释放，则在第二个指针上引用同一对象将导致访问冲突。

Answer 3

您可以使用以下代码测试VCL对象是否被释放/释放:

if  (csFreeNotification in Self.ComponentState) 
or (csDestroying in Self.ComponentState)  then ... //Self is Freed or Freeing.

但是不能将此方法应用于普通指针(非vcl对象)

Answer 4

我也遇到了这个问题，但我通过执行以下操作来解决它

首先在接口

下创建一个新变量

unit Login_Sys;
interface
var
bisnotinmemory:boolean=true;

然后进入你想要随机检查的类，看看它是否仍在内存的构造函数和析构函数方法中，并执行如下操作

constructor TUserlogin.create;
begin
  bisnotinmemory:=False;

和

destructor TUserlogin.free;
begin
  bisnotinmemory:=true;

如果你必须跟踪多个对象，那么你总是可以将我使用的"bisnotinmemory"变量放入数组中。

unit Login_Sys;
interface
var
bisnotinmemory: array[0..1] of Boolean = (true, true);

记得在类的create方法中添加"iOBjectID: integer"之类的东西比如

constructor TUserlogin.create(iOBjectID : integer);
begin
  bisnotinmemory[iOBjectID]:=false;
  iPersonalID:=iOBjectID;

你甚至可以在对象的"private"区域下声明一个像"iPersonalID"这样的变量，以便在调用析构函数方法时使用。

destructor TUserlogin.free;
begin
  bisnotinmemory[iPersonalID]:=true;

我在Delphi 2010中测试了这个