Абстрактные виртуальные методы

← →
Ученик (2002-08-28 13:21) [0]

Как определить, что абстрактный метод не реализован в наследнике ?

← →
Skier (2002-08-28 13:23) [1]

>Ученик
Вызвать и получить AV (Abstract Error)

← →
Ученик (2002-08-28 13:25) [2]

А проверить перед вызовом ?

← →
murza (2002-08-28 13:26) [3]

Что значит "наследник"? Экземпляр или тип. Я не совсем понимаю, как создать экземпляр абстрактного класса. А про тип тебе и на стадии разработки все известно.

← →
Skier (2002-08-28 13:27) [4]

>Ученик
Ну...засунь вызов в try-except-end и всё...
И напиши функцию.

← →
Ученик (2002-08-28 13:34) [5]

Маленький тестовый пример

type
TA = class
procedure A; virtual; abstract;
end;

TB = class(TA);

TAClass = class of TA;

procedure TForm1.Button1Click(Sender: TObject);
var
A : TAClass;
B : TA;
begin
A := TB;
B := A.Create;
try
B.A
finally
B.Free
end
end;

В try except это как-то неправильно

← →
Skier (2002-08-28 13:36) [6]

>Ученик

> В try except это как-то неправильно

Но чудес-то не бывает ?

← →
Ученик (2002-08-28 13:42) [7]

Skier © (28.08.02 13:36)
В данном случае это наверно не так, так как метод виртуальный

← →
Skier (2002-08-28 13:43) [8]

>Ученик
Имеешь ввиду VMT ?

← →
Ученик (2002-08-28 13:46) [9]

>Skier © (28.08.02 13:43)
Да, но решения пока нет

← →
Сиарый паскалист (2002-08-28 13:53) [10]

Копаясь в VMT, я заметил, что все абстрактные методы представлены в VMT одним и тем же указателем.
Соответственно, если знаешь индекс метода в VMT - то проверить на абстрактность элементарно.

← →
Игорь Шевченко (2002-08-28 13:54) [11]

Вопрос сам по себе некорректен, IMHO.

← →
Ученик (2002-08-28 13:55) [12]

>Сиарый паскалист (28.08.02 13:53)
А как его узнать ?

← →
Ученик (2002-08-28 13:55) [13]

>Игорь Шевченко © (28.08.02 13:54)
Почему ?

← →
Ученик (2002-08-28 13:57) [14]

>Сиарый паскалист (28.08.02 13:53)
Имеется ввиду индекс

← →
Skier (2002-08-28 13:57) [15]

>Ученик

> Почему ?

А какая цель у всего этого ? Просто исследование ??

← →
Ученик (2002-08-28 13:58) [16]

>Skier © (28.08.02 13:57)
Не, цель практическая, т.е. не спортивная

← →
Skier (2002-08-28 13:59) [17]

>Ученик
Какая именно ?

← →
Ученик (2002-08-28 14:04) [18]

Skier © (28.08.02 13:59)
В двух словах, не все компоненты, работающие с базами данных поддерживают и таблицы и запросы, поэтому некоторые методы остаются нереализованными

← →
Игорь Шевченко (2002-08-28 14:04) [19]

Потому что, зная абстрактные методы предка, подразумевается, что их надо перекрывать для того, чтобы наследник корректно работал. Или не обращаться к ним.

← →
Skier (2002-08-28 14:05) [20]

>Ученик
Извини, но...туманно.

← →
Сиарый паскалист (2002-08-28 14:05) [21]

Ученик ©
Хотя вроде можно обойтись и без индекса - через TMethod.Code.
(Если просто брать @TSomeClass.AbstractMethod - он даст что-то другое (для неабстрактных методов обе величины совпадают)).

← →
MBo (2002-08-28 14:07) [22]

http://216.101.185.148/scripts/isapi.dll/article?id=6895378A&article=1575549

← →
Ученик (2002-08-28 14:15) [23]

>MBo © (28.08.02 14:07)
Большое спасибо, то что надо, пример я написал не очень удачный,
сразу не заработало, надо было TA = class(TComponent)

← →
Ученик (2002-08-28 14:20) [24]

Для примера все работает, а в реале методы в public, сам конечно виноват, попробую искать адрес в VMT или переделаю в published

← →
Сиарый паскалист (2002-08-28 14:24) [25]

Или так: (если без published методов)
...
TProc = procedure of object;
TTestAbsClass = class
procedure Test; virtual; abstract;
end;

var
AbstractMethodPointer: Pointer;

function IsMethodAbstract(Meth: TMethod): Boolean;

implementation

function IsMethodAbstract(Meth: TMethod): Boolean;
begin
Result := Meth.Code = AbstractMethodPointer;
end;

var
ob: TTestAbsClass;
p: TProc;

initialization

ob := TTestAbsClass.Create;
try
p := ob.Test;
AbstractMethodPointer := TMethod(p).Code;
finally
ob.Free;
end;

end.

← →
Ученик (2002-08-28 14:35) [26]

>Сиарый паскалист (28.08.02 14:24)
А как вызывать IsMethodAbstract ?

← →
Сиарый паскалист (2002-08-28 14:40) [27]

type TYourProc = procedure(...Any Arguments...)of object;
var p: TYourProc;

p := YourObject.MethodThatMayBeAbstract;

if IsMethodAbstract(TMethod(p)) then ...

← →
Ученик (2002-08-28 14:51) [28]

>Сиарый паскалист (28.08.02 14:40)
Спасибо, а можно ли сделать универсальную функцию

function IsMethodAbstract(параметры необходимые для работы функции) : Boolean;
Для каждой описывать "(28.08.02 14:40)", согласитесь, не очень.

← →
Старый паскалист (2002-08-28 15:21) [29]

Сомневаюсь.

← →
vuk (2002-08-28 15:49) [30]

А зачем вообще делать абстрактные методы в данном случае? Не проще ли просто сделать пустые виртуальные медоды? И тогда никаких проблем.

← →
Ученик (2002-08-28 16:06) [31]

>vuk © (28.08.02 15:49)
Все от лени :), по отсутствию перекрытия абстрактных методов можно судить о возможностях того или иного наследника, а так нужно вводить еще что-то дополнительно и для каждого.

Вопрос немного в сторону, как работает команда JMP (точнее как преобразуется в адрес на который перейдет программа) E9AABBCCDD, известен текущий адрес и AABBCCDD ?

← →
vuk (2002-08-28 16:23) [32]

>а так нужно вводить еще что-то дополнительно и для каждого
Честно говоря, я так бы и сделал. Оно надежнее. К примеру можно сделать метод класса, который будет возвращать информацию о том, что может экземпляр данного класса. Еще один вариант узнать о том, что может объект - использовать интерфейсы.

← →
Старый паскалист (2002-08-28 16:46) [33]

>Сиарый паскалист (28.08.02 14:40)
>Спасибо, а можно ли сделать универсальную функцию

Вто есть ещё какой вариант:

uses
VirtMeth;

...

function IsMethodAbstractOrStatic(AClass: TClass; MethodAddr: Pointer): Boolean;
var mp: TMethodPtr;
begin
mp := MethodPtr(AClass, MethodAddr);
Result := mp.MethodType = mtUnknown;
end;

// Пример использования:
// if IsMethodAbstractOrStatic(TYourClass,
// @TYourClass.MethodThatMayBeAbstract) then ...
//
// Основан на том факте, что прямое взятие адреса абстрактного
// метода (НЕ ЧЕРЕЗ TMehod!!!) возвращает значение, которого нет
// в VMT (или в DMT).
// Соответственно, такой метод может быть либо статическим,
// либо абстрактным.
// Если ты точно знаешь, что метод виртуальный(динамический) -
// значит, он абстрактный

{-------------------------------------------------------}
unit VirtMeth;

interface

uses
SysUtils;

type

PPtrArray = ^TPtrArray;
TPtrArray = array[0..MaxInt div 16] of Pointer;
PSmallArray = ^TSmallArray;
TSmallArray = array[0..MaxInt div 16] of SmallInt;

TMethodType = (mtStatic, mtVirtual, mtDynamic, mtUnknown);

PMethodPtr = ^TMethodPtr;
TMethodPtr = record
BaseClass: TClass;
case MethodType: TMethodType of
mtStatic: ( Address: Pointer; );
mtVirtual: ( Index: Integer; );
mtDynamic: ( Selector: SmallInt; );
end;

function MethodPtr(BaseClass: TClass; MethodAddress: Pointer): TMethodPtr;
function ResolveMethod(Instance: TObject; MethPtr: TMethodPtr): TMethod;

function StaticMethod(BaseClass: TClass; MethodAddress: Pointer): TMethodPtr;
function DynamicMethod(BaseClass: TClass; MethodAddress: Pointer): TMethodPtr;
function VirtualMethod(BaseClass: TClass; MethodAddress: Pointer): TMethodPtr;

function VMTLength(VMT: TClass): Integer;

function FirstIntroduction(MethPtr: TMethodPtr): TMethodPtr;

var
vmtAbstract: Pointer;

implementation

type
TAbstractTest = class
procedure Test; virtual; abstract;
end;

function MethodPtr(BaseClass: TClass; MethodAddress: Pointer): TMethodPtr;
begin
Result.MethodType := mtUnknown;
Result := VirtualMethod(BaseClass, MethodAddress);
if Result.MethodType = mtUnknown then
Result := DynamicMethod(BaseClass, MethodAddress);
// if Result.MethodType = mtUnknown then
// Result := StaticMethod(BaseClass, MethodAddress);
end;

function VMTLength(VMT: TClass): Integer;
procedure Nearest(tblOffSet: Integer; var Res: Integer);
var
tblAddr: Integer;
vmtTblEntry: Pointer;
begin
Integer(vmtTblEntry) := Integer(VMT) + tblOffSet;
if Pointer(vmtTblEntry^) <> nil then
begin
tblAddr := Integer(vmtTblEntry^);
if Res > tblAddr-Integer(VMT) then
Res := TblAddr - Integer(VMT);
end;
end;
begin
Result := 1000;
Nearest(vmtIntfTable, Result);
Nearest(vmtAutoTable, Result);
Nearest(vmtInitTable, Result);
Nearest(vmtTypeInfo, Result);
Nearest(vmtFieldTable, Result);
Nearest(vmtMethodTable, Result);
Nearest(vmtDynamicTable,Result);
Nearest(vmtClassName, Result);
Result := Result shr 2;
end;

function AddressToVMTIndex(VMT, MethodAddress: Pointer): Integer;
var i, L: Integer;
begin
Result := -1;
L := VMTLength(TClass(VMT));
i := 0;
while i < L do
begin
if PPtrArray(VMT)^[i] = MethodAddress then
begin
Result := i;
Exit;
end;
Inc(i);
end;
end;

function VMTIndexToAddress(VMT: Pointer; Index: Integer): Pointer;
begin
if (Index > -1) then
Result := PPtrArray(VMT)^[Index] else Result := nil;
end;

function VMTIndexToAddressCheck(VMT: Pointer; Index: Integer): Pointer;
begin
if (Index > -1) and (Index < VMTLength(VMT)) then
Result := PPtrArray(VMT)^[Index] else Result := nil;
end;

← →
Старый паскалист (2002-08-28 16:46) [34]

// продолжение

function AddressToDynSelector(VMT, MethodAddress: Pointer): SmallInt;
var i, L: Integer;
dmt, dmt1, dmt2: Pointer;
begin
Result := 0; // Selectors can be positive (message handlers) and negative (usual dynamic methods)
while VMT <> TObject do
begin
dmt := Pointer(Pointer(Integer(VMT) + vmtDynamicTable)^);
if dmt <> nil then
begin
L := SmallInt(dmt^);
Integer(dmt1) := Integer(dmt) + SizeOf(SmallInt);
Integer(dmt2) := Integer(dmt) + SizeOf(SmallInt) + L*SizeOf(SmallInt);
for i := 0 to L-1 do
if PPtrArray(dmt2)^[i] = MethodAddress then
begin
Result := PSmallArray(dmt1)^[i];
Exit;
end;
end;
VMT := TClass(VMT).ClassParent;
end;
end;

function DynSelectorToAddress(VMT: Pointer; Selector: SmallInt): Pointer;
var i, L: Integer;
dmt, dmt1, dmt2: Pointer;
begin
Result := nil;
if Selector = 0 then Exit;
repeat
dmt := Pointer(Pointer(Integer(VMT) + vmtDynamicTable)^);
if dmt <> nil then
begin
L := SmallInt(dmt^);
Integer(dmt1) := Integer(dmt) + SizeOf(SmallInt);
Integer(dmt2) := Integer(dmt) + SizeOf(SmallInt) + L*SizeOf(SmallInt);
for i := 0 to L-1 do
if PSmallArray(dmt1)^[i] = Selector then
begin
Result := PPtrArray(dmt2)^[i];
Exit;
end;
end;
VMT := TClass(VMT).ClassParent;
until VMT = TObject;
end;

{------------------------------------------------------------------------------}

function StaticMethod(BaseClass: TClass; MethodAddress: Pointer): TMethodPtr;
begin
Result.MethodType := mtStatic;
Result.BaseClass := BaseClass;
Result.Address := MethodAddress;
end;

function VirtualMethod(BaseClass: TClass; MethodAddress: Pointer): TMethodPtr;
begin
Result.MethodType := mtUnknown;
Result.BaseClass := BaseClass;
Result.Index := AddressToVMTIndex(BaseClass, MethodAddress);
if Result.Index > -1 then Result.MethodType := mtVirtual;
end;

function DynamicMethod(BaseClass: TClass; MethodAddress: Pointer): TMethodPtr;
begin
Result.MethodType := mtUnknown;
Result.BaseClass := BaseClass;
Result.Selector := AddressToDynSelector(BaseClass, MethodAddress);
if Result.Selector <> 0 then Result.MethodType := mtDynamic;
end;

function ResolveMethod(Instance: TObject; MethPtr: TMethodPtr): TMethod;
begin
Result.Code := nil;
Result.Data := nil;
if Instance.InheritsFrom(MethPtr.BaseClass) then
begin
Result.Data := Instance;
case MethPtr.MethodType of
mtUnknown: Result.Code := nil;
mtDynamic: Result.Code := DynSelectorToAddress(Instance.ClassType, MethPtr.Selector);
mtVirtual: Result.Code := VMTIndexToAddress(Instance.ClassType, MethPtr.Index);
mtStatic: Result.Code := MethPtr.Address;
end;
end;
end;

{------------------------------------------------------------------------------}

function FirstIntroduction(MethPtr: TMethodPtr): TMethodPtr;
var VMT: TClass;
P: Pointer;
begin
Result := MethPtr;
VMT := MethPtr.BaseClass;
if MethPtr.MethodType = mtStatic then Exit;
repeat
VMT := VMT.ClassParent;
case MethPtr.MethodType of
mtVirtual: P := VMTIndexToAddressCheck(VMT, MethPtr.Index);
mtDynamic: P := DynSelectorToAddress(VMT, MethPtr.Index);
end;
if P = nil then Exit;
Result.BaseClass := VMT;
if P = vmtAbstract then Exit;
until VMT = TObject;
end;

initialization

vmtAbstract := PPtrArray(TAbstractTest)^[0];

finalization

end.

← →
Игорь Шевченко (2002-08-28 16:49) [35]

Вопрос немного в сторону, как работает команда JMP (точнее как преобразуется в адрес на который перейдет программа) E9AABBCCDD, известен текущий адрес и AABBCCDD ?

Адрес команды JMP + ее длина (в данном случае 5) + AABBCCDD

← →
Ученик (2002-08-28 17:08) [36]

>Старый паскалист (28.08.02 16:46)

Супер, я пробовал

type
TA = class(TComponent)
public
procedure A; virtual; abstract;
end;

TB = class(TA)

TAClass = class of TA;

procedure TForm1.Button1Click(Sender: TObject);
var
A : TAClass;
B : TA;
begin
A := TB;
B := A.Create(nil);
try
if IsMethodAbstractOrStatic(B.ClassType, @TA.A) then
ShowMessage("Abstract")
else
B.A
finally
B.Free
end
end;

Это правильно или нет ?

← →
Ученик (2002-08-28 17:16) [37]

← →
Старый паскалист (2002-08-28 17:25) [38]

Вообще говоря, нет.
Второй способ чисто статический,
т.е. он может работать только так
(для класса, известного на стадии компиляции)

if IsMethodAbstractOrStatic(TA, @TA.A {в обоих случаях TA - иначе не будет работать})

Проблема в том, что у динамически определённого класса нельзя взять адрес метода (кроме как через TMethod.Code),
т.е. нельзя написать @(B.ClassType.A).

← →
Игорь Шевченко (2002-08-28 17:32) [39]

← →
Ученик (2002-08-28 17:33) [40]

>Старый паскалист (28.08.02 17:25)

А если добавить в IsMethodAbstractOrStatic еще один параметр, т.е.
function IsMethodAbstractOrStatic (ABaseClass, AClass: TClass; ABaseAbstractMethodAddr: Pointer): Boolean;

то это может помочь ?

Абстрактные виртуальные методы Найти похожие ветки