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