Хак №6: Проверка допустимости объектного указателя

Это перевод Hack #6:Checking for a valid object instance. Автор: Hallvard Vassbotn.

Я только что ответил на вопрос в newsgroup, просто делая copy-and-paste своего старого поста. Повторное использование является благим делом, так что я решил поместить это ещё и в свой блог. Вот этот пост: "Просто забавы ради я сделал несколько подпрограмм, которые проверяют, является ли указатель ссылкой на допустимый объект (экземпляр класса). Этот код основывается на некоторых типах и подпрограммах из книги Ray Lischner-а "Secrets of Delphi 2" (модуль S_VMT). Заметьте, что этот код привязан к D3. Для других версий Delphi могут потребоваться изменения.

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;

Надо полагать, что этот способ не пуленепробиваем, но должен работать во многих случаях. Он работает, проверяя допустимость указателя, используя функцию IsBadReadPtr, затем проверяет что VMT-указатель для данного предполагаемого объекта корректен. Использование этого кода не рекомендуется - вместо этого используйте установку указателей в nil после удаления объекта".

Обновление: я нашёл другой старый пост с более простым (и, вероятно, более безопасным) способом проверки:

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;

Заметьте, что этот вариант кода написан для D6 и D7 (IIRC). Для других версий вам может понадобится обновить жёстко зашитое волшебное число (17).

Обновление: заметьте, что "новый" FastMM Pierre-а (а, следовательно, и менеджер памяти в D2006 и выше) более агрессивно повторно использует память, чем старый менеджер памяти, так что бы более вероятно можете получить ложно-положительный ответ от этого кода, особенно если память объекта была освобождена, а затем повторно использована для другого объекта (потенциально: другого типа).

Как обычно: используйте этот хак с осторожностью и недоверием.