Entwickler-Ecke :: Thema anzeigen

MaxiTB - Mo 07.04.03 10:00
Titel: Ich hab mal die Lösung des Problems aufgegabelt.

Aber Vorsicht:

Man beachte die schönen INOFFIZELL und den Assemblercode.
Also nix für Anfänger, nix ist sicher und obs mit D7 geht - weiß ich nicht - ich habs nicht ausprobiert ... mittlerweile habe ich mein Prob schon anders gelöst (MAP/DFM files parsing).

Hier die Antworten aus einem anderen Forum:

Zitat:

Hagen Reddmann - 01:47pm Apr 5, 2003 MEZ (# 1 von 3)

type
TEnumTypeInfoCallback = function(UserData: Pointer; Info: PTypeInfo): Boolean; register; function GetBaseOfCode(Module: hModule; var CodeStart, CodeEnd: PChar): Boolean;
asm // get Codesegment pointers, check if module is a valid PE
PUSH EDI
PUSH ESI
AND EAX,not 3
JZ @@2
CMP Word Ptr [EAX],'ZM';
JNE @@1
MOV ESI,[EAX + 03Ch]
CMP Word Ptr [ESI + EAX],'EP'
JNE @@1
MOV EDI,[EAX + ESI + 014h + 008h]
ADD EAX,[EAX + ESI + 014h + 018h]
ADD EDI,EAX
MOV [EDX],EAX
MOV [ECX],EDI
XOR EAX,EAX
@@1: SETE AL
@@2: POP ESI
POP EDI
end; function EnumTypeInfo(Module: hModule; Callback: TEnumTypeInfoCallback; UserData: Pointer): PTypeInfo;
var
P,E,K,N: PChar;
L: Integer;
begin
Result := nil;
if Assigned(Callback) then
try
if GetBaseOfCode(Module, P, E) then
while P < E do
begin
DWord(P) := DWord(P) and not 3;
K := P + 4;
if (PDWord(P)^ = DWord(K)) and (PByte(K)^ > 0) and (PByte(K)^ < 18) then
// Info.Kind in ValidRange.D6
begin
L := PByte(K + 1)^; // length Info.Name
N := K + 2; // @Info.Name[1]
if (L > 0) and (N^ in ['_', 'a'..'z', 'A'..'Z']) then // valid ident ??
begin
repeat
Inc(N);
Dec(L);
until (L = 0) or not (N^ in ['_', 'a'..'z', 'A'..'Z', '0'..'9']);
if L = 0 then // length and ident valid
if Callback(UserData, Pointer(K)) then
// tell it and if needed abort iteration
begin
Result := Pointer(K);
Exit;
end else K := N;
end;
end;
P := K;
end;
except
end;
end; procedure Test; function MyEnum(Data: Pointer; Info: PTypeInfo): Boolean; register;
// wir suchen nur Klassen abgeleitet von TCustomForm
begin
Result := False;
if (Info.Kind = tkClass) and GetTypeData(Info).ClassType.InheritsFrom(TCustomForm) then
WriteLn( Info.Name );
end; begin
EnumTypeInfo(MainInstance, @MyEnum, nil);
// or with packages
// EnumTypeInfo(GetModuleHandle('vcl50.bpl'), @MyEnum, nil);
end;
Obiger Code nutz die "inoffiziellen" TypeInfo Strukturen des delphi Compilers. Diese werden im implementierenden Modul gespeichert. Mann kann mit obiger Struktur über alle Datentypen iterieren, also auch die Deklarationen von Sets, Enums, ordinale Typen und eben auch Klassen und Interfaces.
Der Trick bei der Geschichte ist das der Compiler ab dem Codestart des Codesegementes, eg. meistens $40000 +$200 +x diese Typeinfos speichert. Normalerweise sind die Typinfo Records aber NICHT untereinander verlinkt. Um denoch ausgehende von einem solchen Record den nächsten Record zu finden wird getrickst, s.o.
Der Code ist getestet mit D3,D4,D5,D6 und sollte auch unter D7 laufen.

ABER VORSICHT ! Wird ohne Packages compiliert und Units/Klassen eingebunden die NICHT benutzt werden so optimiert der Linker diese weg. D.h. in der fertigen Anwendung existieren diese Klassen überhaupt nicht mehr.
Wird mit Packages compiliert so muß mit SysUtils.EnumModules() über alle installierten Packages iteriert werden. In dieser Callback muß dann EnumTypeInfo() für jedes Package aufgerufen werden.

Gruß Hagen

Hagen Reddmann - 01:50pm Apr 5, 2003 MEZ (# 2 von 3)

Ach nochwas. Man kann obige Funktion "austricksen", d.h. einen Record im Codesegement erzeugen der für die Funktion wie ein TypeInfo-Record aussieht. Dadurch liefert die Funktion natürlich falsche Resultate :(( Allerdings ist mir sowas noch nie untergekommen, d.h. es muß schon explizit gecodet werden.
Der Vorteil gegenüber MAP-Files liegt wohl auf der Hand. Keine externen Daten nötig, kein Debugbuild nötig und im Gegensatz zu MAP Dateien wird live das was tatsächlich in der Anwendung eincompiliert wurde ausgewertet. MAP Files sind dagegen weniger rubust, wird neu compiliert und die MAP datei aber nicht ersetzt reagiert das System absolut falsch.

Gruß Hagen

Hagen Reddmann - 02:01pm Apr 5, 2003 MEZ (# 3 von 3)

Falls man mit Callbacks arbeiten möchte die auf Klassen basieren kann man so vorgehen:

// 1. Beispiel Klasse type
TMyEnumClass = class(TObject)
class function Callback(Info: PTypeInfo): Boolean;
end; function TMyEnum.Callback(Info: PTypeInfo): Boolean;
begin
Result := False;
WriteLn( Info.Name );
end; begin
EnumTypeInfo(MainInstance, @TMyEnum.Callback, @TMyEnum);
end; // 2. Beispiel Objectinstance type
TMyEnum = class(TObject)
private
FList: TStringList;
function Callback(Info: PTypeInfo): Boolean;
public
constructor Create;
destructor Destroy; override;
procedure Enum(Module: hInstance);
property List: TStringList read FList;
end; function TMyEnum.Callback(Info: PTypeInfo): Boolean;
begin
Result := False;
FList.AddObject(Info.Name, Info);
end; constructor TMyEnum.Create;
begin
inherited Create;
FList := TStringList.Create;
end; destructor TMyEnum.Destroy;
begin
FreeAndNil(FList);
inherited Destroy;
end; procedure TMyEnum.Enum(Module: hInstance);
begin
EnumTypeInfo(Module, @TMyEnum.Callback, Self);
end; begin
with TMyEnum.Create do
try
Enum(MainInstance);
finally
Free;
end;
end;
usw. usw.

Gruß Hagen

PS: ich arbeite aber in diesem Falle lieber prozedural :)

Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2026 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!