Entwickler-Ecke

Delphi Language (Object-Pascal) / CLX - Abtrakte Methoden identifizieren


MaxiTB - Di 22.04.03 11:36
Titel: Abtrakte Methoden identifizieren
Grüße !

Ich hab mal wieder was gefinkeltes (diesesmal aber ziemlich simple eigentlich - nur irgendwie hab ich gerade ein Kopf vor dem Brett ... ähm ... oder so).

Ich bräuchte eine Methode:

Quelltext 
1:
 
function ContainsAbstractMethods(AClass: TObject): boolean


Diese sollte mir einfach True zurückgeben, wenn eine oder mehrere abstrakten Methoden zur Laufzeit vorhanden sind.

Hab schon ein paar Versuche mit der VMT probiert, allerdings war das konstruktivste ein schöner Blue-Screen. *g*

Hat da jemand eine Idee ?


AndyB - Di 22.04.03 16:29
Mit der VMT geht das schon recht schwierig. Aber mit Hilfe der [url=http://www.sf.net/projects/jcl]Jedi Code Library[/url] wird es zu Kinderspiel. Man muss nur die Adresse der System-internen Prozedur _AbstractError ermitteln und kann dann die VMT und DMT Einträge vergleichen.


Quelltext 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
 
uses JclSysUtils;


type
  TAbstractClass = class(TObject)
    procedure AbstractMethod; virtual; abstract;
  end;

function IsAbstractClass(AClass: TClass): Boolean;
var
  AbstractError: Pointer;
  i, Count: Integer;
  dynTbl: PDynamicAddressList;
begin
  i := GetVirtualMethodCount(TAbstractClass) - 1;
  AbstractError := GetVirtualMethod(TAbstractClass, i);

  Result := True;
 // virtual method table
  for i := 0 to GetVirtualMethodCount(AClass) - 1 do
    if GetVirtualMethod(AClass, i) = AbstractError then Exit;

 // dynamic method table
  Count := GetDynamicMethodCount(AClass);
  if Count > 0 then
  begin
    dynTbl := GetDynamicAddressList(AClass);
    if dynTbl <> nil then
      for i := 0 to Count - 1 do
        if dynTbl^[i] = AbstractError then Exit;
  end;

  Result := False;
end;


MaxiTB - Mi 23.04.03 13:49
Titel: Danke schön !
Hier der Code für alle, die wissen wollen was im Hintergrund abläuft (aus der JCL):


Quelltext 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
 
{$IFDEF VER150} uses System; {$ENDIF}

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;


AndyB - Mi 23.04.03 22:37
Titel: Re: Danke schön !
MaxiTB hat folgendes geschrieben:

Quelltext 
1:
2:
 
uses
  System;

Das ist nie nötig, und führt sogar zu einer Fehlermeldung, da die System-Unit vom Compiler bereits eingefügt wird. :wink:


MaxiTB - Do 24.04.03 09:03
Titel: Also bei mir ...
... gehts (D7 Enterprise). Nix Fehlermeldung, nix nix gehen. :wink:

Obs unnötig ist, okay, darüber kann man streiten. *lol*


AndyB - Do 24.04.03 16:13
Dann habe die da was geändert.
Delphi 6: Bezeichner redefiniert: 'System'


MaxiTB - Do 24.04.03 16:32
Wurscht.

Daran wirds bei keinem Scheitern :wink: !
Besser so ?


Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!