Hack #6:Checking for a valid object instance

I just answered a question in a newsgroup, by simply copying-and-pasting an old post of mine. Reuse is nice, so I decided to put it in my blog as well. Here it is: "Just for the fun of it, I've made some routines to check if a pointer points to a valid object instance. This relies on some types and routines from Ray Lischner's "Secrets of Delphi 2" (the S_VMT unit). Note that this code is D3 specific. Small changes are needed for D1/D2. [Right :)]

uses 
  S_VMT;

function ValidPtr(P: pointer; Size: Cardinal): boolean;
begin
  Result := not IsBadReadPtr(P, Size);
end;

function ValidObjType(Obj: TObject; ClassType: TClass): boolean;
begin
  Result := Assigned(Obj) and
                    ValidPtr(Pointer(Obj), SizeOf(TObject)) and
                    ValidPtr(Pointer(Obj), ClassType.InstanceSize);
end;

type
  PClass = ^TClass;

function ValidPShortString(S: PShortString): boolean;
begin
  Result := ValidPtr(S, SizeOf(Byte)) and
            ValidPtr(S, Ord(S^[0])) ;
end;

function ValidClassParent(ClassParent: PClass): boolean;
begin
  if ClassParent = nil then
    Result := true
  else
  if ValidPtr(ClassParent, SizeOf(ClassParent^)) then
    Result := (ClassParent^ = nil) or ValidClassType(ClassParent^)
  else
    Result := false;
end;

function ValidClassType(ClassType: TClass): boolean;
var
  Vmt: PVmt;
begin
  Vmt := GetVmt(ClassType);
  Result := ValidPtr(Vmt, SizeOf(Vmt^))        and
            (Vmt^.SelfPtr = ClassType)         and
            ValidPShortString(Vmt^.ClassName)  and
            ValidClassParent(PClass(Vmt^.ClassParent)) ;
end;

function ValidObj(Obj: TObject): boolean;
begin
  Result := Assigned(Obj) and
            ValidPtr(PClass(Obj), SizeOf(TClass)) and
            ValidClassType(Obj.ClassType) and
            ValidPtr(Pointer(Obj), Obj.InstanceSize);
end;

This is probably not foolproof, but it should work in most instances. It works by checking for valid pointers using the Win32 API IsBadReadPtr, checking that the VMT-pointer for the given object is valid. Using this code is not recommended as an alternative to setting instance pointers to nil after freeing them."

Update; I found another old post with a simpler (and probably safer) way of doing it:

function ValidateObj(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;

Notice that this version is specific to D6 and D7 (IIRC). Other versions might need to update the hardcoded magic number (17).

Update II [June 22, 2007]:
Note that Pierre's "new" FastMM (and thus the D2006/2007 MM) reuses memory blocks more aggressively than the old MM, so you may be false positives from my function if the instance pointer has been freed and just happens to be reallocated by a different object instance (of potentially a different object type).

As always, use this hack with care and a grain of salt or two.