現在インストールされているVCLコンポーネントの完全なリストを "スキャン"する方法

Question

this questionへの本当に満足のいく回答はまだ見つかっていません。私はModelMakerとGExpertsを持っており、どちらも包括私が探しているクラス階層をロードしていないようです。同様に、私はDevExpress社の人々から継承する完全なクラスリストをコンパイルCDKコードの上にフォークとは思わない... ;-) SO

...

をALL Iの場合すべての登録されたコンポーネントクラス（または非コンポーネントを含むすべてのクラス、それが簡単/可能な場合でも）を参照する自己参照表を作成することです。これを行う最善の方法は何でしょうか？

注：プロパティ/メソッドの詳細は実際には必要ありません。私はテーブルに格納して、ツリービューを置くことができるクラス名（と親の名前）の完全なリストです。しかしそれ以上のものは、ボーナス情報として歓迎する以上のものです。 :-)

---

アップデート以降：

：SO上で私の「最近」セクションに表示さ

一つの答えではなく、ここで問題には（？多分彼らはそれを消去し）、このました "コンポーネント検索のコードを見てみると、インストールされているすべてのコンポーネントを列挙するのに役立ちます。"

そのコードはありますか？それはどこに隠れているのですか？勉強するのは面白いでしょう。

Answer 1

もう1つのアイデアは、エクスポートされた関数のリストの上にある型情報をスキャンして、列挙をスキップすることができます。タイプ情報は、接頭辞 '@ $ xp $'で始まる名前でエクスポートされます。ここでは例です：IDEにインストールされたテスト設計パッケージの

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. 

単位：

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. 

あなたの句を必要にdesignideを追加する必要があります。このデザインパッケージをインストールすると、Delphiのヘルプメニューの下に新しいメニュー項目Testが表示されます。これをクリックすると、ロードされたすべてのクラスがメッセージウィンドウに表示されます。

Answer 2

Delphi独自のクラスブラウザを試しましたか？

ブラウザにショートカットCTRL-SHIFT-Bがロードされます。私はあなたがブラウザで右クリックすることによってそのオプションにアクセスできると信じています。ここでは、プロジェクト内のクラスまたは既知のすべてのクラスのみを表示するオプションがあります。

私はチェックしませんでしたが、TComponentノードの下に表示されているコンポーネントを含め、TComponentのすべての子孫を期待しています。 CTRL-Fを使用して、特定のクラスを検索します。

---

編集：このDelphi Wikiページによると、CTRL + SHIFT + BのはDelphi5でのみ使用可能です。私はこれをチェックするためにDelphi 2007を持っていませんが、あなたのバージョンでクラスブラウザを見つけることができないなら、私はそこに何かがないと思います。

Answer 3

残念ながら、RegisterClassメカニズムを実装するコードは、クラス実装セクションでは表示されません。

IDEにインストールされているコンポーネントのリストを取得する必要がある場合は、デザインパッケージを作成してIDEにインストールし、ToolsAPIユニットでIOTAPackageServicesを使用できます。これにより、インストールされているパッケージとそのコンポーネントのリストが表示されます。

注：ToolsAPIのようなDelphiの内部ユニットを使用できるようにするには、 'requires'句にdesignide.dcpを追加する必要があります。

もう少し作業はしますが、より一般的な方法は、ロードされたすべてのモジュールを列挙することです。パッケージモジュールでGetPackageInfo（SysUtils）を呼び出して、含まれているユニット名と必要なパッケージを列挙できます。ただし、パッケージに含まれるクラスのリストは表示されません。

あなたは（JCLにTJclPeImage付きなど）エクスポート関数のパッケージのリストを列挙し、このように名付けられたものを検索できます。例えば

@<unit_name>@<class_name>@

：「@システム@のTObjectを@ '。

関数名を指定してGetProcAddressを呼び出すと、TClass参照が取得されます。そこから、ClassParentを使用して階層を歩くことができます。これにより、ランタイムパッケージ（Delphi IDE）でコンパイルされたDelphi実行ファイルを実行するプロセスにロードされたすべてのパッケージのすべてのクラスを列挙できます。