Delphi-PRAXiS - Delphi Ressourcen aus anderen Pe Dateien auslesen

Seite 1 von 2

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)

- Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)

- - Delphi Ressourcen aus anderen Pe Dateien auslesen (https://www.delphipraxis.net/120889-ressourcen-aus-anderen-pe-dateien-auslesen.html)

Ressourcen aus anderen Pe Dateien auslesen

Hi,
ich habe in der Codelib folgenden Code gefunden:

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.

Kann mir jemand sagen wie ich den umändern muss das ich den auch in "Grafischen" Anweundungen von mir also mit ganz normalen Forms ohne Konsole verwenden kann. Wenn ich manche Sachen übernehm kommt es nämlich zu Fehlern.

MFG Lars Wiltfang