TClass-Objkete einer Anwendung auflisten

[olee]

Hi,

Ich habe eine Frage, die mich schon seit Langem brennend interessiert:

Ist es irgendwie möglich alle verwendeten Klassen einer Anwendungaufzulisten?

Es gibt ja für jede Klasse in Delphi ein zugehöriges TClass-Objekt.

Und genau diese TClass-Objekte würde ich gerne auflisten.

Wäre es theoretisch möglich, den Adressraum des Programms, angefangen von einer Basisklasse wie TObjekt, nach dieses
TClass-Objekten zu durchsuchen oder so?

MFG

[himitsu]

Theoretisch ist es möglich, aber es können/werden wohl auch viele falsche Funde auftauchen.

Im Prinzip mußt du nur nach Strukturen suchen, welche "typische" für eine Klasse sind.


[add]

Delphi-Quellcode:

Function MyIsClass(C: TClass; MaxRecursion: Integer = 32): Boolean;
  Var B: Boolean;
    i, i2: Integer;
    PropList: PPropList;
    S: PShortString;
    C2: TClass;

  Label None;

  Begin
    Result := False;
    Try
      If (C = nil) or (Integer(C) and $3 <> 0) Then Goto None;
      {***** vmtSelfPtr *****}
      //If PInteger(C + vmtSelfPtr)^ = C Then Goto None;
      {***** vmtTypeInfo *****}
      //If C.ClassInfo <> nil Then Begin
      //  i := GetPropList(PTypeInfo(C.ClassInfo), PropList);
      //  B := False;
      //  If i > 0 Then
      //    Try
      //      For i := i - 1 downto 0 do
      //        For i2 := 1 to Length(PropList[i].Name) do
      //          If not (PropList[i].Name[i2] in ['a'..'z', 'A'..'Z', '0'..'9', '_']) Then B := True;
      //    Finally
      //      FreeMem(PropList);
      //    End;
      //  If B Then Goto None;
      //End;
      {***** vmtClassName *****}
      S := PShortString(PPointer(Integer(C) + vmtClassName)^);
      If Length(S^) < 1 Then Goto None;
      For i2 := 1 to Length(S^) do
        If not (S^[i2] in ['a'..'z', 'A'..'Z', '0'..'9', '_']) Then Goto None;
      {***** vmtInstanceSize *****}
      If (TClass(C).InstanceSize < 0) or (TClass(C).InstanceSize > 1048576) Then Goto None;
      {***** vmtParent *****}
      If MaxRecursion = 0 Then Goto None;
      S := PShortString(PPointer(Integer(C) + vmtClassName)^);
      Result := (S^{C.ClassName} = 'TObject') or MyIsClass(TClass(C).ClassParent, MaxRecursion - 1);
      None:
    Except
    End;
  End;

Procedure TForm2.Button1Click(Sender: TObject);
  Var C: Integer;
    MBI: MEMORY_BASIC_INFORMATION;
    i: Integer;

  Begin
    Button1.Hide;
    // HInstance entspricht der Startspeicheradresse der EXE im RAM

    // der erste Speicherblock ist irgendwas Anderes
    // (eventuell enthält er die API-Funktionszeiger und globalen Variablen? )
    VirtualQuery(Pointer(HInstance), MBI, SizeOf(MBI));

    // der zweite Speicherblock dürfte die Codesection sein
    VirtualQuery(Pointer(Integer(MBI.BaseAddress) + MBI.RegionSize), MBI, SizeOf(MBI));

    For C := Integer(MBI.BaseAddress) - vmtSelfPtr to Integer(MBI.BaseAddress) + MBI.RegionSize - SizeOf(TClass) do Begin
      If MyIsClass(TClass(C)) Then Memo1.Lines.Add(Format('$%.8d %s', [C, TClass(C).ClassName]));
      If C and $FF = 0 Then Begin
        Caption := IntToStr(Integer(MBI.BaseAddress) + MBI.RegionSize - SizeOf(TClass) - C);
        Application.ProcessMessages;
      End;
    End;
    Caption := 'fertig';
  End;

Benötigt werden für den Test ein TMemo (Memo1) und ein TButton (Button1)

Aber wie schon gesagt, 100% zuverlässig und vorallem schnell ist es nicht gerade.

[olee]

Hm das ist schade.

Ich wollte gerne für meine RUTIS Script-Engine, wo man in der bald erscheinenden neuen Version (*werbung-mach*) Formulare
und Co. erstellen kann, möglichst viele Objekte bereitstellen. Da aber das erstellen eines Controls über dessen ClassName
geht, brauche ich so eine Liste mit alle verfügbaren Controls, die ich momentan manuell erstellen mus T_T.

Trotzdem danke

MFG