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.