Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Абстрактные виртуальные методы [D5, D6]

Страницы: < 1 2 3 4 >
Ученик © (2002-08-28 13:21:00)
Как определить, что абстрактный метод не реализован в наследнике ?

Игорь Шевченко (2002-08-28 18:13:00) [21]
Ученик © (28.08.02 17:40)

457С04 + 5 + FFFAAE9F

Толик (2002-08-28 18:02:00) [22]
to Старый паскалист (28.08.02 17:49)
Да, действительно. Флейм длинный получился, сразу всего и не увидишь :)

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

Старый паскалист (2002-08-28 17:49:00) [23]
2Толик ©

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

Толик (2002-08-28 17:43:00) [24]
Мне кажется, что решение данной проблемы гораздо более постое.
Известно, что если ф-я объявлена в классе как 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:41:00) [25]
Весь вопрос, как узнать адрес метода для класса, известного по ссылке. (Адрес базового метода тут не поможет).

Можно, конечно, вернуться к 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:40:00) [26]
>Игорь Шевченко © (28.08.02 17:32)
А как складывали ?

Ученик (2002-08-28 17:33:00) [27]
>Старый паскалист (28.08.02 17:25)

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

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

Игорь Шевченко (2002-08-28 17:32:00) [28]
Ученик © (28.08.02 17:16)

Вроде, 402AA8 :-)

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

Старый паскалист (2002-08-28 17:25:00) [29]
Вообще говоря, нет.
Второй способ чисто статический,
т.е. он может работать только так
(для класса, известного на стадии компиляции)

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

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

Ученик (2002-08-28 17:16:00) [30]
Игорь Шевченко © (28.08.02 16:49)

В CPU
00457C04 E99FAEFAFF JMP ????

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

Ученик (2002-08-28 17:08:00) [31]
>Старый паскалист (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 16:49:00) [32]
Вопрос немного в сторону, как работает команда JMP (точнее как преобразуется в адрес на который перейдет программа) E9AABBCCDD, известен текущий адрес и AABBCCDD ?

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

Старый паскалист (2002-08-28 16:46:00) [33]
// продолжение

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:46:00) [34]
>Сиарый паскалист (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;

vuk (2002-08-28 16:23:00) [35]
>а так нужно вводить еще что-то дополнительно и для каждого
Честно говоря, я так бы и сделал. Оно надежнее. К примеру можно сделать метод класса, который будет возвращать информацию о том, что может экземпляр данного класса. Еще один вариант узнать о том, что может объект - использовать интерфейсы.

Ученик (2002-08-28 16:06:00) [36]
>vuk © (28.08.02 15:49)
Все от лени :), по отсутствию перекрытия абстрактных методов можно судить о возможностях того или иного наследника, а так нужно вводить еще что-то дополнительно и для каждого.

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

vuk (2002-08-28 15:49:00) [37]
А зачем вообще делать абстрактные методы в данном случае? Не проще ли просто сделать пустые виртуальные медоды? И тогда никаких проблем.

Старый паскалист (2002-08-28 15:21:00) [38]
Сомневаюсь.

Ученик (2002-08-28 14:51:00) [39]
>Сиарый паскалист (28.08.02 14:40)
Спасибо, а можно ли сделать универсальную функцию

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

Сиарый паскалист (2002-08-28 14:40:00) [40]
type TYourProc = procedure(...Any Arguments...)of object;
var p: TYourProc;

p := YourObject.MethodThatMayBeAbstract;

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

Страницы: < 1 2 3 4 >

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »