GetClass requires a class to be priory registered using RegisterClass function otherwise it will fail.
Below, a sample that uses some undocumented functions to get all classes:
type
TDesignPackages = TObject;
TDesignPackage = TObject;
TIDEDesignPackage = TObject;
TRegModule = TObject;
TRegClass = TObject;
TDesignPackagesGetPackages = function(Obj: TDesignPackages; PackageIndex: Integer): TObject;
TIDEDesignPackageGetCount = function(Obj: TIDEDesignPackage): Integer;
TRegModuleGetCount = function(Obj: TRegModule): Integer;
TIDEDesignPackageGetModules = function(Obj: TIDEDesignPackage; Index: Integer): TRegModule;
TRegModuleGetClasses = function(Obj: TRegModule; Index: Integer): TRegClass;
var
DesignPackagesGetPackages: TDesignPackagesGetPackages;
IDEDesignPackageGetCount: TIDEDesignPackageGetCount;
IDEDesignPackageGetModules: TIDEDesignPackageGetModules;
RegModuleGetCount: TRegModuleGetCount;
RegModuleGetClasses: TRegModuleGetClasses;
function GetClass2(PackageIndex, ComponentIndex: Integer): TClass;
var
Coreide: THandle;
Delphicoreide: THandle;
LGlobalPackagesPtr: Pointer;
LDesignPackages: TDesignPackages;
LIDEDesignPackage: TIDEDesignPackage;
LRegModule: TRegModule;
LRegClass: TRegClass;
LIDEDesignPackageCount: Integer;
LRegModuleCount: Integer;
LIndex: Integer;
I: Integer;
J: Integer;
begin
Result := nil;
{ --- Move me outside --- }
// adapt 260 suffix according to your Delphi version.
Coreide := GetModuleHandle('coreide260.bpl');
Delphicoreide := GetModuleHandle('delphicoreide260.bpl');
LGlobalPackagesPtr := GetProcAddress(Coreide, '@Pakmgr@Packages');
DesignPackagesGetPackages := GetProcAddress(Coreide, '@Pakmgr@TDesignPackages@GetPackages$qqri');
IDEDesignPackageGetCount := GetProcAddress(Delphicoreide, '@Pascpppakmgr@TIDEDesignPackage@GetCount$qqrv');
IDEDesignPackageGetModules := GetProcAddress(Delphicoreide, '@Pascpppakmgr@TIDEDesignPackage@GetModules$qqri');
RegModuleGetCount := GetProcAddress(Coreide, '@Pakmgr@TRegModule@GetCount$qqrv');
RegModuleGetClasses := GetProcAddress(Coreide, '@Pakmgr@TRegModule@GetClasses$qqri');
Assert(Assigned(LGlobalPackagesPtr), 'LGlobalPackagesPtr not assigned');
Assert(Assigned(DesignPackagesGetPackages), 'DesignPackagesGetPackages not assigned');
Assert(Assigned(IDEDesignPackageGetCount), 'IDEDesignPackageGetCount not assigned');
Assert(Assigned(IDEDesignPackageGetModules), 'IDEDesignPackageGetModules not assigned');
Assert(Assigned(RegModuleGetCount), 'RegModuleGetCount not assigned');
Assert(Assigned(RegModuleGetClasses), 'RegModuleGetClasses not assigned');
{ --- End Move outside --- }
if Assigned(LGlobalPackagesPtr) then
begin
LDesignPackages := TObject(PPointer(LGlobalPackagesPtr)^);
LIDEDesignPackage := DesignPackagesGetPackages(LDesignPackages, PackageIndex);
LIDEDesignPackageCount := IDEDesignPackageGetCount(LIDEDesignPackage);
LIndex := 0; // Component Index.
for I := 0 to LIDEDesignPackageCount - 1 do
begin
LRegModule := IDEDesignPackageGetModules(LIDEDesignPackage, I);
LRegModuleCount := RegModuleGetCount(LRegModule);
for J := 0 to LRegModuleCount - 1 do
begin
if LIndex = ComponentIndex then
begin
LRegClass := RegModuleGetClasses(LRegModule, J);
Result := TClass(PPointer(PByte(LRegClass) + 4)^);
exit;
end;
Inc(LIndex);
end;
end;
end;
end;
procedure Test(Sender: TObject);
var
PackageServices: IOTAPAckageServices;
I: Integer;
J: Integer;
LClass: TClass;
s: string;
begin
if Supports(BorlandIDEServices, IOTAPAckageServices, PackageServices) then
begin
for I := 0 to PackageServices.PackageCount - 1 do
begin
for J := 0 to PackageServices.GetComponentCount(I) - 1 do
begin
s := PackageServices.ComponentNames[I, J];
LClass := GetClass2(I, J);
if Assigned(LClass) then
begin
Assert(LClass.ClassName = s);
end;
end;
end;
end;
end;