Finden aller Klassen zur Laufzeit

[tgvoelker]

Code:

  procedure EnumForms;
  var pAddr:Cardinal;
      pPC:^Cardinal;
      pPS:^ShortString;
      pS,pCN:ShortString;
      pClass:TClass;
      pExcept,pB:Boolean;
  Begin
//nächste Zeile bereitet die Listen vor, zu denen später hinzugefügt wird
    SetUpLists;
    pExcept:=False;
    pAddr:=Cardinal(TObject)+vmtSelfPtr;
    while not pExcept do Begin
      try
        pPC:=Pointer(pAddr);
        if pPC^<>(pAddr-vmtSelfPtr) then Begin Inc(pAddr,4);Continue; End;
        pPC:=Pointer(pAddr-vmtSelfPtr+vmtClassName);
        try
          pPS:=Pointer(pPC^);
        except
          pExcept:=True;
          Continue;
        end;
        try
          pS:=pPS^;
          pClass:=Pointer(pAddr-vmtSelfPtr);
          pCN:=pClass.ClassName;
          pB:=pClass.InheritsFrom(TObject);
        except
          Inc(pAddr,4);
          Continue;
        end;
        if (pCN=pS)and(pB) then Begin
//hier prüfe ich auf Forms und füge die zu best. Listen hinzu. Der Part ist also variabel
          if pClass.InheritsFrom(TForm) And (pClass<>TForm) And (pClass<>TReferenceForm) then Begin
            if pClass.InheritsFrom(TReferenceForm) then PRefFormList.Add(pClass.ClassName);
            PFormList.AddObject(pClass.ClassName,TFormListDesc.Create(TFormClass(pClass)));
          End;
//Ende Prüfung
          pAddr:=Cardinal(pPS)+Length(pS)+1;
          if pAddr mod 4>0 Then pAddr:=((pAddr shr 2) shl 2)+4;
        End Else Inc(pAddr,4);
      except
        pExcept:=True;
      end;
    End;
  End;