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

Question

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

下图第一个程序在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，如下所示，在Delphi7或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 对象是否 freed/freeing:

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;

然后转到class你想随机检查它是否还在内存中的构造函数和析构函数方法，然后做这样的事情

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);

只记得在 class 的创建方法中添加类似 "iOBjectID : integer" 的东西，比如 say

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

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

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

我用 Delphi 2010

测试了这个

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

How to test whether a object is freed in Delphi

delphi

fastmm