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

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

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

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

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

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

>Игорь Шевченко © (28.08.02 17:32)
А как складывали ?

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

Весь вопрос, как узнать адрес метода для класса, известного по ссылке. (Адрес базового метода тут не поможет).

Можно, конечно, вернуться к published и написать

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

IsMethodAbstractOrStatic(B.ClassType,
B.ClassType.MethodAddress("A") )
// Нужен адрес именно метода A
// класса B.ClassType,а не класса TA

← →
Толик © (2002-08-28 17:43) [43]

Мне кажется, что решение данной проблемы гораздо более постое.
Известно, что если ф-я объявлена в классе как abstract, то в VMT этого класса записывается указатель не на неё, а на ф-ю _AbstractError, объявленную в System.pas.
Для этого надо найти адрес этой ф-и и сравнивать значение в VMT с её адресом: если эти адреса совпадают, то наша ф-я абстрактная. Проблема заключается в том, что у ф-и _AbstractError нельзя взять адрес - это один из приколов Делфей. Но Делфю можно обмануть.
Итак: объявляем тестовый класс с единственной абстрактной ф-ей.
TAbstract = class(TObject) public procedure AbstractProc(); virtual; abstract; end;
Отсюда можно узнать адрес _AbstractError. Он равен pointer(pointer(TAbstract)^)

А далее всё просто: получаем указатель на VMT проверяемого класса и ищем в ней (VMT - таблица, значит она) адреса, равные @_AbstractError. Если есть хоть один такой адрес, значит наш класс содержит абстрактные ф-и.

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

2Толик ©

Такое решение было предложено мной сначала.
Но для этого нужно либо знать индекс метода в VMT, или
действовать через TMethod.Code.

← →
Толик © (2002-08-28 18:02) [45]

to Старый паскалист (28.08.02 17:49)
Да, действительно. Флейм длинный получился, сразу всего и не увидишь :)

Кстати, а может подскажете:
TMyClass public procedure Proc1(); virtual; abstract; end;
что за адрес получится, если написать @TMyClass.Proc1??? Это адрес чего?

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

Ученик © (28.08.02 17:40)

457С04 + 5 + FFFAAE9F

← →
Старый паскалист (2002-08-28 18:19) [47]

Отладчик говорит, что по этому адресу находится

main.pas.14: procedure Test; virtual; abstract;
0043e5e0 jmp @AbstractError
...

Очевидно, заглушка какая-то. В чём её смысл - пока не знаю.

← →
Старый паскалист (2002-08-28 18:23) [48]

В смысле это у меня она называлась Test, у тебя будет Procl

Но эта процедура динамически вызвана быть не может, посколько VMT на неё не ссылается. Он может быть вызвана только статически.

← →
Ученик © (2002-08-28 18:32) [49]

>Игорь Шевченко © (28.08.02 18:13)
Спасибо, т.е все-таки наоборот

← →
Ученик © (2002-08-28 18:54) [50]

Идея :-)

if not AbstractMethod then
B.A

AbstractMethod извлекает адрес метода из следующего за ним кода,
пока не реализовано

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

>Ученик © (28.08.02 18:54)
Тут будет проблема с методами имеющими параметры, похоже все-таки придется объявить в published.

← →
vuk © (2002-08-28 19:39) [52]

Подход называется "мы не ищем легких путей". И все от лени? :o)

← →
Ученик © (2002-08-28 19:49) [53]

>vuk © (28.08.02 19:39)
Да нет, просто наследники расплодились, где-то забудешь вставить, в результате ошибка при выполнении :-), хотелось исправить в одном месте, да видно не судьба,
вот еще хотелось добавлять свойства у компонентов в Run-Time, тоже оказалось не судьба, и кода все больше и больше :)

← →
vuk © (2002-08-28 19:51) [54]

Я ж говорю - интерфейсы могут быть хорошим выходом. Получили объект -> запросили интерфейс -> если поддерживается, то выполняем методы. Заодно и всем объектам не нужно быть наследниками одного класса.

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

>vuk © (28.08.02 19:51)
С интерфейсами придется все методы интерфейсов реализовывать, что тоже не есть хорошо, в любом случае спасибо за совет.

← →
vuk © (2002-08-28 20:04) [56]

>С интерфейсами придется все методы интерфейсов реализовывать
Ну так разбейте методы на логические группы, которые друг без друга значения не имеют... В самом крайнем (тяжелом) случае - один метод на интерфейс. :o)

← →
Ученик © (2002-08-28 20:06) [57]

>vuk © (28.08.02 20:04)
"мы не ищем легких путей". :-), спасибо, чего-нибудь придумается

← →
Толик © (2002-08-29 10:01) [58]

to Ученик ©
А чем неприемлемо то, что предложил Старый паскалист (28.08.02 13:53)??? Ведь всё работает замечательно! Решение было дано через 30 минут после поступления вопроса на форум. Реализацию см. Толик © (28.08.02 17:43)
Любой класс проверяется на наличие абстрактных методов.

to Ученик © (29.08.02 10:10)
Дано:
TTest = class(TObject) public procedure Proc1(); virtual; abstract; procedure Proc2(); virtual; abstract; end;
Задача:
хочется узнать, является ли ф-я Proc2 абстрактной.
Решение:
Объявим несколько дополнительных типов:

//для удобства работы с VMT
TPtrArray = array[0..0]of pointer; PPtrArray = ^TPtrArray;
//для адреса _AbstractError, см. Толик © (28.08.02 17:43)
TAbstract = class(TObject) public procedure Abstr(); virtual; abstract; end;
//а вот и собственно код:
procedure TForm1.Button1Click(Sender: TObject); var ptr: pointer; pptr: PPtrArray absolute ptr; i: byte; begin asm mov i, vmtoffset TTest.Proc2 end; ptr := pointer(TTest); if(pptr^[i shr 2] = pointer(pointer(TAbstract)^))then ShowMessage("абстрактная ф-я!!!"); end;
Несколько коментариев:
mov i, vmtoffset TTest.Proc2 - определяем смещение ф-и Proc2 в VMT (оно в байтах!)
ptr := pointer(TTest); - получаем указатель на VMT класса TTest
pptr^[i shr 2] - указатель, который лежит со смещением в i байт в VMT (pointer - 4 байта, потому и делим на 4)
pointer(pointer(TAbstract)^)) - получаем адрес _AbstractError

Надеюсь, что помог.

>Толик © (29.08.02 11:55)
Классно, большое спасибо, а можно сделать каким-нибудь образом vmtoffset TTest.Proc2 параметром функции, хотелось бы сделать что-то универсальное для проверки абстрактности public методов.

для проверки абстрактности public методов
Не только public-методов, а вообще любых (в т.ч. и private), т.к. в VMT они записываются все подряд без разбора в порядке объявления.
А насчёт сделать ... vmtoffset TTest.Proc2 параметром функции - вот здесь мы подходим к тому моменту, где возможности Делфей заканчиваются.
Можно сделать так (немного перепишем пример выше):
function IsAbstract(const VMT: pointer; const Offset: byte): boolean; begin RESULT := VMT^[Offset shr 2] = pointer(pointer(TAbstract)^)) end; procedure TForm1.Button1Click(Sender: TObject); var pptr: PPtrArray; i: byte; begin asm mov i, vmtoffset TTest.Proc2 end; pptr := pointer(TTest); if(IsAbstract(pptr, i))then ShowMessage("абстрактная ф-я!!!"); end;
Если этого достаточно, то и замечтельно. А вот если захочется по указателю на абстрактную ф-ю вызвать ф-ю из класса-наследника - то это на Делфях уже не реализовать. Придётся переходить на C++

>Толик © (29.08.02 12:58)
>Не только public-методов, а вообще любых (в т.ч. и private), >т.к. в VMT они записываются все подряд без разбора в порядке >объявления.

Имелось ввиду, что проверка будет из других модулей, поэтому и public,

"...можно сделать каким-нибудь образом vmtoffset TTest.Proc2 параметром функции..."

Имелось ввиду, что каждый раз писать

asm
mov i, vmtoffset TTest.Proc2
end;

не очень хотелось бы.

>Придётся переходить на C++
Это плохой вывод :-), еще раз большое спасибо

Да, придётся каждый раз писать
asm
mov i, vmtoffset TTest.Proc2
end;

Это и есть тот предел возможности Делфей, о котором я говорил выше. А насчёт плохого вывода - я бы не был столь категоричен. Например, на С++ поставленная задача решается в ДВЕ строчки кода!!! Если интерестно, то:
//объявляем указатель на АБСТРАКТНУЮ ф-ю abstract_fnc класса TParentAbstractClass и инициализируем его void(TParentAbstractClass::*p_mem_fnc)()const(&TParentAbstractClass::abstract_fnc); //Вызываем ф-ю объекта pChildClass, расположенную в VMT по адресу, записанному в p_mem_fnc (pChildClass->*p_mem_fnc)();

>Толик © (29.08.02 13:29)

>А насчёт плохого вывода - я бы не был столь категоричен
Да, это не категоричность это с улыбкой :-)

>С вызовом как раз проблем нет, функция то виртуальная, просто
B.A

function VmtOffset(P : Integer) : integer;
asm
mov eax, 1
end;

procedure TForm1.Button1Click(Sender: TObject);
var
P : Pointer;
begin
VmtOffset(asm end)
end;

на asm компилятор не ругается, но говорит, что тип не тот, как думаете какой должен быть тип ?

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