Wie ermittelt man welche Komponenten in einem Package sind?

[MaBuSE]

Hallo,
ich würde gerne zur Laufzeit wissen welche Komponenten in dem Package xyz.bpl enthalten sind.
Die Info ob das ein Runtime-, Designtime-Package oder Beides ist wär auch nicht schlecht.

Wenn ein Package in Delphi geladen wird (Menu -> Komponenten -> Packages installieren) kann man mit dem Komponenten Button sehen welche Komponenten in diesem Package sind.
Genau das will ich auch in meinem Programm haben !!!

An die Beschreibung und die Units des Package kommt man relativ leicht mit getPackageInfo.

Kann mir jemand helfen?

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure cbprocPackageInfo(const Name: string; NameType: TNameType; Flags: Byte; Param: Pointer);
var
  s: string;
begin
  // CallbackFunktion von GetPackageInfo
  case NameType of
    ntContainsUnit    : s := 'Unit: ';
    ntRequiresPackage : s := 'benötigt Package: ';
    ntDcpBpiName      : s := 'PackageName: ';
  end;
  Form1.Memo1.Lines.Add('  Flags: ' + IntToHex(Flags, 2) + ' - ' +s + name);
end;

procedure GetBplInfo(FileName: string);
var
  HPack, Flags : integer;
begin
  Form1.Memo1.Lines.Add('Dateiname: '+FileName);
  Form1.Memo1.Lines.Add('  Package Name: '+GetPackageDescription(PAnsiChar(FileName)));
  HPack := LoadPackage(FileName);
  GetPackageInfo(HPack, nil, Flags, cbprocPackageInfo);
  UnloadPackage(HPack);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Lines.Clear;
  getBplInfo('dclisp70.bpl');
end;

end.

[Stevie]

Hi Mabuse,

folgendende Unit hab ich bei unseren niederländischen Kollegen gefunden:

Delphi-Quellcode:

unit PackageInfo;

interface
uses Classes;

type
  TPackageClassesAndUnits = class
  protected
    FModuleName: string;
    FUnitList: TStringList;
    FClassList: TList;
    procedure MethodGetClass(AClass: TPersistentClass);
  public
    constructor Create(ModuleHandle: THandle); Overload;
    constructor Create(ModuleName: String); Overload;
    destructor Destroy; override;
    property ClassList: TList read FClassList;
    property Units: TStringList read FUnitList;
    property ModuleName: string read FModuleName;
  end;

implementation
uses TypInfo, SysUtils, Windows;

procedure PackageInfoMethod(const Name: string; NameType: TNameType; Flags: Byte; Param: Pointer);
var
  UnitList: TStringList;
begin
  // add unit
  if NameType = ntContainsUnit then
  begin
    UnitList := TStringList(Param); // should work when Param is FUnitList from TPackageClassesAndUnits
    UnitList.Add(Name);
  end;
end;


{ TPackageClassesAndUnits }

constructor TPackageClassesAndUnits.Create(ModuleHandle: THandle);
var
  flags: integer;
begin
  // create class list
  FClassList:= TList.Create;
  // create unit list (sorted, ignore duplicates)
  FUnitList := TStringList.Create;
  FUnitList.Duplicates := dupIgnore;
  FUnitList.Sorted := true;

  FModuleName := GetModuleName(ModuleHandle);

  // build unit list
  GetPackageInfo(ModuleHandle, FUnitList, flags, @PackageInfoMethod);

  // build class list
  with TClassFinder.Create(nil, false) do
  try
    GetClasses(MethodGetClass);
  finally
    Free;
  end;
end;

constructor TPackageClassesAndUnits.Create(ModuleName: String);
begin
  Create(GetModuleHandle(PChar(ModuleName)));
end;

destructor TPackageClassesAndUnits.Destroy;
begin
  FClassList.Free;
  FUnitList.Free;
  inherited;
end;

procedure TPackageClassesAndUnits.MethodGetClass(AClass: TPersistentClass);
var
  TypeData: PTypeData;
begin
  // get typedata pointer
  TypeData := GetTypeData(AClass.ClassInfo);
  // add class when unit name of class typedate in unit list and not
  // already added
  if (FUnitList.IndexOf(TypeData^.UnitName) >= 0) and
    (FClassList.IndexOf(AClass) < 0) then
    FClassList.Add(AClass);
end;

end.

Allerdings ist hierbei Vorraussetzung, dass die Klassen registriert sind, ansonsten hast du nicht wirklich eine Chance, sie zu finden.

MfG
Stevie

[MaBuSE]

Danke für die Antwort.

Zitat:

Zitat von Stevie

Allerdings ist hierbei Vorraussetzung, dass die Klassen registriert sind, ansonsten hast du nicht wirklich eine Chance, sie zu finden.

Wenn Sie nicht registriert sind habe ich wohl keine Chance :-(

Ich habe versucht die Register Prozedur der Packages aufzurufen, bekomme aber nur einen Fehler EComponentError "Ungültige Komponentenregistrierung" :-(

In den Register Prozeduren der Packages steht natürlich folgendes drin:

Delphi-Quellcode:

RegisterComponent('Palette', [TMyComponent]);

Wie kann ich die denn zur Laufzeit registrieren um zu sehen welche Komponenten in dem Package enthalten sind?

[Stevie]

Zitat:

Zitat von MaBuSE

Wie kann ich die denn zur Laufzeit registrieren um zu sehen welche Komponenten in dem Package enthalten sind?

In jeder Unit, wo Klassen enthalten sind, die du finden willst, muss folgendes enthalten sein:

Delphi-Quellcode:

initialization
  RegisterClass(TMyClass);

finalization
  UnRegisterClass(TMyClass);

[MaBuSE]

Zitat:

Zitat von Stevie

In jeder Unit, wo Klassen enthalten sind, die du finden willst, muss folgendes enthalten sein:

Delphi-Quellcode:

initialization
  RegisterClass(TMyClass);
finalization
  UnRegisterClass(TMyClass);

Wer macht das denn?

Nicht mal in den Standard Package z.B. dclstd70.bpl ist das gemacht.

Ich will aber wissen, was in den einzelnen Package enthalten ist.
Die IDE kann das ja auch :mrgreen:

Als Experten, der in die IDE geklingt wird und dann das Package läd, nachschaut und es wieder entläd funktioniert das über die ToolsAPI. (BorlandIDEServices as IOTAPackageServices)

Aber Leider nicht ohne IDE :evil:

Mein Tool gibt bisher folgendes aus:

Code:

Dateiname: dclstd70.bpl
  Package Name: Borland Standardkomponenten
  Flags: 00 - benötigt Package: designide70.bpl
  Flags: 00 - benötigt Package: vclx70.bpl
  Flags: 00 - benötigt Package: vcl70.bpl
  Flags: 00 - benötigt Package: rtl70.bpl
  Flags: 03 - Unit: dclstd
  Flags: 00 - Unit: StdConst
  Flags: 00 - Unit: SysInit
  Flags: 00 - Unit: ActnRes
  Flags: 00 - Unit: ActnDrag
  Flags: 00 - Unit: NewStdAc
  Flags: 00 - Unit: ActnEdit
  Flags: 00 - Unit: SvcReg
               SvcReg.Register;
  Flags: 00 - Unit: DdeReg
               DdeReg.Register; fehlgeschlagen (Ungültige Komponentenregistrierung)
  Flags: 00 - Unit: FiltEdit
  Flags: 00 - Unit: HCtlEdit
  Flags: 00 - Unit: NodeEdit
  Flags: 00 - Unit: ImgEdit
  Flags: 00 - Unit: ItemEdit
  Flags: 00 - Unit: ColEdit
  Flags: 00 - Unit: SBarEdit
  Flags: 00 - Unit: MaskProp
  Flags: 00 - Unit: MaskText
  Flags: 00 - Unit: OleReg
               OleReg.Register; fehlgeschlagen (Ungültige Komponentenregistrierung)
  Flags: 00 - Unit: StdReg
               StdReg.Register; fehlgeschlagen (Ungültige Komponentenregistrierung)
  Flags: 00 - Unit: SysReg
               SysReg.Register; fehlgeschlagen (Ungültige Komponentenregistrierung)
  Flags: 00 - PackageName: dclstd

Mir fehlen z.B. noch folgende Informationen:

Code:

TOpenDialog
TSaveDialog
TOpenPictureDialog
TSavePictureDialog
TFontDialog
TColorDialog
TPrintDialog
TPrinterSetupDialog
TFindDialog
TReplaceDialog
TPageSetupDialog
TTimer
TPaintBox
TMediaPlayer
TMainMenu
TPopupMenu
TLabel
TEdit
TMemo
TButton
TCheckBox
TRadioButton
TListBox
TComboBox
TScrollBar
TGroupBox
TRadioGroup
TPanel
TActionList
TBitBtn
TSpeedButton
TMaskEdit
TStringGrid
TDrawGrid
TImage
TShape
TBevel
TScrollBox
TCheckListBox
TSplitter
TStaticText
TControlBar
TApplicationEvents
TValueListEditor
TLabeledEdit
TColorBox
TTabControl
TPageControl
TImageList
TRichEdit
TTrackBar
TProgressBar
TUpDown
THotKey
TAnimate
TDateTimePicker
TMonthCalendar
TTreeView
TListView
THeaderControl
TStatusBar
TToolBar
TCoolBar
TPageScroller
TComboBoxEx
TXPManifest
TOleContainer
TCOMAdminCatalog
TDdeClientConv
TDdeClientItem
TDdeServerConv
TDdeServerItem

Hat jemand eine Idee ?

[maximov]

Moin Mabuse,

der Hagen hat mal einen sehr trickreichen, wenn auch illegalen, code zum iterieren über alle typeInfo eines moduls veröffentlicht, mit dem du wohl deine aufgabenstellung erfüllen kannst.

in folgendem thread findest du alles nötige: http://www.delphipraxis.net/internal...ght=hagen+rtti

[negaH]

Korrekt, und mit System.EnumModules() kannst du über die geladenen Packages iterieren.

Delphi-Quellcode:

uses TypInfo, HagEnumInfo;

function TForm1.DoTypeInfo(Info: PTypeInfo): Boolean; register;
begin
  Result := False;
  if Info.Kind = tkClass then
    Memo1.Lines.Add(GetModuleName(FindHInstance(Info)) + ', ' + Info.Name);
end;

procedure TForm1.Button1Click(Sender: TObject);

  function MyEnumModule(Instance: Integer; Data: Pointer): Boolean;
  begin
    Result := not EnumTypeInfo(Instance, @MyEnumTypeInfo, Data);
  end;

begin
  Memo1.BeginUpdate;
  try
    Memo1.Clear;
    EnumModules(@MyEnumModule, Self);
  finally
    Memo1.EndUpdate;
  end;
end;

Gruß Hagen

[MaBuSE]

Zitat:

Zitat von negaH

Korrekt, und mit System.EnumModules() kannst du über die geladenen Packages iterieren.

Danke, aber irgendwie funnktioniert das nicht richtig bei mir.

Dein hier geposteter Quellcode funktioniert bei mir so nicht.
Folgende Dinge musste ich ändern:

• Memo1.BeginUpdate und Memo1.EndUpdate gibts bei meinem Delphi 7 TMemo nicht
• EnumTypeInfo fibt bei mir nicht Boolean, sondern PTypeInfo zurück
• EnumModules(@MyEnumModule, self); musste ich zu EnumModules(TEnumModuleFunc(@MyEnumModule), self); ändern (gab Fehlermeldung wegen mehrdeutiger Überladung)
• Result := not EnumTypeInfo(Instance, @MyEnumTypeInfo, Data); musste ich nach EnumTypeInfo(Instance, @DoTypeInfo, Data); ändern, da MyEnumTypeInfo nicht definiert ist.
• function TForm1.DoTypeInfo(Info: PTypeInfo): Boolean; register; musste ich nach function DoTypeInfo(UserData: Pointer; Info: PTypeInfo): Boolean; register; ändern (da TEnumTypeInfoCallback so definiert ist)

Ich hoffe das diese Änderungen so richtig sind.

Im Memo steht nun eine Liste der eingebundenen Klassen.

Leider nur die von Projekt1.exe nicht die der Package, obwohl ich ein Package mit LoadPackage('dclsockets70.bpl'); geladen habe.

Mein Versuch gestern mit Deiner Unit brachten mich etwas weiter.

Ich habe einfach Deine Unit wie folgt abgeändert: (2 x Ausgabe in Memo)

Delphi-Quellcode:

function RegClassesHandler(UserData: Pointer; Info: PTypeInfo): Boolean; register;
var td:PTypeData;
begin
  if Info^.Kind = tkClass then
  begin
    td := GetTypeData(info);
    if td^.ClassType.InheritsFrom(TPersistent) then
    begin
      RegisterClass(TPersistentClass(td^.ClassType));
      Form1.Memo1.Lines.Add('              Register: '+TPersistentClass(td^.ClassType).ClassName);
    end;
    Form1.Memo1.Lines.Add('              Unit:'+td^.UnitName+' - Klasse: '+td^.ClassType.ClassName+
      ' = class('+td^.ParentInfo^.Name+')');
  end;
  result := false;
end;

Dabei ist mir folgendes aufgefallen:
1. Es werden nicht alle Komponenten gefunden.
2. RegisterClass wird nicht aufgerufen, obwohl TForm von TPersistent abgeleitet ist.
Hier die Ausgabe der Procedure für Package dclstd70.bpl

Code:

Unit:FiltEdit - Klasse: TFilterEditor = class(TForm)
Unit:FiltEdit - Klasse: TFilterProperty = class(TStringProperty)
Unit:MaskText - Klasse: TMaskTextProperty = class(TStringProperty)
Unit:MaskText - Klasse: TMaskTextForm = class(TForm)
Unit:MaskProp - Klasse: TMaskProperty = class(TStringProperty)
Unit:MaskProp - Klasse: TMaskForm = class(TForm)
Unit:ItemEdit - Klasse: TItemInfo = class(TObject)
Unit:ItemEdit - Klasse: TListViewItems = class(TForm)
Unit:NodeEdit - Klasse: TTreeViewItems = class(TForm)
Unit:ImgEdit - Klasse: TImageInfo = class(TObject)
Unit:ImgEdit - Klasse: TImageListEditor = class(TForm)
Unit:NewStdAc - Klasse: TNewStdActionDlg = class(TForm)
Unit:ActnDrag - Klasse: TActionDragObject = class(TDragControlObject)
Unit:ActnEdit - Klasse: TActionImageListListener = class(TChangeLink)
Unit:ActnEdit - Klasse: TActionListDesigner = class(TToolbarDesignWindow)
Unit:ActnRes - Klasse: TStandardActions = class(TDataModule)
Unit:XPMan - Klasse: TXPManifest = class(TComponent)
Unit:SBarEdit - Klasse: TStatusBarEditor = class(TForm)
Unit:ColEdit - Klasse: TColInfo = class(TObject)
Unit:ColEdit - Klasse: TListViewColumns = class(TForm)
Unit:HCtlEdit - Klasse: THeaderControlEditor = class(TForm)
Unit:DdeReg - Klasse: TSrvrConvEdit = class(TDefaultEditor)
Unit:DdeReg - Klasse: TCliConvEdit = class(TDefaultEditor)
Unit:DdeReg - Klasse: TSrvrItemEdit = class(TDefaultEditor)
Unit:DdeReg - Klasse: TDdeLinkDlg = class(TForm)
Unit:DdeReg - Klasse: TDdeLinkInfoProperty = class(TPropertyEditor)
Unit:DdeReg - Klasse: TDdeClientItemProperty = class(TStringProperty)

In dem Package sind aber noch folgende Komponenten registriert:
TOpenDialog, TSaveDialog, TOpenPictureDialog, TSavePictureDialog, TFontDialog, TColorDialog, TPrintDialog, TPrinterSetupDialog, TFindDialog, TReplaceDialog, TPageSetupDialog, TTimer, TPaintBox, TMediaPlayer, TMainMenu, TPopupMenu, TLabel, TEdit, TMemo, TButton, TCheckBox, TRadioButton, TListBox, TComboBox, TScrollBar, TGroupBox, TRadioGroup, TPanel, TActionList, TBitBtn, TSpeedButton, TMaskEdit, TStringGrid, TDrawGrid, TImage, TShape, TBevel, TScrollBox, TCheckListBox, TSplitter, TStaticText, TControlBar, TApplicationEvents, TValueListEditor, TLabeledEdit, TColorBox, TTabControl, TPageControl, TImageList, TRichEdit, TTrackBar, TProgressBar, TUpDown, THotKey, TAnimate, TDateTimePicker, TMonthCalendar, TTreeView, TListView, THeaderControl, TStatusBar, TToolBar, TCoolBar, TPageScroller, TComboBoxEx, TXPManifest, TOleContainer, TCOMAdminCatalog, TDdeClientConv, TDdeClientItem, TDdeServerConv und TDdeServerItem

Für das Package dclsockets70.bpl zeigt mir Deine Funktion gar nichts an, aber es sind die Komponenten
TClientSocket und TServerSocket enthalten

[MaBuSE]

Gestern hatte ich noch eine Idee, die aber auch nicht funktioniert :-/

In jedem Package (das Komponenten enthällt) gibt es eine Unit, die eine Prozedur Register enthällt.
Diese Prozedur habe ich aufgerufen

Delphi-Quellcode:

...
  case NameType of
    ntContainsUnit    : begin
                          s := 'Unit: ';
                          s2 := LowerCase(Name);
                          s2[1] := UpCase(s2[1]);
                          @PRegister := GetProcAddress(PInteger(Param)^,
                            pchar('@'+s2+'@Register$qqrv'));
                          if @PRegister <> nil then
                          begin
                            s2 := name+'.Register;';
                            try
                              PRegister;  // <--- hier wird Register; aufgerufen !!!
                            except
                              on E: Exception do
                                s2 := s2 + ' fehlgeschlagen ('+E.Message+')';
                            end;
                          end
                          else s2:= '';
                        end;
...

In der Register; stehen für normalerweise die RegisterComponents(...) Aufrufe
Der Aufruf schlägt natürlich fehl, weil die Prozedur RegisterComponentsProc nur in der IDE gesetzt ist, zur Laufzeit ist sie nil.

Delphi-Quellcode:

  SRegisterError = 'Ungültige Komponentenregistrierung';
...
procedure RegisterComponents(const Page: string;
  const ComponentClasses: array of TComponentClass);
begin
  if Assigned(RegisterComponentsProc) then
    RegisterComponentsProc(Page, ComponentClasses)
  else
    raise EComponentError.CreateRes(@SRegisterError);
end;

Wenn man diese Prozedur zuweist, sollte es klappen:

Delphi-Quellcode:

procedure myTestProc(const Page: string; const ComponentClasses: array of TComponentClass);
begin
  Form1.Memo1.Lines.Add(Page); // Testweise nur die Palette ausgeben
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  bak : procedure(const Page: string; const ComponentClasses: array of TComponentClass);
begin
  bak := RegisterComponentsProc;
  RegisterComponentsProc := myTestProc;
  RegisterComponents('Test hat geklappt', [TComponent]);
  RegisterComponentsProc := bak;
end;

Es wird auch 'Test hat geklappt' im Memo ausgegeben -> es funktioniert

Also habe ich das PAckage geladen, die Register Procedure aufgerufen und ein 'Ungültige Komponentenregistrierung' Fehler bekommen. Das Memo bleibt leer. Das verbiegen des Zeigers hat wohl keine Auswirkungen auf das Package.

Wie macht das Delphi?

Ich kann das Package ja in der IDE Laden, und die Komponenten werden dann brav in der Palette angezeigt.

[maximov]

Zitat:

Zitat von MaBuSE

...
Im Memo steht nun eine Liste der eingebundenen Klassen.

Leider nur die von Projekt1.exe nicht die der Package, obwohl ich ein Package mit LoadPackage('dclsockets70.bpl'); geladen habe.
...

Das macht mich ein bischen stutzig, da ich davon ausgehe, das du das ModulHandle von 'dclsockets70.bpl' angegeben hast. Deine aussage lässt aber eher darauf schliessen, das dort das Handle des hauptmoduls angekommen ist. ?