Ressourcen in fremden PE-Dateien auflisten

[Olli]

Dieses Programm nimmt als Parameter den Dateinamen einer PE-Datei entgegen und gibt die enthaltenen Ressourcen mit Typ, Namen und verfügbaren Sprachen aus.
Da für Stringtables eine spezielle Behandlung nötig ist, ist dies noch nicht implementiert. Allerdings habe ich das schon einmal in einem anderen Thema erklärt, wo Luckie dazu nachfragte.
Wenn ich genug Zeit finde, werde ich das Programm noch so updaten, daß es auch die Stringtables sauber auflistet.

Dieser Quelltext ist hiermit gemeinfrei (Public Domain). Das bedeutet, daß er frei und völlig ohne jegliche Beschränkungen irgendwelcher Natur verwendet werden darf. Es wäre natürlich nett mich zu erwähnen, jedoch ist es keine Bedinung sondern höchstens Höflichkeit. Abgesehen davon muß ich jegliche Gewährleistungen und Garantien im Zusammenhang mit dem Code ausschließen. Mit der Verwendung erklärt ihr auch also einverstanden, daß ich für keine entstehenden Schäden durch den Code haftbar gemacht werden kann.

Delphi-Quellcode:

program ResLister;
{$APPTYPE CONSOLE}
uses
  Windows,
  SysUtils;

const
  // Nicht in Delphi 4 deklariert.
  RT_HTML = PChar(23);
  RT_MANIFEST = PChar(24);

var
  // Mappingliste von Typen zu Namen
  ResourceTypeDefaultNames: array[0..20] of record
    ResType: PChar;
    ResTypeName: string;
  end = (
    (ResType: RT_ACCELERATOR; ResTypeName: 'RT_ACCELERATOR'; ),
    (ResType: RT_ANICURSOR; ResTypeName: 'RT_ANICURSOR'; ),
    (ResType: RT_ANIICON; ResTypeName: 'RT_ANIICON'; ),
    (ResType: RT_BITMAP; ResTypeName: 'RT_BITMAP'; ),
    (ResType: RT_CURSOR; ResTypeName: 'RT_CURSOR'; ),
    (ResType: RT_DIALOG; ResTypeName: 'RT_DIALOG'; ),
    (ResType: RT_DLGINCLUDE; ResTypeName: 'RT_DLGINCLUDE'; ),
    (ResType: RT_FONT; ResTypeName: 'RT_FONT'; ),
    (ResType: RT_FONTDIR; ResTypeName: 'RT_FONTDIR'; ),
    (ResType: RT_GROUP_CURSOR; ResTypeName: 'RT_GROUP_CURSOR'; ),
    (ResType: RT_GROUP_ICON; ResTypeName: 'RT_GROUP_ICON'; ),
    (ResType: RT_HTML; ResTypeName: 'RT_HTML'; ),
    (ResType: RT_ICON; ResTypeName: 'RT_ICON'; ),
    (ResType: RT_MANIFEST; ResTypeName: 'RT_MANIFEST'; ),
    (ResType: RT_MENU; ResTypeName: 'RT_MENU'; ),
    (ResType: RT_MESSAGETABLE; ResTypeName: 'RT_MESSAGETABLE'; ),
    (ResType: RT_PLUGPLAY; ResTypeName: 'RT_PLUGPLAY'; ),
    (ResType: RT_RCDATA; ResTypeName: 'RT_RCDATA'; ),
    (ResType: RT_STRING; ResTypeName: 'RT_STRING'; ),
    (ResType: RT_VERSION; ResTypeName: 'RT_VERSION'; ),
    (ResType: RT_VXD; ResTypeName: 'RT_VXD'; )
    );

(******************************************************************************
 ** GetEnglishLangName (Hilfsfunktion)
 **
 ** Diese Hilfsfunktion holt den Namen der als LANGID übergebenen Sprache auf
 ** Englisch und gibt sie als String zurück.
 ******************************************************************************)

function GetEnglishLangName(langid: LANGID): string;
var
  len: Integer;
  lcid: DWORD;
begin
  lcid := DWORD(langid or (SORT_DEFAULT shl 16)); // MAKELCID
  len := GetLocaleInfoA(lcid, LOCALE_SENGLANGUAGE, nil, 0);
  SetLength(Result, len);
  GetLocaleInfoA(lcid, LOCALE_SENGLANGUAGE, @Result[1], len);
end;

(******************************************************************************
 ** IS_INTRESOURCE (Hilfsfunktion)
 **
 ** Diese Hilfsfunktion überprüft, ob es sich bei einem Ressourcentypnamen um
 ** einen Integertypen oder einen Stringtypen handelt. Ist es ein Integertyp, so
 ** wird True zurückgegeben, ansonsten False.
 ******************************************************************************)

function IS_INTRESOURCE(lpszType: PChar): Boolean;
begin
  Result := ((DWORD(lpszType) shr 16) = 0);
end;

(******************************************************************************
 ** ResourceTypes (Hilfsfunktion)
 **
 ** Diese Hilfsfunktion erzeugt aus dem übergenen Ressourentypnamen eine lesbare
 ** Form. Dies schließt Integertypnamen ein.
 ** Sollte es sich um einen der Standardtypen handeln, so wird an die numerische
 ** Form des Ressourcentypnamen noch der Name der Konstante in Klammern
 ** angehangen.
 ******************************************************************************)

function ResourceTypes(lpszType: PChar): string;
var
  i: Integer;
begin
  if (IS_INTRESOURCE(lpszType)) then
    Result := Format('#%d', [Word(lpszType)])
  else
    Result := Format('%s', [string(lpszType)]);
  for i := 0 to Length(ResourceTypeDefaultNames) - 1 do
  begin
    if (MAKEINTRESOURCE(lpszType) = MAKEINTRESOURCE(ResourceTypeDefaultNames[i].ResType)) then
    begin
      Result := Result + Format(' (%s)', [ResourceTypeDefaultNames[i].ResTypeName]);
      Break;
    end;
  end;
end;

(******************************************************************************
 ** EnumResLangProc
 **
 ** Eine Callback-Funktion, welche für jeden im Modul enthaltenen Ressourcentyp
 ** pro enthaltenem Ressourcennamen so oft aufgerufen wird, wie es Sprachen
 ** gibt, in denen die Ressource verfügbar ist.
 **
 ** Die Funktion ihrerseits gibt den aktuellen Sprachcode aus.
 ******************************************************************************)

function EnumResLangProcA(hModule: HINST; lpszType: PChar; lpszName: PChar; wIDLanguage: Word; lParam: LPARAM): BOOL; stdcall;
begin
  Writeln(Format(#9'%4.4X - %s', [wIDLanguage, GetEnglishLangName(wIDLanguage)]));
  Result := True;
end;

(******************************************************************************
 ** EnumResNameProc
 **
 ** Eine Callback-Funktion, welche für jeden im Modul enthaltenen Ressourcentyp
 ** pro enthaltenem Ressourcennamen einmal aufgerufen wird.
 **
 ** Die Funktion ihrerseits gibt den Namen der Ressource aus und ermittelt die
 ** Sprachcodes (LANGID) der Sprachen in welchen die Ressource verfügbar ist
 ** durch Aufruf einer weiteren Enumerierungsfunktion EnumResLangProc().
 ******************************************************************************)

function EnumResNameProcA(hModule: HINST; lpszType: PChar; lpszName: PChar; lParam: LPARAM): BOOL; stdcall;
begin
  // Teste auf Integer statt Namen
  if (IS_INTRESOURCE(lpszName)) then
    Writeln(Format(' -> #%d', [Word(lpszName)]))
  // Ansonsten normal als String behandeln
  else
    Writeln(Format(' -> %s', [string(lpszName)]));
  EnumResourceLanguagesA(hModule, lpszType, lpszName, @EnumResLangProcA, 0);
  Result := True;
end;

(******************************************************************************
 ** EnumResTypeProc
 **
 ** Eine Callback-Funktion, welche für jeden im Modul enthaltenen Ressourcentyp
 ** einmal aufgerufen wird.
 **
 ** Die Funktion ihrerseits wandelt den Typennamen in eine lesbare Form um und
 ** ruft dann eine weitere Enumerierungsfunktion (und damit Callbackfunktion)
 ** auf, die die Namen der eigentlichen Ressourcen auflistet.
 ******************************************************************************)

function EnumResTypeProcA(hModule: HINST; lpszType: PChar; lParam: LPARAM): BOOL; stdcall;
begin
  Writeln('RESOURCE TYPE: ', ResourceTypes(lpszType));
  EnumResourceNamesA(hModule, lpszType, @EnumResNameProcA, 0);
  Result := True;
end;

(******************************************************************************
 ** ListResources
 **
 ** Nimmt den Dateinamen der EXE oder DLL (oder anderen PE-Datei) entgegen.
 **
 ** Danach ruft diese Funktion eine Enumerierungsfunktion auf, welche alle im
 ** Modul vorhandenen Ressourcentypen auflistet. Die übergebene Callbackfunktion
 ** EnumResTypeProc() ist für die weitere Verarbeitung zuständig.
 ******************************************************************************)

procedure ListResources(filename: string);
var
  hModule: HINST;
begin
  hModule := LoadLibraryEx(@filename[1], 0, LOAD_LIBRARY_AS_DATAFILE);
  if (hModule <> 0) then
  try
    EnumResourceTypesA(hModule, @EnumResTypeProcA, 0);
  finally
    FreeLibrary(hModule);
  end;
end;

(******************************************************************************
 ** Hauptfunktion
 **
 ** Überprüft die Parameter und gibt ggf. einen Syntaxhinweis aus. Ansonsten
 ** wird die zum Auflisten der Ressourcen zuständige Funktion aufgerufen!
 ******************************************************************************)
begin
  if (ParamCount() < 1) then
  begin
    Writeln(Format('Syntax: %s <Filename>', [ParamStr(0)]));
    Exit;
  end;
  if (FileExists(ParamStr(1))) then
  begin
    ListResources(ParamStr(1));
  end
  else
  begin
    Writeln('The given file does not exist.');
  end;
end.

EDIT #1: Stringtable-Blöcke nun korrekt
EDIT #2: Public Domain
EDIT #3: shmias Einwand eingearbeitet

[edit=Chakotay1308]"[PD]" aus Titel entfernt. Mfg, Chakotay1308[/edit]