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

← →
Ученик (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]

Игорь Шевченко © (28.08.02 16:49)

В CPU
00457C04 E99FAEFAFF JMP ????

На какой адрес перейдет ?

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

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

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

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

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

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

Вроде, 402AA8 :-)

Проверяешь мои способности в устном счете ? :-)

← →
Ученик (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]

← →
Ученик (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]

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

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

← →
Ученик (2002-08-29 10:10) [59]

← →
Толик (2002-08-29 11:55) [60]

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

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

← →
Ученик (2002-08-29 12:17) [61]

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

← →
Толик (2002-08-29 12:58) [62]

для проверки абстрактности 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++

← →
Ученик (2002-08-29 13:18) [63]

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

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

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

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

asm
mov i, vmtoffset TTest.Proc2
end;

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

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

← →
Толик (2002-08-29 13:29) [64]

Да, придётся каждый раз писать
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)();

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

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

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

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

← →
Ученик (2002-08-29 13:47) [66]

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

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

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

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