Wie ermittelt man welche Komponenten in einem Package sind?

[negaH]

@Mabuse:

ok, das mein obiger Code nicht sofort funktioniert ist auch logisch, ich habe ihn hier einfach aus dem gedächtnis eingehämmert, da kann man sich mal irren. Öfters komme ich mit den verschiedenen aber ähnlichen Sprachen durcheinander. Zb. gerade jetzt arbeite ich mit VHDL und dieses ist in der Syntax ähnlich wie PASCAL aber eben nicht gleich, da kostet es schon Anstrengung das if then nicht als if end if; oder das case of end; nicht als case is when end case; zu schreiben sorry also:

dieser Code funktioniert bei mir super, und er extrahiert sogar noch den Unit Namen ohne deinen Trick:

Delphi-Quellcode:

uses BlaBla, TypInfo;

type
  TEnumTypeInfoCallback = function(UserData: Pointer; Info: PTypeInfo): Boolean; register;

function GetBaseOfCode(Module: hModule; var CodeStart, CodeEnd: PChar): Boolean;
asm // get Codesegment pointers, check if module is a valid PE
       PUSH  EDI
       PUSH  ESI
       AND   EAX,not 3
       JZ    @@2
       CMP   Word Ptr [EAX],'ZM';
       JNE   @@1
       MOV   ESI,[EAX + 03Ch]
       CMP   Word Ptr [ESI + EAX],'EP'
       JNE   @@1
       MOV   EDI,[EAX + ESI + 014h + 008h]
       ADD   EAX,[EAX + ESI + 014h + 018h]
       ADD   EDI,EAX
       MOV   [EDX],EAX
       MOV   [ECX],EDI
       XOR   EAX,EAX
@@1:   SETE  AL
@@2:   POP   ESI
       POP   EDI
end;

function EnumTypeInfo(Module: hModule; Callback: TEnumTypeInfoCallback; UserData: Pointer): PTypeInfo;
// copyright (c) 1998 Hagen Reddmann
var
  P,E,K,N: PChar; 
  L: Integer;
begin
  Result := nil;
  if Assigned(Callback) then 
  try
    if GetBaseOfCode(Module, P, E) then 
      while P < E do
      begin 
        DWord(P) := DWord(P) and not 3;
        K := P + 4; 
        if (PDWord(P)^ = DWord(K)) and (PByte(K)^ > 0)
        and (PByte(K)^ <= Integer(High(TTypeKind))) then // Info.Kind in ValidRange.D6
        begin
          L := PByte(K + 1)^;  // length Info.Name 
          N := K + 2;          // @Info.Name[1]
          if (L > 0) and (N^ in ['_', 'a'..'z', 'A'..'Z']) then  // valid ident ??
          begin
            repeat
              Inc(N);
              Dec(L);
            until (L = 0) or not (N^ in ['_', 'a'..'z', 'A'..'Z', '0'..'9']);
            if L = 0 then // length and ident valid
              if Callback(UserData, Pointer(K)) then // tell it and if needed abort iteration
              begin
                Result := Pointer(K);
                Exit;
              end else K := N;
          end;
        end;
        P := K;
      end;
  except
  end;
end;

function TForm1.DoEnumTypeInfo(Info: PTypeInfo): Boolean; register;

  function UnitName(Info: PTypeInfo): String;
  var
    Data: PTypeData;
  begin
    Data := GetTypeData(Info);
    case Info.Kind of
      tkClass: Result := Data.UnitName;
      tkInterface: Result := Data.IntfUnit;
      tkDynArray: Result := Data.DynUnitName;
   else
      Result := '';
    end;
  end;

var
  Prop: PPropList;
  Count,I: Integer;
begin
  Result := False;

  Memo.Lines.Add(Format('%:-40s: %-20s, %s->%s', [
                   Info.Name,
                   GetEnumName(TypeInfo(TTypeKind), Byte(Info.Kind)),
                   ExtractFileName(GetModuleName(FindHInstance(Info))),
                   UnitName(Info)]));
{
  if (Info.Kind = tkClass) and (GetTypeData(Info).PropCount > 0) then
  begin
    Count := GetPropList(Info, Prop);
    try
      for I := 0 to Count -1 do
        Memo.Lines.Add(Format('    %:-36s: %-20s', [
            Prop[I].Name,
            Prop[I].PropType^.Name]));
    finally
      FreeMem(Prop);
    end;
  end;  
}
end;

procedure TForm1.Button1Click(Sender: TObject);

  function MyEnumModule(Instance: Integer; Data: Pointer): Boolean;
  begin
    Result := EnumTypeInfo(Instance, @TForm1.DoEnumTypeInfo, Data) = nil;
  end;

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

Wie du auch siehst ist die Deklaration von TEnumModuleFunc durch Borland sehr unglücklich erfolgt. Besser wäre es wie in meiner Deklaration den UserData Paramater als ersten Parameter der Callback zu benutzen. So kann man nämlich diese Callbacks ohne Probleme als Methoden-Callback eines Objectes benutzen. Dazu muß UserData eben nur Self enthalten.

Angezeigt wird zb. nachfolgendes:

Code:

TForm1                                  : tkClass             , Project1.exe->Unit1
HWND                                    : tkInteger           , vcl70.bpl->
TOwnerDrawState                         : tkSet               , vcl70.bpl->
TColor                                  : tkInteger           , vcl70.bpl->
EInvalidGraphic                         : tkClass             , vcl70.bpl->Graphics
EInvalidGraphicOperation                : tkClass             , vcl70.bpl->Graphics
TFontPitch                              : tkEnumeration       , vcl70.bpl->
TFontName                               : tkLString           , vcl70.bpl->
TFontCharset                            : tkInteger           , vcl70.bpl->
TFontDataName                           : tkString            , vcl70.bpl->
TFontStyle                              : tkEnumeration       , vcl70.bpl->
TFontStyles                             : tkSet               , vcl70.bpl->
TFontStylesBase                         : tkSet               , vcl70.bpl->
TPenStyle                               : tkEnumeration       , vcl70.bpl->
TPenMode                                : tkEnumeration       , vcl70.bpl->
TBrushStyle                             : tkEnumeration       , vcl70.bpl->
TGraphicsObject                         : tkClass             , vcl70.bpl->Graphics
IChangeNotifier                         : tkInterface         , vcl70.bpl->Graphics
TPrinterCapabilities                    : tkSet               , vcl70.bpl->
TPrinter                                : tkClass             , vcl70.bpl->Printers
TPrinterCanvas                          : tkClass             , vcl70.bpl->Printers
TEdgeBorder                             : tkEnumeration       , vcl70.bpl->
TEdgeBorders                            : tkSet               , vcl70.bpl->
TEdgeStyle                              : tkEnumeration       , vcl70.bpl->
TToolWindow                             : tkClass             , vcl70.bpl->ToolWin
TToolDockObject                         : tkClass             , vcl70.bpl->ToolWin
TSizingOrientation                      : tkEnumeration       , vcl70.bpl->
TToolDockForm                           : tkClass             , vcl70.bpl->ToolWin
IShellFolder                            : tkInterface         , vcl70.bpl->ShlObj
IAutoComplete                           : tkInterface         , vcl70.bpl->ShlObj
TCommonDialog                           : tkClass             , vcl70.bpl->Dialogs
TOpenOption                             : tkEnumeration       , vcl70.bpl->
TOpenOptions                            : tkSet               , vcl70.bpl->
TOpenOptionEx                           : tkEnumeration       , vcl70.bpl->
TOpenOptionsEx                          : tkSet               , vcl70.bpl->
TFileEditStyle                          : tkEnumeration       , vcl70.bpl->

.....

ISecurityInfo                           : tkInterface         , rtl70.bpl->OleDB
ISecurityInfoSC                         : tkInterface         , rtl70.bpl->OleDB
IDBPromptInitialize                     : tkInterface         , rtl70.bpl->OleDB
IDBPromptInitializeSC                   : tkInterface         , rtl70.bpl->OleDB
IDataInitialize                         : tkInterface         , rtl70.bpl->OleDB
IDataInitializeSC                       : tkInterface         , rtl70.bpl->OleDB
THEMESIZE                               : tkEnumeration       , rtl70.bpl->
PROPERTYORIGIN                          : tkEnumeration       , rtl70.bpl->
TCustomZlibStream                       : tkClass             , rtl70.bpl->ZLib
TCompressionLevel                       : tkEnumeration       , rtl70.bpl->
TCompressionStream                      : tkClass             , rtl70.bpl->ZLib
TDecompressionStream                    : tkClass             , rtl70.bpl->ZLib
EZlibError                              : tkClass             , rtl70.bpl->ZLib
ECompressionError                       : tkClass             , rtl70.bpl->ZLib
EDecompressionError                     : tkClass             , rtl70.bpl->ZLib

Gruß Hagen

[MaBuSE]

Ersteinmal will ich mich für die viele Mühe bedanken:
Danke !!!

Zitat von negaH:

@Mabuse:
ok, das mein obiger Code nicht sofort funktioniert ist auch logisch, ich habe ihn hier einfach aus dem gedächtnis eingehämmert, da kann man sich mal irren. Öfters komme ich mit den verschiedenen aber ähnlichen Sprachen durcheinander. Zb. gerade jetzt arbeite ich mit VHDL und dieses ist in der Syntax ähnlich wie PASCAL aber eben nicht gleich, da kostet es schon Anstrengung das if then nicht als if end if; oder das case of end; nicht als case is when end case; zu schreiben sorry also:

Das dachte ich mir, und deshalb habe ich ihn ja angepasst, ich wollte nur wissen, ob ich es richtig gemacht habe

Zitat von negaH:

dieser Code funktioniert bei mir super, und er extrahiert sogar noch den Unit Namen ohne deinen Trick:

...Quellcode...

Wie du auch siehst ist die Deklaration von TEnumModuleFunc durch Borland sehr unglücklich erfolgt. Besser wäre es wie in meiner Deklaration den UserData Paramater als ersten Parameter der Callback zu benutzen. So kann man nämlich diese Callbacks ohne Probleme als Methoden-Callback eines Objectes benutzen. Dazu muß UserData eben nur Self enthalten.

Angezeigt wird zb. nachfolgendes:

Code:

TForm1                                  : tkClass             , Project1.exe->Unit1
HWND                                    : tkInteger           , vcl70.bpl->
TOwnerDrawState                         : tkSet               , vcl70.bpl->
TColor                                  : tkInteger           , vcl70.bpl->
EInvalidGraphic                         : tkClass             , vcl70.bpl->Graphics
...

Bei mir zeigt er alles im Kontext von Projekt1.exe an.

Code:

Boolean                                 : tkEnumeration       , Project1.exe->
Char                                    : tkChar              , Project1.exe->
Integer                                 : tkInteger           , Project1.exe->
Byte                                    : tkInteger           , Project1.exe->
Word                                    : tkInteger           , Project1.exe->
Cardinal                                : tkInteger           , Project1.exe->
String                                  : tkLString           , Project1.exe->
TObject                                 : tkClass             , Project1.exe->System
IInterface                              : tkInterface         , Project1.exe->System
TOwnerDrawState                         : tkSet               , Project1.exe->
TErrorRec                               : tkRecord            , Project1.exe->
TExceptRec                              : tkRecord            , Project1.exe->
TCustomVariantType                      : tkClass             , Project1.exe->Variants
TTypeKind                               : tkEnumeration       , Project1.exe->
TAlignment                              : tkEnumeration       , Project1.exe->
TBiDiMode                               : tkEnumeration       , Project1.exe->
TShiftState                             : tkSet               , Project1.exe->
THelpContext                            : tkInteger           , Project1.exe->
THelpType                               : tkEnumeration       , Project1.exe->
TShortCut                               : tkInteger           , Project1.exe->
TNotifyEvent                            : tkMethod            , Project1.exe->
TPersistent                             : tkClass             , Project1.exe->Classes
TInterfacedPersistent                   : tkClass             , Project1.exe->Classes
IStringsAdapter                         : tkInterface         , Project1.exe->Classes
TStrings                                : tkClass             , Project1.exe->Classes
TStringItem                             : tkRecord            , Project1.exe->
TStringList                             : tkClass             , Project1.exe->Classes
TComponentName                          : tkLString           , Project1.exe->
IDesignerNotify                         : tkInterface         , Project1.exe->Classes
TComponent                              : tkClass             , Project1.exe->Classes
TBasicAction                            : tkClass             , Project1.exe->Classes
TIdentMapEntry                          : tkRecord            , Project1.exe->
TColor                                  : tkInteger           , Project1.exe->
TFontPitch                              : tkEnumeration       , Project1.exe->
TFontName                               : tkLString           , Project1.exe->
...
THelpEvent                              : tkMethod            , Project1.exe->
TCustomForm                             : tkClass             , Project1.exe->Forms
TForm                                   : tkClass             , Project1.exe->Forms
TCustomDockForm                         : tkClass             , Project1.exe->Forms
TScreen                                 : tkClass             , Project1.exe->Forms
THintInfo                               : tkRecord            , Project1.exe->
TApplication                            : tkClass             , Project1.exe->Forms
TForm2                                  : tkClass             , Project1.exe->Unit2
TForm1                                  : tkClass             , Project1.exe->Unit1

Ich versuche im Programm eine BPL zu laden.
  LoadPackage('c:\Programme\Borland\Delphi7\Bin\dclSockets70.bpl'); Diese BPL will ich nun untersuchen.

Die erscheint in obiger Liste gar nicht, obwohl sie doch geladen wurde.

Aber ich glaube wir haben etwas aneinander vorbei geredet (geschrieben ):

Die BPL ist nicht in mein Programm (Listing 1. Beitrag) compiliert.
(Sie wird via TOpenDialog zur Laufzeit ausgewählt)

Mit GetPackageDescription bekomme ich die Beschreibung
(z.B. bei dclSockets70.bpl: "Borland Socket-Komponenten")

Mit GetPackageInfo bekomme ich die von dem Package benötigten Packages
(z.B. bei dclSockets70.bpl: "rtl70.bpl")

Mit GetPackageInfo bekomme ich die von dem Package benutzten Units (dcu Dateien)
(z.B. bei dclSockets70.bpl: "dclsockets, SocketsReg, SysInit")

In der Callback Prozedur ermittele ich auch noch ob eine "procedure Register;" vorhanden ist
(z.B. bei dclSockets70.bpl: "SocketsReg.Register;")

Die DelphiIDE ruft diese Register Prozedur auf und initialisiert damit die Komponenten.
(z.B.

Delphi-Quellcode:

procedure Register;
begin
  RegisterComponents('Internet', [TClientSocket, TServerSocket]);
end;

)

Ich will also ein beliebiges Package öffnen und ermitteln welche Komponenten dort drin sind.

Mein Tool gibt nun folgendes aus:

Code:

Dateiname: c:\Programme\Borland\Delphi7\Bin\dclsockets70.bpl
  Package Name: Borland Socket-Komponenten
  Flags: 00 - benötigt Package: rtl70.bpl
  Flags: 03 - Unit: dclsockets
  Flags: 00 - Unit: SocketsReg
               SocketsReg.Register;
  Flags: 00 - Unit: SysInit
  Flags: 00 - PackageName: dclsockets

Was mit fehlt ist nun das in der dclSockets70.bpl folgende Komponenten enthalten sind:

Code:

TClientSocket, TServerSocket

Hat jemand eine Idee?

[Stevie]

Kann es sein, dass du dein Programm mit der "Mit Laufzeit-Packages aktualisieren"-Option erstellen musst, damit dein Vorhaben funktioniert?

[MaBuSE]

Zitat von Stevie:

Kann es sein, dass du dein Programm mit der "Mit Laufzeit-Packages aktualisieren"-Option erstellen musst, damit dein Vorhaben funktioniert?

Habe ich schon mit und ohne probiert.
(Hagens Ansatz habe ich noch nicht damit probiert...)

[edit]
nun gibt Hagens Lösung auch das von Ihm gewünschte Ergebnis:

Code:

TForm2                                  : tkClass             , Project1.exe->Unit2
TForm1                                  : tkClass             , Project1.exe->Unit1
HWND                                    : tkInteger           , vcl70.bpl->
TOwnerDrawState                         : tkSet               , vcl70.bpl->
TColor                                  : tkInteger           , vcl70.bpl->
EInvalidGraphic                         : tkClass             , vcl70.bpl->Graphics
EInvalidGraphicOperation                : tkClass             , vcl70.bpl->Graphics
TFontPitch                              : tkEnumeration       , vcl70.bpl->
...

Aber das ist ja nicht das was ich will. Mein Package wird immer noch nicht in der Liste angezeigt
[/edit]

[edit & OT] Ich bin nun im Wochenende, ich schau heute Abend / Morgen vormittag noch mal vorbei...[/edit]

[maximov]

Moin,

aber wenn du mit
function LoadPackage(const Name: string): HMODULE; dann bekommst du doch genau das Handle, was du bei der suche angeben solltest!?

Delphi-Quellcode:

var Module:HMODULE;
...
EnumTypeInfo(Module,RegClassesHandler,nil);

Naja, wer nicht hören will...


PS: mit den laufzeit-packages hat das IMO nix zu tun, denn die werden ja ins hauptmodul eingebunden. Zumindest ist das in diesen zusammenhang witzlos, da ja dynamisch geladen werden soll.

[negaH]

LoadPackage() wird bei seiner Methode schon fehlschlagen, d.h. der Rückgabewert wird schon INVALID_HANDLE_VALUE oder 0 oder -1 sein aber kein gültiges Modul.

Du kannst in deine Anwendung kein Package laden das selber wiederum das VCL Package benötigt in dem selber wiederum die Units Classes, Forms ect. pp. gelinkt wurden.

Deine Anwendung MUSS mit Laufzeitpackage compiliert werden, anders ginge es nur wenn du das Package mit LoadLibrary() lädst. Aber NUR so LoadLibrary('Package.bpl', LOAD_LIBRARY_AS_DATAFILE) und dann dieses Handle meiner EnumTypeInfo() Funktion direkt übergibst.

Gruß Hagen

[negaH]

So wie nachfolgend geht es auch mit einer EXE die ohne Laufzeitpackages compiliert wurde.

Delphi-Quellcode:

procedure TForm1.Button2Click(Sender: TObject);
var
  Module: hModule;
begin
  Module := LoadLibrary('VCLDB70.bpl');
  if Module <> INVALID_HANDLE_VALUE then
  try
    Memo.Lines.BeginUpdate;
    try
      Memo.Clear;
      EnumTypeInfo(Module, @TForm1.DoEnumTypeInfo, Self);
    finally
      Memo.Lines.EndUpdate;
    end;
  finally
    FreeLibrary(Module);
  end;
end;

Wichtig ist nur das du nicht LoadPackage() benutzt da diese Funktion intern viel mehr Überprüfungen durchführt. Mit LoadPackage() können nur Packages geladen und initialisiert werden die unterschiedliche Units zu den schon geladenen Modulen enthalten.

Gruß Hagen

[MaBuSE]

Zitat von negaH:

So wie nachfolgend geht es auch mit einer EXE die ohne Laufzeitpackages compiliert wurde.

Delphi-Quellcode:

...
  Module := LoadLibrary('VCLDB70.bpl');
...

Wichtig ist nur das du nicht LoadPackage() benutzt da diese Funktion intern viel mehr Überprüfungen durchführt. Mit LoadPackage() können nur Packages geladen und initialisiert werden die unterschiedliche Units zu den schon geladenen Modulen enthalten.

Ich hatte mit LoafPackage keine Probleme.
Aber mit LoadLibrary funktioniert es auch nicht so recht.

Probier mal bitte das Package dclSockets70.bpl aus.
Es sind 2 Komponenten enthalten. Keine wird angezeigt.

Probier mal dclstd70.bpl aus
Es werden einige Klassen angezeigt, aber eben nicht alle.
Vor allem nicht die Komponenten:
[equote="MaBuSE schrieb in http://www.delphipraxis.net/internal...=356197#356197 "]Mein Versuch gestern mit Deiner Unit brachten mich etwas weiter.
...
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[/equote]

[MaBuSE]

Hier ist ein kleines Beispielprogramm um das mal auszuprobieren:

[negaH]

Vergiss es, das was du vorhast kann nicht funktionieren. Du versucht die Packages der Delphi IDE zu laden, diese können aber nur innerhalb vom Delphi selber geladen und benutzt werden.

Erkläre mal was du überhaupt vor hast, denn so wie ich das sehe läuft es auf einen Verstoß gegen die Lizenzbestimmungen hinaus.

Gruß Hagen