현재 설치된 VCL 구성 요소의 전체 목록을 "검색"하는 방법

Question

this question에 대한 만족스러운 답변을 찾지 못했지만 지금은 내 자신을 고려 중입니다. 나는 ModelMaker와 GExperts를 가지고 있는데 어느 것도 포괄적 인 클래스를 찾지 못했습니다. 뿐만 아니라, 나는 DevExpress의에서 사람들이 상속하는 전체 클래스 목록에 컴파일 CDK 코드를 통해 포크 것이라고 생각하지 않습니다 ... ;-) SO

...

을 ALL 나는 경우, 모든 등록 된 구성 요소 클래스 (또는 비 구성 요소를 포함한 모든 클래스까지도 쉽게/가능하면 자체 참조 테이블 생성)를 수행하는 것이 가장 좋은 방법 일 것입니다.

참고 : 속성/메소드 세부 정보는 실제로 필요하지 않습니다. 클래스 이름 (및 부모 이름)의 전체 목록을 테이블에 저장하고 트리 뷰에 넣을 수 있습니다. 그 외에는 보너스 정보로 환영받는 것 이상입니다.

: 질문 (? 어쩌면 그들은 그것을 삭제) 여기 내 "최근"절에서의 SO 있지만 나타

한 대답은,이

이었다

---

업데이트 이후 :-) "구성 요소 검색 코드를 살펴보고 싶을 수 있습니다. 설치 한 모든 구성 요소를 열거하는 데 도움이 될 수 있습니다."

해당 코드를 사용할 수 있습니까? 그렇습니다, 어디에 숨어 있습니까? 공부하는 것이 흥미로울 것입니다.

Answer 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에서만 사용할 수 있습니다. 델파이 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 실행 파일을 실행하는 프로세스에로드 된 모든 패키지의 모든 클래스를 열거 할 수 있습니다.