function GetObjectClass(APointer: Pointer): TClass;
{$IFDEF MSWINDOWS}
var
  LMemInfo: TMemoryBasicInformation;

  { Checks whether the given address is a valid address for a VMT entry. }
  function IsValidVMTAddress(APAddress: Pointer): Boolean;
  begin
    { Do some basic pointer checks: Must be dword aligned and beyond 64K }
    if (UIntPtr(APAddress) > 65535) and (UIntPtr(APAddress) and 3 = 0) then
    begin
      { Do we need to recheck the virtual memory? }
      if (UIntPtr(LMemInfo.BaseAddress) > UIntPtr(APAddress)) or ((UIntPtr(LMemInfo.BaseAddress) + NativeUInt(LMemInfo.RegionSize)) < (UIntPtr(APAddress) + SizeOf(Pointer))) then
      begin
        { Get the VM status for the pointer }
        LMemInfo.RegionSize := 0;
        VirtualQuery(APAddress, LMemInfo, SizeOf(LMemInfo));
      end;
      { Check the readability of the memory address }
      Result := (NativeUInt(LMemInfo.RegionSize) >= SizeOf(Pointer)) and (LMemInfo.State = MEM_COMMIT) and
        (LMemInfo.Protect and (PAGE_READONLY or PAGE_READWRITE or PAGE_EXECUTE or PAGE_EXECUTE_READ or PAGE_EXECUTE_READWRITE or PAGE_EXECUTE_WRITECOPY) <> 0) and (LMemInfo.Protect and PAGE_GUARD = 0);
    end
    else
      Result := False;
  end;

{ Returns true if AClassPointer points to a class VMT }
  function InternalIsValidClass(AClassPointer: Pointer; ADepth: Integer = 0): Boolean;
  var
    LParentClassSelfPointer: PPointer;
  begin
    { Check that the self pointer as well as parent class self pointer addresses
      are valid }
    if (ADepth < 1000) and IsValidVMTAddress(Pointer(PByte(AClassPointer) + vmtSelfPtr)) and IsValidVMTAddress(Pointer(PByte(AClassPointer) + vmtParent)) then
    begin
      { Get a pointer to the parent class' self pointer }
      LParentClassSelfPointer := PPointer(PByte(AClassPointer) + vmtParent)^;
      { Check that the self pointer as well as the parent class is valid }
      Result := (PPointer(PByte(AClassPointer) + vmtSelfPtr)^ = AClassPointer) and
        ((LParentClassSelfPointer = nil) or (IsValidVMTAddress(LParentClassSelfPointer) and InternalIsValidClass(LParentClassSelfPointer^, ADepth + 1)));
    end
    else
      Result := False;
  end;

begin
  { Get the class pointer from the (suspected) object }
  Result := TClass(PNativeUInt(APointer)^);
  { No VM info yet }
  LMemInfo.RegionSize := 0;
  { Check the block }
  if not InternalIsValidClass(Pointer(Result), 0) then
    Result := nil;
{$ELSE !MSWINDOWS}
begin
  { Not currently supported under Linux / OS X }
  Result := nil;
{$ENDIF MSWINDOWS}
end;

procedure FreeAndNil(var Obj); inline;
var
  Temp: TObject;
begin
  if GetObjectClass(Pointer(Obj)) <> nil then
  begin
    Temp := TObject(Obj);
    Pointer(Obj) := nil;
    Temp.Free;
  end;
end;