Delphi 如何"；扫描"；当前安装的VCL组件的完整列表

我仍然没有找到一个真正令人满意的答案，现在正在考虑推出我自己的。我有ModelMaker和GExperts，它们似乎都没有加载我正在寻找的全面的类层次结构。同样，我不认为DevExpress的人会放弃CDK代码，它编译了一个完整的类列表来继承…；-）

所以

如果ALL我想做的是为所有注册的组件类（或者甚至包括非组件在内的所有类，如果这很简单/可能的话）构建一个自引用表，那么最好的方法是什么

注意：我并不真正需要属性/方法的详细信息；我只需要一个完整的类名（和父类名）列表，就可以存储到一个表中并放在树视图中。不过，除此之外的任何内容都可以作为奖金信息使用。：-）

---

稍后更新：

---

一个答案出现在我关于SO的“最新”部分中，但不是在这个问题上（可能是他们删除了它？），是这样的：

“你可能想看看组件搜索代码，它可以帮助你列举所有安装的组件。”

代码可用吗？那么，它藏在哪里呢？学习起来会很有趣。

你试过Delphi自己的类浏览器吗

浏览器会加载快捷键CTRL-SHIFT-B。我相信您可以通过在浏览器中单击鼠标右键来访问其选项。在这里，您可以选择仅显示项目中的类或所有已知类

我还没有检查，但我希望TComponent的每个子代（包括已安装的组件）都在TComponent节点下可见。使用CTRL-F搜索特定类

---

---

编辑：根据此页面，CTRL+SHIFT+B仅在Delphi5中可用。我没有Delphi 2007来检查这一点，但是如果您在您的版本中找不到类浏览器，我怀疑没有。

不幸的是，实现RegisterClass机制的代码隐藏在类实现部分

如果为了获得IDE中安装的组件列表而需要此功能，可以编写一个设计包，将其安装到IDE中，并在ToolsAPI单元中使用IoTapPackageServices。这将为您提供已安装软件包及其组件的列表

注意：您必须将designide.dcp添加到'requires'子句中，才能使用Delphi的内部单元，如ToolsAPI

需要做更多的工作，但更通用的方法是枚举所有加载的模块。您可以在包模块上调用GetPackageInfo（SysUtils），以枚举包含的单元名称和所需的包。但是，这不会提供包中包含的类的列表

您可以枚举包的导出函数列表（例如，在中使用TJclPeImage）并搜索以下名称的函数：

@@@

例如：'@System@TObject@"

---

通过使用函数名调用GetProcAddress，可以获得TClass引用。从那里，您可以使用ClassParent遍历层次结构。通过这种方式，您可以枚举在运行使用运行时包（也是Delphi IDE）编译的Delphi可执行文件的进程中加载的所有包中的所有类。

另一种方法是扫描导出函数列表顶部的类型信息，以便您可以跳过进一步的枚举。类型信息以前缀“@$xp$”开头的名称导出。下面是一个例子：

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.

unitpackageutils；
接口
使用
窗口、类、系统、Contnrs、TypInfo；
类型
TDelphiPackageList=类别；
TDelphiPackage=class；
TDelphiProcess=类
私有的
F包装：tDelphi包装商；
函数GetPackageCount:整数；
函数GetPackages（索引：整数）：TDelphiPackage；
公众的
构造函数创建；事实上的
毁灭者毁灭；推翻
程序清晰；事实上的
函数FindPackage（句柄：HMODULE）：TDelphiPackage；
程序重新加载；事实上的
属性PackageCount：整数读取GetPackageCount；
属性包[索引：整数]：TDelphiPackage read GetPackages；
结束；
TDelphiPackageList=类（TObjectList）
受保护的
函数GetItem（索引：整数）：TDelphiPackage；
过程集合项（索引：整数；包装：TDelphiPackage）；
公众的
函数Add（APackage:TDelphiPackage）：整数；
函数提取（APackage:TDelphiPackage）：TDelphiPackage；
函数移除（APackage:TDelphiPackage）：整数；
函数IndexOf（APackage:TDelphiPackage）：整数；
过程插入（索引：整数；打包：TDelphiPackage）；
功能一：TDelphiPackage；
最后一个功能：TDelphiPackage；
属性项[索引：整数]：TDelphiPackage read GetItem write SetItem；违约
结束；
TDelphiPackage=class
私有的
手：坦德尔；
FInfoTable：指针；
FTypeInfos:TList；
程序检查信息表；
程序检查类型信息；
函数GetDescription:字符串；
函数GetFileName:string；
函数GetInfoName（NameType:TNameType；索引：Integer）：字符串；
函数GetShortName:string；
函数GetTypeInfoCount（种类：TTypeKinds）：整数；
函数GetTypeInfos（种类：TTypeKinds；索引：Integer）：PTypeInfo；
公众的
构造函数创建（AHandle:HMODULE；AInfoTable:Pointer=nil）；
毁灭者毁灭；推翻
属性描述：字符串读取GetDescription；
属性文件名：字符串读取GetFileName；
属性句柄：THandle read FHandle；
属性ShortName：字符串读取GetShortName；
属性TypeInfoCount[种类：TTTypeTypeCounts]：整数读取GetTypeInfoCount；
属性TypeInfos[种类：ttypetriends；索引：Integer]：PTypeInfo read GetTypeInfos；
结束；
实施
使用
RTLConsts，SysConst，
PSAPI，ImageHlp；
{从SysUtils.pas复制的包信息结构}
类型
PPkgName=^TPkgName；
TPkgName=打包记录
HashCode：字节；
名称：字符的数组[0..255]；
结束；
PUnitName=^TUnitName；
突尼斯名称=打包记录
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.