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和upper下编译时运行错误。也就是说，它输出

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

我也有这方面的问题，但我通过以下方式解决了这个问题

首先直接在界面

下创建一个新变量

addPost(){
this.newPost = {
    title: this.mytemplateForm.value.title,
    body: this.mytemplateForm.value.body
}
this._postService.addPost(this.newPost);
this.mytemplateForm.reset(); }

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

unit Login_Sys;

interface
var
bisnotinmemory:boolean=true;

和

constructor TUserlogin.create;
begin
  bisnotinmemory:=False;

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

destructor TUserlogin.free;
begin
  bisnotinmemory:=true;

请记住在类的创建方法中添加类似“iOBjectID：integer”的内容，比如说

unit Login_Sys;

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

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

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

我使用Delphi 2010进行了测试

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

4 个答案: