Announcement

**Hagen Reddmann** · 22.04.2003, 10:38

Teils, wenn deine Abstracten Methoden statische Methoden sind dann gibts keinen Weg (ausser man ruft sie auf und erh�lt eine Exception).
Wenn sie als virtuell/dynamic definiert wurden, was eigentlich die
sinnvollste Anwendung ist, dann geht das. 

Dazu musst du die VMT bzw. DMT durchiterieren und die Adresse des Solts mit der von _AbstractError vergleichen. 

An die Adresse von System._AbstractError kommst Du mit:

<pre>

function AbstractAdress: Pointer;
asm
LEA EAX,System.@AbstractError
end;

</pre>

Gr��tes Problem beim Aufbau der Klassenstruktur ist das die L�nge der VMT nicht bekannt ist. D.h. man kann nicht direkt ermitteln wieviele Slots in der VMT gespeichert sind. Dies ist f�r den Compiler/Linker auch nicht n�tig da im Grunde die VMT/DMT statische/Compilerzeit Records sind. Will man dagegen dynamisch zur Laufzeit die VMT/DMT auswerten dann fehlt halt ein Feld mit der L�nge der VMT in der Klassen Struktur. 
Ich habe mir so beholfen: Die Klassenstruktur enth�lt VOR und NACH der VMT noch andere Informationen. Man kann nun die L�nge der VMT berechnen indem man die nachfoldende Adresse der anderen Strukturen berechnet. Die Differenz / 4 Bytes ergibt dann die Anzahl der Slots in der VMT. 

Gru� Hage

**MaxiTB** · 22.04.2003, 11:17

Das war aber ruckzuck ...

Nop - ich wu�te erstmals gar nicht, da� statische Methoden abstract sein k�nnen ... wenn schon, sowas kommt nicht vor.

1) Wie iteriere ich eben beide am besten durch (ich bin von einer Null-Terminierung ausgegangen ...).

2) *jetzt langsam �berhaupt keinen Durchblick mehr bei Pascal-Pointer hab und mir ein nettes C++ w�nsch* *g

**MaxiTB** · 22.04.2003, 11:28

Im Moment hab ichs mal gerade so ...

function ContainsAbstractMethods(AClass: TObject): boolean;

function nAbstractErrorAddress: Pointer;
begin
asm LEA EAX,System.@AbstractError
end;

function nVmtStart(AClass: TObject): Pointer;
begin

Result:=Pointer(Cardinal(AClass)-76);

end;

function nVmtCount(AClass: TObject): integer;
begin
Result:=0;
end;

function nDmtStart(AClass: TObject): Pointer;
begin
Result:=Pointer(Carinal(AClass)-48);
end;

function nDmtCount(AClass: TObject): integer;
begin

end;

var
lVmt: Pointer;
lDmt: Pointer;
lIndex: integer;
begin

Result:=false;

lVmt:=nVmtStart(AClass);

for lIndex:=0 to nVmtCount(AClass) do
if Pointer(Integer(lVmt)+(lIndex shl 2))=nAbstractErrorAddress then
then
begin
Result:=true;
exit;
end;

lDmt:=nDmtStart(AClass);

for lIndex:=0 to nDmtCount(AClass) do
if Pointer(Integer(lDmt)+(lIndex shl 2))=nAbstractErrorAddress then
then
begin
Result:=true;
exit;
end;

end;

Allerdings hab ich noch keine Ahnung, wie ich die Anzahl jetzt rausbekommen ... wie legt der Compiler jetzt die Daten eigentlich ab ? Nach der Offset-Reihenfolge

**MaxiTB** · 22.04.2003, 11:29

Fesch ... jetzt ist die ganze Formatierung im Sepp ! *ggg

**Hagen Reddmann** · 23.04.2003, 16:21

Ok, lange theoretische Rede -> wenig Durchblick, kurzer Source -> ah Effekt. 

<pre>

<code>function VMTSlotCount(AClass: TClass): Integer;
// calculate VMT Slot Count
var
P,E: PDWord;
C,M: DWord;
begin
C := DWord(AClass);
PChar(P) := PChar(AClass) + vmtSelfPtr;
PChar(E) := PChar(AClass) + vmtClassName;
M := E^;
if P^ = C then // sanity check
while PChar(P) < PChar(E) do
begin
Inc(P);
if (P^ >= C) and (P^ < M) then M := P^;
end;
Result := (M - C) div 4;
end;
 
function IsAbstract(Addr: Pointer): Boolean;
// TRUE is Addr points to _AbstractError
asm
CMP EAX,OFFSET System.@AbstractError // Addr == _AbstractError ??
JE @@1 // yes, jump to @@1
CMP Byte Ptr [EAX],0E9h // PByte(EAX)^ == $E9 ?? -> $E9 = JMP OpCode
JNE @@1 // no, jump to @@1
ADD EAX,[EAX +1] // load absolute address, from relative JMP
ADD EAX,5
CMP EAX,OFFSET System.@AbstractError // PPointer(Addr +1)^ + 5 == _AbstractError ??
@@1: SETE AL // set AL dependend
end;
 
function HasAbstracts(ClassType: TClass; CheckInherits: Boolean = True): Boolean;
type
PPointer = ^Pointer;
PDMT = ^TDMT;
TDMT = packed record
Count: Word;
Slots: array[0..0] of Word;
end;
 
var
VMT: PPointer;
DMT: PDMT;
I: Integer;
begin
Result := ClassType <> nil;
if not Result then Exit;
// call inherited Class first
if CheckInherits and HasAbstracts(ClassType.ClassParent) then Exit;
 
// walk VMT, virtual Method Table
VMT := Pointer(ClassType);
for I := 0 to VMTSlotCount(ClassType) -1 do
if IsAbstract(VMT^) then Exit
else Inc(VMT);
 
// walk DMT, dynamic Method Table
DMT := PPointer(PChar(ClassType) + vmtDynamicTable)^;
if DMT <> nil then
begin
// skip to Method Table, VMT points right after the DMT Slot Table to the Address Table of DMT
PChar(VMT) := PChar(DMT) + DMT.Count * SizeOf(Word) + SizeOf(Word);
for I := 0 to DMT.Count -1 do
if IsAbstract(VMT^) then Exit
else Inc(VMT);
end;
Result := False;
end;
 
type
TTest = class(TObject)
procedure XYZ; dynamic; abstract;
procedure YZX; dynamic; abstract; // change to virtual; dynamic; to see different results on
end; // how VMT's are shared between classes, instead of DMT's
 
TTest1 = class(TTest)
procedure Test1; virtual;
procedure Test2; dynamic;
end;
 
procedure TTest1.Test1;
begin
end;
 
procedure TTest1.Test2;
begin
end;
 
 
procedure VMT;
begin
 
WriteLn( HasAbstracts(TTest1) );
WriteLn( HasAbstracts(TTest1, False) );
 
WriteLn( IsAbstract(@TTest.XYZ) );
end;

</code></pre>

Gru� Hage

**MaxiTB** · 23.04.2003, 16:25

<pre>
Habs schon selbst hingebuxt ... trotzdem Danke *g*

uses
System;

type
TDynamicAddressList = array[0..MaxInt div 16] of Pointer;
PDynamicAddressList = ^TDynamicAddressList;

function ContainsAbstractMethods(AClass: TClass): boolean;

function nAbstractErrorAddress: Pointer; assembler;
asm
LEA EAX, System.@AbstractError
end;

function nGetVirtualMethodCount(AClass: TClass): integer;
var
lBeginVmt: longint;
lEndVmt: longint;
lTablePointer: longint;
lIndex: integer;
begin
lBeginVmt := longint(AClass);

lEndVmt := PLongint(longint(AClass) + vmtClassName)^;
lIndex := vmtSelfPtr + SizeOf(Pointer);
repeat
lTablePointer := PLongint(longint(AClass) + lIndex)^;
if (lTablePointer <> 0) and (lTablePointer >= lBeginVmt) and
(lTablePointer < lEndVmt) then
lEndVmt := longint(lTablePointer);
Inc(lIndex, SizeOf(Pointer));
until lIndex >= vmtClassName;

Result := (lEndVmt - lBeginVmt) div SizeOf(Pointer);
end;

function nGetVirtualMethod(AClass: TClass; const AIndex: integer): Pointer;
begin
Result := PPointer(integer(AClass) + AIndex * SizeOf(Pointer))^;
end;

function nGetDynamicMethodCount(AClass: TClass): integer; assembler;
asm
MOV EAX, [EAX].vmtDynamicTable
TEST EAX, EAX
JE @@Exit
MOVZX EAX, WORD PTR [EAX]
@@Exit:
end;

function nGetDynamicAddressList(AClass: TClass): PDynamicAddressList; assembler;
asm
MOV EAX, [EAX].vmtDynamicTable
MOVZX EDX, Word ptr [EAX]
ADD EAX, EDX
ADD EAX, EDX
ADD EAX, 2
end;

var
lIndex: integer;
lCount: integer;
lDynTbl: PDynamicAddressList;
begin
Result := true;
for lIndex := 0 to nGetVirtualMethodCount(AClass) - 1 do
if nGetVirtualMethod(AClass, lIndex) = nAbstractErrorAddress then
exit;

lCount := nGetDynamicMethodCount(AClass);
if lCount > 0 then
begin
lDynTbl := nGetDynamicAddressList(AClass);
if lDynTbl <> nil then
for lIndex := 0 to lCount - 1 do
if lDynTbl[lIndex] = nAbstractErrorAddress then
exit;

end;
Result := false;
end;
</pre&gt

**Hagen Reddmann** · 23.04.2003, 16:30

Nachtrag: hier noch eine Function die die Klasse ermittelt in der die erste abstracte Methode deklariert wurde. Sie geht Top-Down vor, heist von der aktuellen Klasse aus zu deren Vorfahrklassen. 

<pre>

<code>function ClassOfIntroduceAbstracts(ClassType: TClass): TClass;
begin
Result := ClassType;
while Result <> nil do
if HasAbstracts(Result, False) then Exit
else Result := Result.ClassParent;
end;

</code></pre>

Gru� Hage

**Hagen Reddmann** · 23.04.2003, 16:38

Wichtig bei nGetVirtualMethodCount() ist das die einzelnen Pointer der Klassen Struktur NICHT in sortierter Reihenfolge vorliegen. Allerdings, so wie ich deinen Source lese, scheinst du schon einen MinMax Algo zu nutzen

) 

Wie lange haste denn gebraucht um den Code zu implementieren ?? 
Geh�rt schon einiges an Insight dazu um das fertig zu bringen. 
Meinen obigen Source habe ich gerade in den letzten 20 Minuten geschrieben, allerdings wusste ich auch wie die Klassen arbeiten

�brigens, schau dir mal IsAbstract() an !! 
Damit kannst du n�mlich auch isAbstract(@TTest.XYZ) benutzen. Der Compiler legt f�r solche Derefernezierungen eine virtuellen/dynamischen Methode die Abstract deklariert wurden ein Jump Tabelle an !! Warum er dies macht ist mit aber nicht ganz klar, einzigster Grund k�nnte sein das es ja Klassen-Methoden/Object-Methoden Derefenzierungen sind, und der Self-Pointer in EAX ber�cksichtigt werden mu�. Allerdngs ben�tigt _AbstractError kein Self in EAX !! 

Zus�tzlich musst du noch eines beachten: Wird eine dynamische abstrakte Methode deklariert, so taucht die NUR in der DMT der deklariernende Klasse auf. D.h. da dein Code nicht rekursiv die Parent Klassen untersucht, k�nnten dir solche dynamischen abstrakten Methoden durch die Lappen gehen. D.h. z.B. bei TTest1 und TTest mit nur dynamischen abstrakten Methoden, w�rde TTest1 als abstrakt-los ermittelt. 

Gru� Hage

**Hagen Reddmann** · 23.04.2003, 17:02

Ok, alles l�sst sich sch�ner machen, hier meine endg�ltigen Funktionen 

Gru� Hagen 

<pre>

<code>function IsAbstract(Addr: Pointer): Boolean;
// TRUE is Addr points to _AbstractError
asm
CMP EAX,OFFSET System.@AbstractError // Addr == _AbstractError ??
JE @@1 // yes, jump to @@1
CMP Byte Ptr [EAX],0E9h // PByte(EAX)^ == $E9 ?? -> $E9 = JMP OpCode
JNE @@1 // no, jump to @@1
ADD EAX,[EAX +1] // load absolute address, from relative JMP
ADD EAX,5
CMP EAX,OFFSET System.@AbstractError // PPointer(Addr +1)^ + 5 == _AbstractError ??
@@1: SETE AL // set AL dependend
end;
 
function HasAbstracts(ClassType: TClass; CheckInherits: Boolean = True): Boolean;
 
type
PPointer = ^Pointer;
 
function VMTSlotCount(AClass: TClass): Integer;
// calculate VMT Slot Count
var
P,E: PDWord;
C,M: DWord;
begin
C := DWord(AClass);
PChar(P) := PChar(AClass) + vmtSelfPtr;
PChar(E) := PChar(AClass) + vmtClassName;
M := E^;
if P^ = C then // sanity check
while PChar(P) < PChar(E) do
begin
Inc(P);
if (P^ >= C) and (P^ < M) then M := P^;
end;
Result := (M - C) div 4;
end;
 
function VMT(ClassType: TClass): Pointer;
// get VMT
begin
Result := ClassType;
end;
 
function DMTSlotCount(ClassType: TClass): Integer;
// get DMT slot count
var
D: PWord;
begin
D := PPointer(PChar(ClassType) + vmtDynamicTable)^;
if D <> nil then Result := D^ else Result := 0;
end;
 
function DMT(ClassType: TClass): Pointer;
// get DMT method table
begin
Result := PPointer(PChar(ClassType) + vmtDynamicTable)^;
if Result <> nil then
Result := PChar(Result) + PWord(Result)^ * SizeOf(Word) + SizeOf(Word);
end;
 
function Walk(MT: PPointer; Count: Integer): Boolean;
// walk trough Method Table
begin
Result := False;
while not Result and (Count > 0) do
begin
Result := IsAbstract(MT^);
Inc(MT);
Dec(Count);
end;
end;
 
 
begin
Result := (ClassType <> nil) and
((CheckInherits and HasAbstracts(ClassType.ClassParent)) or
Walk(VMT(ClassType), VMTSlotCount(ClassType)) or
Walk(DMT(ClassType), DMTSlotCount(ClassType)));
end;
 
function ClassOfIntroduceAbstracts(ClassType: TClass): TClass;
begin
Result := ClassType;
while Result <> nil do
if HasAbstracts(Result, False) then Exit
else Result := Result.ClassParent;
end;

</code></pre&gt

**Hagen Reddmann** · 23.04.2003, 17:08

Nop - ich wu�te erstmals gar nicht, da� statische Methoden abstract sein k�nnen ... wenn schon, sowas kommt nicht vor. 

Und ich wusste nicht das das in den neueren Delphi Versionen ge�ndert wurden ist. Nunmehr m�ssen abstrakte Methoden immer dynamisch oder virtuell sein. Fr�herer Pascal Versionen lie�en auch statische zu

Gru� Hage

**MaxiTB** · 24.04.2003, 08:23

Wow - das ist ja eine Menge, was sich da angesammelt hat ... ich h�tte nicht sooo schnell Feierabend machen sollen.
 
Erstens mals hab ich mir viel von meinem Code geborgt (also assimiliert) und zwar von der Jedi Code Library (JCL). Ich hoffe, die Jungs und M�dls killen mich nicht daf�r ;-).
 
Zweitens die Implementierungszeit: zirka 10 Minuten inkl. Test - aber okay, war ja simple mit Copy & Paste. Hab mich dann noch ein bisserl reingelesen und mir auf den Kopf gehauen, da� ich nicht selber drauf gekommen bin ... sobald man mal die Offsets wei� und die prinzipielle Struktur, schon ist der Rest ziemlich einfach. *g*
 
Drittens war mir das mit der DMT war mir schon klar - naja - wie dem auch sei, dynamische Methoden sind sowieso nur Beipack; also wenn die schon jemand verwendet (sind ja angeblich ein Relikt aus BP7, wo die VMT noch im Datensegment war ... und da war damals jedes Byte wertvoll *g*), Pech gehabt. *eg*
 
Viertens, macht doch nix mit dem statisch - abwarten auf .NET, da gehts dann wieder. *ggg*
 
F�nftens und Danke nochmals f�r den Code ! Ich schau mir den jetzt durch und gr�bble ein bisserl dr�ber ... nebenbei esse ich noch meinen M�ller Milchreis Zimt (made in Germany *g*) und hoffe, ich habe jetzt dann absoluten Durchblick in Sachen VMT/DMT. ;-

**Hagen Reddmann** · 24.04.2003, 15:56

Drittens war mir das mit der DMT war mir schon klar - naja - wie dem auch sei, dynamische Methoden sind sowieso nur Beipack; also wenn die schon jemand verwendet (sind ja angeblich ein Relikt aus BP7, wo die VMT noch im Datensegment war ... und da war damals jedes Byte wertvoll *g*), 

Oh, diese Annahme ist schlichtweg falsch. Es ist sogar umgekeht, dynamische Methoden sind wichtiger als virtuelle, nur sieht man das als Delphicoder nicht sofort. 
Es gibt n�mlich statische, virtuelle, als dynmisch deklarierte UND autom. durch den Compiler referenzierte dynamische Methoden die als message deklariert wurden. D.h. Methoden die als message deklariert sind sind tats�chlich dynmaische Methoden mit vorgebener Slot ID. Diese ID identifiziert den Solt in der DMT und ist gleichbedeutend mit der Messagekonstante, z.B. wm_Paint. 

Die wenigsten wissen das man bei einer dynamischen Methode die Slot ID angeben kann, also 

<pre>

type
TMyObject = class(TObject)
procedure XYZ; dynamic 1234; -> // dynamic wm_Paint; --> message wm_Paint;
end; 

</pre>

D.h. so wie TControls mit Messages umgehen kann, kann jede beliebige Klasse mit Messages umgehen, also z.B. auch TFont k�nnte "Messages" dispatchen. 

Damit sind dynamische Methoden sehr sehr effizient, da man diese mit allen Klassen benutzen kann, egal ob die spezifische Klasse diese dynamische Methode implementiert oder eben NICHT. 

Im Gegensatz dazu mu� der Designer bei virtuellen Methoden von Anfang an die virtuellen Methoden "durchdenken". Bei solchen dynamsichen Methoden sollte NUR die zuk�nftige Parameterliste feststehen (z.B. var Message: Tmeasseg); und die ID's. 

Die ID einer dynamischen Methode kann maximal $FFFF sein, es k�nnen in einer Klasse also maximal 65535 dynamsiche Methoden deklariert werden. ABER, w�rde man das per virtuellen Methoden simmulieren wollen so m�ssten wir alle 65535 m�glichen Methoden im vorhinein deklarieren. Es entst�nde eine Monsterklasse die 65535 * 4 Bytes an VMT ben�tigte. Trotzdem w�rde nur ein Bruchteil dieser Methoden tats�chlich benutzt, eg. durchimplementiert. Der Rest w�re ein m�glicher �berhang. Nun dynamische Methoden speichern NUR die durchimplemenierten Slots. Wird versucht eine nicht durchimplementierte Methode aufzurufen, so wird als erstes in der Vorg�ngerklasse danach gesucht, bis hinab zu TObject. Wird KEINE Methode mit dem entsprechenen Slot gefunden, so wird TObject.DefaultHandler() aufgerufen. Und nun passierts: wir k�nnen Defaulthandler() �berschreiben und �ber diesen unsere Funktionalit�t NACHTR�GLICH impelemntieren OHNE das wir eine dynamsiche Methode mit dem entsprechenden Slot gecodet haben.!! 
Dynmische Methoden sind extrem flexibler, habe aber ihren Preis. Das Aufrufen, Raussuchen der Methode zum Slot, ben�tigt viel mehr zeit als z.B. das direkte Anspringen bei statischen, bzw. indirekte Aufrufen bei virtuellen Methoden. 

Ein gutes Anwendungsbeispiel sind meine TNodes. TNode sind so �hnlich wie die beim TTreeView, allerdings effizienter. Sie k�nnen also Datenb�ume representiern. Nun der Unterschied zu z.B. TTreeView-Nodes ist das bei meinen TNodes diese auch Messages-Dynamic-Methoden haben. �ber diese Methoden managen die TNodes nicht nur die enthaltenen Daten sondern auch die Darstellung/Bearbeitung usw. D.h. das anzeigenden Control setzt diese Messages an den TNode Baum ab, und die einzelne TNode stellt sich im Control selber dar, editiert sich selber usw. Dadurch kann in einem solchen Baum verschiedene TNode Klassen eingef�gt werden und jede stellt sich abh�ngig von dessen individueller Implementation anders dar. Das anzeigende, �bergeordnete Control mu� demzufolge NICHT umprogrammiert werden, sondern die Nodes "konfigurieren" es selber. Es wurde also die Datenverwaltung und Speicherung mit der Datenrepr�sentation in einem Object = TNode integriert. 

Gru� Hage

**MaxiTB** · 24.04.2003, 16:50

Oki - jetzt hast du mich in den Boden argumentiert, alter Knabe. *g*
Und was mich noch mehr �rgert ist die Tatsache, da� alle Message-Handler durch den Rost fallen - obs wichtig ist ? Ich wei� es gerade nicht und das �rgert mich noch mehr. *gerade f�rchterlich �rgerlich sei*
Aber Wurscht - das Grundprinzip mit den dynamischen kannte ich, nur das mit dem Messaging hab ich wohl �berlesen - wieder mal schlauer geworden ;-).
TNX �hm - f�r diesen Megavortrag ! *zwinker

**Hagen Reddmann** · 25.04.2003, 03:51

Megavortrag, yes ist'ne Schw�che von mir. Ich denke, bzw. hoffe,das noch mehr User die Posting lesen, und man lernt bekanntlioch nie aus

)

Gru� Hage

Announcement

Abstrakte Methoden identifizieren ...

Abstrakte Methoden identifizieren ...

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment