So "scannen" Sie die vollständige Liste der aktuell installierten VCL-Komponenten

Question

Ich habe immer noch keine wirklich befriedigende Antwort auf this question gefunden und erwäge jetzt, meine eigene zu rollen. Ich habe ModelMaker und GExperts, und keiner scheint die umfassende Klassenhierarchie zu laden, die ich suche. Wie gut, ich glaube nicht, die Leute bei DevExpress über den CDK-Code Gabel werden, die eine vollständige Klassenliste kompiliert aus zu erben ... ;-)

SO ...

Wenn ALL I Möchten Sie eine selbstreferenzierende Tabelle aller registrierten Komponentenklassen erstellen (oder sogar aller Klassen einschließlich Nicht-Komponenten, wenn das genauso einfach/möglich ist), was wäre der beste Weg, dies zu tun?

Hinweis: Ich brauche keine Details zu Eigenschaften/Methoden. Nur eine vollständige Liste von Klassennamen (und Elternnamen) kann ich in einer Tabelle speichern und in eine Baumansicht einfügen. Alles darüber hinaus ist als Bonusinfo mehr als willkommen. :-)

---

-Update später:

Eine Antwort, die auf SO in meinem "jüngsten" Abschnitt zeigt, aber nicht hier auf die Frage (? Vielleicht gelöscht sie es), war dies:

"Wenn Sie sich den Code der Komponentensuche ansehen möchten, kann er Ihnen dabei helfen, alle installierten Komponenten einzubinden."

Ist dieser Code verfügbar? Ist es so, wo versteckt es sich? Wäre interessant zu lernen.

Answer 1

Eine andere Idee ist es, nach Typinformationen zu suchen, die oben auf der Liste der exportierten Funktionen stehen, so dass Sie die Aufzählung weiter überspringen können. Die Typinfos werden mit Namen exportiert, die mit dem Präfix '@ $ xp $' beginnen. Hier ein Beispiel:

unit PackageUtils; 

interface 

uses 
    Windows, Classes, SysUtils, Contnrs, TypInfo; 

type 
    TDelphiPackageList = class; 
    TDelphiPackage = class; 

    TDelphiProcess = class 
    private 
    FPackages: TDelphiPackageList; 

    function GetPackageCount: Integer; 
    function GetPackages(Index: Integer): TDelphiPackage; 
    public 
    constructor Create; virtual; 
    destructor Destroy; override; 

    procedure Clear; virtual; 
    function FindPackage(Handle: HMODULE): TDelphiPackage; 
    procedure Reload; virtual; 

    property PackageCount: Integer read GetPackageCount; 
    property Packages[Index: Integer]: TDelphiPackage read GetPackages; 
    end; 

    TDelphiPackageList = class(TObjectList) 
    protected 
    function GetItem(Index: Integer): TDelphiPackage; 
    procedure SetItem(Index: Integer; APackage: TDelphiPackage); 
    public 
    function Add(APackage: TDelphiPackage): Integer; 
    function Extract(APackage: TDelphiPackage): TDelphiPackage; 
    function Remove(APackage: TDelphiPackage): Integer; 
    function IndexOf(APackage: TDelphiPackage): Integer; 
    procedure Insert(Index: Integer; APackage: TDelphiPackage); 
    function First: TDelphiPackage; 
    function Last: TDelphiPackage; 

    property Items[Index: Integer]: TDelphiPackage read GetItem write SetItem; default; 
    end; 

    TDelphiPackage = class 
    private 
    FHandle: THandle; 
    FInfoTable: Pointer; 
    FTypeInfos: TList; 

    procedure CheckInfoTable; 
    procedure CheckTypeInfos; 
    function GetDescription: string; 
    function GetFileName: string; 
    function GetInfoName(NameType: TNameType; Index: Integer): string; 
    function GetShortName: string; 
    function GetTypeInfoCount(Kinds: TTypeKinds): Integer; 
    function GetTypeInfos(Kinds: TTypeKinds; Index: Integer): PTypeInfo; 
    public 
    constructor Create(AHandle: HMODULE; AInfoTable: Pointer = nil); 
    destructor Destroy; override; 

    property Description: string read GetDescription; 
    property FileName: string read GetFileName; 
    property Handle: THandle read FHandle; 
    property ShortName: string read GetShortName; 
    property TypeInfoCount[Kinds: TTypeKinds]: Integer read GetTypeInfoCount; 
    property TypeInfos[Kinds: TTypeKinds; Index: Integer]: PTypeInfo read GetTypeInfos; 
    end; 

implementation 

uses 
    RTLConsts, SysConst, 
    PSAPI, ImageHlp; 

{ Package info structures copied from SysUtils.pas } 

type 
    PPkgName = ^TPkgName; 
    TPkgName = packed record 
    HashCode: Byte; 
    Name: array[0..255] of Char; 
    end; 

    PUnitName = ^TUnitName; 
    TUnitName = packed record 
    Flags : Byte; 
    HashCode: Byte; 
    Name: array[0..255] of Char; 
    end; 

    PPackageInfoHeader = ^TPackageInfoHeader; 
    TPackageInfoHeader = packed record 
    Flags: Cardinal; 
    RequiresCount: Integer; 
    {Requires: array[0..9999] of TPkgName; 
    ContainsCount: Integer; 
    Contains: array[0..9999] of TUnitName;} 
    end; 

    TEnumModulesCallback = function (Module: HMODULE; Data: Pointer = nil): Boolean; 
    TEnumModulesProc = function (Callback: TEnumModulesCallback; Data: Pointer = nil): Boolean; 

const 
    STypeInfoPrefix = '@$xp$'; 

var 
    EnumModules: TEnumModulesProc = nil; 

function PackageInfoTable(Module: HMODULE): PPackageInfoHeader; forward; 

function AddPackage(Module: HMODULE; Data: {TDelphiPackageList} Pointer): Boolean; 
var 
    InfoTable: Pointer; 
begin 
    Result := False; 

    if (Module <> HInstance) then 
    begin 
    InfoTable := PackageInfoTable(Module); 
    if Assigned(InfoTable) then 
     TDelphiPackageList(Data).Add(TDelphiPackage.Create(Module, InfoTable)); 
    end; 
end; 

function GetPackageDescription(Module: HMODULE): string; 
var 
    ResInfo: HRSRC; 
    ResData: HGLOBAL; 
begin 
    Result := ''; 
    ResInfo := FindResource(Module, 'DESCRIPTION', RT_RCDATA); 
    if ResInfo <> 0 then 
    begin 
    ResData := LoadResource(Module, ResInfo); 
    if ResData <> 0 then 
    try 
     Result := PWideChar(LockResource(ResData)); 
     UnlockResource(ResData); 
    finally 
     FreeResource(ResData); 
    end; 
    end; 
end; 

function EnumModulesPS(Callback: TEnumModulesCallback; Data: Pointer = nil): Boolean; 
var 
    ProcessHandle: THandle; 
    SizeNeeded: Cardinal; 
    P, ModuleHandle: PDWORD; 
    I: Integer; 
begin 
    Result := False; 

    ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, GetCurrentProcessId); 
    if ProcessHandle = 0 then 
    RaiseLastOSError; 
    try 
    SizeNeeded := 0; 
    EnumProcessModules(ProcessHandle, nil, 0, SizeNeeded); 
    if SizeNeeded = 0 then 
     Exit; 

    P := AllocMem(SizeNeeded); 
    try 
     if EnumProcessModules(ProcessHandle, P, SizeNeeded, SizeNeeded) then 
     begin 
     ModuleHandle := P; 
     for I := 0 to SizeNeeded div SizeOf(DWORD) - 1 do 
     begin 
      if Callback(ModuleHandle^, Data) then 
      Exit; 
      Inc(ModuleHandle); 
     end; 

     Result := True; 
     end; 
    finally 
     FreeMem(P); 
    end; 
    finally 
    CloseHandle(ProcessHandle); 
    end; 
end; 

function EnumModulesTH(Callback: TEnumModulesCallback; Data: Pointer = nil): Boolean; 
begin 
    Result := False; 
    // todo win9x? 
end; 

function PackageInfoTable(Module: HMODULE): PPackageInfoHeader; 
var 
    ResInfo: HRSRC; 
    Data: THandle; 
begin 
    Result := nil; 
    ResInfo := FindResource(Module, 'PACKAGEINFO', RT_RCDATA); 
    if ResInfo <> 0 then 
    begin 
    Data := LoadResource(Module, ResInfo); 
    if Data <> 0 then 
    try 
     Result := LockResource(Data); 
     UnlockResource(Data); 
    finally 
     FreeResource(Data); 
    end; 
    end; 
end; 

{ TDelphiProcess private } 

function TDelphiProcess.GetPackageCount: Integer; 
begin 
    Result := FPackages.Count; 
end; 

function TDelphiProcess.GetPackages(Index: Integer): TDelphiPackage; 
begin 
    Result := FPackages[Index]; 
end; 

{ TDelphiProcess public } 

constructor TDelphiProcess.Create; 
begin 
    inherited Create; 
    FPackages := TDelphiPackageList.Create; 
    Reload; 
end; 

destructor TDelphiProcess.Destroy; 
begin 
    FPackages.Free; 
    inherited Destroy; 
end; 

procedure TDelphiProcess.Clear; 
begin 
    FPackages.Clear; 
end; 

function TDelphiProcess.FindPackage(Handle: HMODULE): TDelphiPackage; 
var 
    I: Integer; 
begin 
    Result := nil; 

    for I := 0 to FPackages.Count - 1 do 
    if FPackages[I].Handle = Handle then 
    begin 
     Result := FPackages[I]; 
     Break; 
    end; 
end; 

procedure TDelphiProcess.Reload; 
begin 
    Clear; 

    if Assigned(EnumModules) then 
    EnumModules(AddPackage, FPackages); 
end; 

{ TDelphiPackageList protected } 

function TDelphiPackageList.GetItem(Index: Integer): TDelphiPackage; 
begin 
    Result := TDelphiPackage(inherited GetItem(Index)); 
end; 

procedure TDelphiPackageList.SetItem(Index: Integer; APackage: TDelphiPackage); 
begin 
    inherited SetItem(Index, APackage); 
end; 

{ TDelphiPackageList public } 

function TDelphiPackageList.Add(APackage: TDelphiPackage): Integer; 
begin 
    Result := inherited Add(APackage); 
end; 

function TDelphiPackageList.Extract(APackage: TDelphiPackage): TDelphiPackage; 
begin 
    Result := TDelphiPackage(inherited Extract(APackage)); 
end; 

function TDelphiPackageList.First: TDelphiPackage; 
begin 
    Result := TDelphiPackage(inherited First); 
end; 

function TDelphiPackageList.IndexOf(APackage: TDelphiPackage): Integer; 
begin 
    Result := inherited IndexOf(APackage); 
end; 

procedure TDelphiPackageList.Insert(Index: Integer; APackage: TDelphiPackage); 
begin 
    inherited Insert(Index, APackage); 
end; 

function TDelphiPackageList.Last: TDelphiPackage; 
begin 
    Result := TDelphiPackage(inherited Last); 
end; 

function TDelphiPackageList.Remove(APackage: TDelphiPackage): Integer; 
begin 
    Result := inherited Remove(APackage); 
end; 

{ TDelphiPackage private } 

procedure TDelphiPackage.CheckInfoTable; 
begin 
    if not Assigned(FInfoTable) then 
    FInfoTable := PackageInfoTable(Handle); 

    if not Assigned(FInfoTable) then 
    raise EPackageError.CreateFmt(SCannotReadPackageInfo, [ExtractFileName(GetModuleName(Handle))]); 
end; 

procedure TDelphiPackage.CheckTypeInfos; 
var 
    ExportDir: PImageExportDirectory; 
    Size: DWORD; 
    Names: PDWORD; 
    I: Integer; 
begin 
    if not Assigned(FTypeInfos) then 
    begin 
    FTypeInfos := TList.Create; 
    try 
     Size := 0; 
     ExportDir := ImageDirectoryEntryToData(Pointer(Handle), True, IMAGE_DIRECTORY_ENTRY_EXPORT, Size); 
     if not Assigned(ExportDir) then 
     Exit; 

     Names := PDWORD(DWORD(Handle) + DWORD(ExportDir^.AddressOfNames)); 
     for I := 0 to ExportDir^.NumberOfNames - 1 do 
     begin 
     if StrLIComp(PChar(DWORD(Handle) + Names^), STypeInfoPrefix, StrLen(STypeInfoPrefix)) <> 0 then 
      Break; 
     FTypeInfos.Add(GetProcAddress(Handle, PChar(DWORD(Handle) + Names^))); 
     Inc(Names); 
     end; 
    except 
     FreeAndNil(FTypeInfos); 
     raise; 
    end; 
    end; 
end; 

function TDelphiPackage.GetDescription: string; 
begin 
    Result := GetPackageDescription(Handle); 
end; 

function TDelphiPackage.GetFileName: string; 
begin 
    Result := GetModuleName(FHandle); 
end; 

function TDelphiPackage.GetInfoName(NameType: TNameType; Index: Integer): string; 
var 
    P: Pointer; 
    Count: Integer; 
    I: Integer; 
begin 
    Result := ''; 
    CheckInfoTable; 
    Count := PPackageInfoHeader(FInfoTable)^.RequiresCount; 
    P := Pointer(Cardinal(FInfoTable) + SizeOf(TPackageInfoHeader)); 
    case NameType of 
    ntContainsUnit: 
     begin 
     for I := 0 to Count - 1 do 
      P := Pointer(Cardinal(P) + StrLen(PPkgName(P)^.Name) + 2); 
     Count := Integer(P^); 
     P := Pointer(Cardinal(P) + SizeOf(Integer)); 
     if (Index >= 0) and (Index < Count) then 
     begin 
      for I := 0 to Count - 1 do 
      P := Pointer(Cardinal(P) + StrLen(PUnitName(P)^.Name) + 3); 
      Result := PUnitName(P)^.Name; 
     end; 
     end; 
    ntRequiresPackage: 
     if (Index >= 0) and (Index < Count) then 
     begin 
     for I := 0 to Index - 1 do 
      P := Pointer(Cardinal(P) + StrLen(PPkgName(P)^.Name) + 2); 
     Result := PPkgName(P)^.Name; 
     end; 
    ntDcpBpiName: 
     if PPackageInfoHeader(FInfoTable)^.Flags and pfPackageModule <> 0 then 
     begin 
     for I := 0 to Count - 1 do 
      P := Pointer(Cardinal(P) + StrLen(PPkgName(P)^.Name) + 2); 
     Count := Integer(P^); 
     P := Pointer(Cardinal(P) + SizeOf(Integer)); 
     for I := 0 to Count - 1 do 
      P := Pointer(Cardinal(P) + StrLen(PUnitName(P)^.Name) + 3); 
     Result := PPkgName(P)^.Name; 
     end; 
    end; 
end; 

function TDelphiPackage.GetShortName: string; 
begin 
    Result := GetInfoName(ntDcpBpiName, 0); 
end; 

function TDelphiPackage.GetTypeInfoCount(Kinds: TTypeKinds): Integer; 
var 
    I: Integer; 
begin 
    CheckTypeInfos; 
    Result := 0; 
    for I := 0 to FTypeInfos.Count - 1 do 
    if (Kinds = []) or (PTypeInfo(FTypeInfos[I])^.Kind in Kinds) then 
     Inc(Result); 
end; 

function TDelphiPackage.GetTypeInfos(Kinds: TTypeKinds; Index: Integer): PTypeInfo; 
var 
    I, J: Integer; 
begin 
    CheckTypeInfos; 
    Result := nil; 
    J := -1; 
    for I := 0 to FTypeInfos.Count - 1 do 
    if (Kinds = []) or (PTypeInfo(FTypeInfos[I])^.Kind in Kinds) then 
    begin 
     Inc(J); 
     if J = Index then 
     begin 
     Result := FTypeInfos[I]; 
     Break; 
     end; 
    end; 
end; 

{ TDelphiPackage public } 

constructor TDelphiPackage.Create(AHandle: HMODULE; AInfoTable: Pointer = nil); 
begin 
    inherited Create; 
    FHandle := AHandle; 
    FInfoTable := AInfoTable; 
    FTypeInfos := nil; 
end; 

destructor TDelphiPackage.Destroy; 
begin 
    FTypeInfos.Free; 
    inherited Destroy; 
end; 

initialization 
    case Win32Platform of 
    VER_PLATFORM_WIN32_WINDOWS: 
     EnumModules := EnumModulesTH; 
    VER_PLATFORM_WIN32_NT: 
     EnumModules := EnumModulesPS; 
    else 
     EnumModules := nil; 
    end; 

finalization 

end. 

Einheit des Pakets Testdesign in der IDE installiert:

unit Test; 

interface 

uses 
    SysUtils, Classes, 
    ToolsAPI; 

type 
    TTestWizard = class(TNotifierObject, IOTAWizard, IOTAMenuWizard) 
    private 
    { IOTAWizard } 
    procedure Execute; 
    function GetIDString: string; 
    function GetName: string; 
    function GetState: TWizardState; 
    { IOTAMenuWizard } 
    function GetMenuText: string; 
    end; 

implementation 

uses 
    TypInfo, 
    PackageUtils; 

function AncestryStr(AClass: TClass): string; 
begin 
    Result := ''; 
    if not Assigned(AClass) then 
    Exit; 

    Result := AncestryStr(AClass.ClassParent); 
    if Result <> '' then 
    Result := Result + '\'; 
    Result := Result + AClass.ClassName; 
end; 

procedure ShowMessage(const S: string); 
begin 
    with BorlandIDEServices as IOTAMessageServices do 
    AddTitleMessage(S); 
end; 

{ TTestWizard } 

procedure TTestWizard.Execute; 
var 
    Process: TDelphiProcess; 
    I, J: Integer; 
    Package: TDelphiPackage; 
    PInfo: PTypeInfo; 
    PData: PTypeData; 

begin 
    Process := TDelphiProcess.Create; 
    for I := 0 to Process.PackageCount - 1 do 
    begin 
    Package := Process.Packages[I]; 
    for J := 0 to Package.TypeInfoCount[[tkClass]] - 1 do 
    begin 
     PInfo := Package.TypeInfos[[tkClass], J]; 
     PData := GetTypeData(PInfo); 
     ShowMessage(Format('%s: %s.%s (%s)', [Package.ShortName, PData^.UnitName, PInfo^.Name, AncestryStr(PData^.ClassType)])); 
    end; 
    end; 
end; 

function TTestWizard.GetIDString: string; 
begin 
    Result := 'TOndrej.TestWizard'; 
end; 

function TTestWizard.GetName: string; 
begin 
    Result := 'Test'; 
end; 

function TTestWizard.GetState: TWizardState; 
begin 
    Result := [wsEnabled]; 
end; 

function TTestWizard.GetMenuText: string; 
begin 
    Result := 'Test'; 
end; 

var 
    Index: Integer = -1; 

initialization 
    with BorlandIDEServices as IOTAWizardServices do 
    Index := AddWizard(TTestWizard.Create); 

finalization 
    if Index <> -1 then 
    with BorlandIDEServices as IOTAWizardServices do 
     RemoveWizard(Index); 

end. 

Sie müssen hinzufügen DesignIDE auf Ihre requires-Klausel. Wenn Sie dieses Design-Paket installieren, sollte ein neuer Menüeintrag Test unter Delphi's Hilfe-Menü erscheinen. Wenn Sie darauf klicken, sollten alle geladenen Klassen im Nachrichtenfenster angezeigt werden.

Answer 2

Haben Sie Delphi's eigenen Klassenbrowser ausprobiert?

Der Browser wird mit der Tastenkombination STRG-UMSCHALT-B geladen. Ich glaube, Sie können auf seine Optionen zugreifen, indem Sie mit der rechten Maustaste in den Browser klicken. Hier haben Sie die Möglichkeit, nur die Klassen in Ihrem Projekt oder alle bekannten Klassen anzuzeigen.

Ich habe nicht überprüft, aber ich erwarte, dass alle Nachkommen von TComponent, einschließlich installierter Komponenten, unter dem TComponent-Knoten sichtbar sind. Verwenden Sie STRG-F, um nach einer bestimmten Klasse zu suchen.

---

Edit: nach dieser Delphi Wiki Seite, CTRL + SHIFT + B ist nur in Delphi5 verfügbar. Ich habe Delphi 2007 nicht, um das zu überprüfen, aber wenn Sie keinen Klassenbrowser in Ihrer Version finden, würde ich vermuten, dass es keine gibt.

Answer 3

Leider ist der Code, der den RegisterClass-Mechanismus implementiert, im Klassenimplementierungsabschnitt verborgen.

Wenn Sie dies benötigen, um die Liste der in der IDE installierten Komponenten zu erhalten, können Sie ein Design-Paket schreiben, es in der IDE installieren und IOTAPackageServices in der ToolsAPI-Einheit verwenden. Dadurch erhalten Sie die Liste der installierten Pakete und ihrer Komponenten.

Hinweis: Sie müssen designide.dcp zu Ihrer 'requires'-Klausel hinzufügen, um Delphis interne Einheiten wie ToolsAPI verwenden zu können.

Ein bisschen mehr Arbeit, aber ein allgemeinerer Weg wäre, alle geladenen Module aufzulisten. Sie können GetPackageInfo (SysUtils) auf einem Paketmodul aufrufen, um die enthaltenen Einheitennamen und erforderlichen Pakete aufzulisten. Sie erhalten jedoch keine Liste der im Paket enthaltenen Klassen.

Sie könnten das Paket der Liste der exportierten Funktionen (zB mit TJclPeImage im JCL) aufzählen und für diejenigen, die wie folgt benannt suchen:

@<unit_name>@<class_name>@

zum Beispiel: ‚@-System @ TObject @ '.

Durch Aufrufen von GetProcAddress mit dem Funktionsnamen erhalten Sie die TClass-Referenz. Von dort aus können Sie die Hierarchie mit ClassParent durchlaufen. Auf diese Weise können Sie alle Klassen in allen Paketen auflisten, die in einem Prozess geladen sind, der eine Delphi-Programmdatei ausführt, die mit Laufzeit-Paketen kompiliert wurde (auch Delphi-IDE).