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

Question

The two programs as shown below try to test whether a object is freed, using the techniques described here Bad reference to an object already freed .

The first program as shown below runs correctly if compiled under Delphi 7, but wrongly if compiled under Delphi XE and upper. That is to say, it outputs

 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.

The second program, explicitly using FastMM4, as shown below runs wrongly when compiled under Delphi 7 or XE and upper. That is to say, it outputs

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.

I am confused how the wrong behavior is caused, and wonder how to test whether a object is freed for Delphi 7 and Delphi XE and upper, especially when FastMM4 is used ?

Answer 1

In general, it is not possible to make a robust test that a pointer refers to an instance that has been freed or not. It is the job of the programmer to maintain control of the lifetime of your objects.

Answer 2

There is no way to check whether the object is valid, but to compare its pointer to NIL. Disallow objects to have more than one pointer, otherwise if this object freed by one pointer, reference to the same object on the second pointer will cause Access Violation.

Answer 3

you can test a VCL object if it is freed/freeing or not with the following code:

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

But you can not apply this method to ordinary pointers (non-VCL objects)

Answer 4

I had problems with this too, but I got around it by doing the following

First create a new variable directly under interface

unit Login_Sys;

interface
var
bisnotinmemory:boolean=true;

Then go to the class you would like to randomly check to see if its still in memory's constructor and destructor methods and do something like this

constructor TUserlogin.create;
begin
  bisnotinmemory:=False;

and

destructor TUserlogin.free;
begin
  bisnotinmemory:=true;

If you have to keep track of multiple object then you could always make the "bisnotinmemory" variable I used into an array.

unit Login_Sys;

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

Just remember to add something like "iOBjectID : integer" to the create methode of the class like say

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

You could even declare a variable like "iPersonalID" under the "private" area of the object for use when the destructor method gets called.

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

I tested this with Delphi 2010