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.