IconIndex aus "DefaultIcon"-Eintrag in der Registry...

[FriFra]

Um an den genauen "Ort" des verwendeten Icons zu gelangen lese ich den Wert "DefaultIcon" des bettr. Dateitypen aus.
Da komme ich dann an Werte wie: '%systemroot%/system32/shell32.dll,-110'
Wie in meinem Beispiel, ist der "IconIndex" manchmal negativ...
Es gibt natürlich keinen negativen Iconindex, deshalb habe ich mal etwas herumprobiert und festgestell, dass man bei den negativen Werten "immer" 224 dazu zählen muss, d.h. in meinem Beispiel entspricht -110 eigentlich der Iconresource an Position 114
Ist der Index Positiv übernehme ich ihn immer 1:1

Bisher funktioniert das bei mir zuverlässig. ABER kann ich mich darauf verlassen, das jeder negative Iconindex + 224 immer den korrekten Wert liefert? Wo ist das definiert?

[Klaus01]

Vielleicht trägt dies ja etwas zu Klärung bei?

Zitat:

Icon indices are 0 based. Negative numbers can be used as well if you want to specify one of the last icons in the file. However negative indices may cause future problems if the icon source is extended to contain more icons in a future version (the actual icon index will change).

Grüße
Klaus

[mpth]

wenn ich mich recht entsinne, bedeutet ein negativer wert bei defaulticon, dass nicht der index zum symbol, sondern seine resource id gemeint ist, also bei -110 nicht das 111. symbol in der shell32.dll, sondern das symbol in shell32.dll mit dem resource identifier 110. da kannst du dich also nicht drauf verlassen, dass das auch bei späteren windows-versionen mit der addition von 224 noch passt...

[FriFra]

Ich lese aber alle ResourcenIdentifier mit EnumResources in eine StringList ein und genau dadurch bin ich doch auf die 224 gekommen, eben weil die -110 eben weder dem Iconindex, noch dem IdentifierIndex entspricht. nach der Addition passt es , allerdings frage ich mich schon: warum 224?

[mpth]

EnumResources? kenn ich so gar nicht... meinst du IShellItem.EnumResources?

//edit
meinte natürlich IShellItemResources.EnumResources

[FriFra]

Zitat von mpth:

EnumResources? kenn ich so gar nicht... meinst du IShellItem.EnumResources?

Ich hänge am besten mal die komplette Funktion an, wo ich das ganze benötige. Der relevante Teil ist allerdings ziemlich weit unten

Delphi-Quellcode:

function SaveApplicationIconGroup(icofile: PChar; exefile: PChar): Boolean;
  function GetProgramAssociation(Ext: string): string;
  var
    reg: TRegistry;
    r, s: string;
    Buffer: array[0..MAX_PATH] of Char;
  begin
    s := '';
    reg := TRegistry.Create;
    reg.RootKey := HKEY_CLASSES_ROOT;
    if reg.OpenKey(ext + '\DefaultIcon', false) <> false then
    begin
      s := reg.ReadString('');
      reg.CloseKey;
    end
    else
    begin
      if reg.OpenKey(ext, false) <> false then
      begin
        s := reg.ReadString('');
        reg.CloseKey;
        if s <> '' then
        begin
          if reg.OpenKey(s + '\DefaultIcon', false) <> false then
            s := reg.ReadString('');
          reg.CloseKey;
        end;
      end;
    end;
    if Pos('%', s) = 1 then
    begin
      r := Copy(s, 2, Length(s));
      if Pos('%', r) > 0 then
      begin
        r := Copy(r, 1, Pos('%', r) - 1);
        GetEnvironmentVariable(PChar(r), Buffer, MAX_PATH);
        s := Copy(s, Length(r) + 3, Length(s));
        r := Buffer;
        s := r + s;
      end;
    end;
    if Pos('%', s) > 0 then
      Delete(s, Pos('%', s), length(s));
    if ((length(s) > 0) and (s[1] = '"')) then
      Delete(s, 1, 1);
    if ((length(s) > 0) and (s[length(s)] = '"')) then
      Delete(s, Length(s), 1);
    while ((length(s) > 0) and ((s[length(s)] = #32) or (s[length(s)] = '"')))
      do
      Delete(s, Length(s), 1);
    reg.Free;
    result := s;
  end;
  function EnumResourceNamesProc(Module: HMODULE; ResType: PChar; ResName:
    PChar; lParam: TStringList): Integer; stdcall;
  var
    ResourceName: string;
  begin
    if hiword(Cardinal(ResName)) = 0 then
    begin
      ResourceName := IntToStr(loword(Cardinal(ResName)));
    end
    else
    begin
      ResourceName := ResName;
    end;
    lParam.Add(ResourceName);
    Result := 1;
  end;
  function ExtractIconFromFile(ResFileName: string; IcoFileName: string; nIndex:
    string): Boolean;

  type
    PMEMICONDIRENTRY = ^TMEMICONDIRENTRY;
    TMEMICONDIRENTRY = packed record
      bWidth: Byte;
      bHeight: Byte;
      bColorCount: Byte;
      bReserved: Byte;
      wPlanes: Word;
      wBitCount: Word;
      dwBytesInRes: DWORD;
      nID: Word;
    end;
  type
    PMEMICONDIR = ^TMEMICONDIR;
    TMEMICONDIR = packed record
      idReserved: Word;
      idType: Word;
      idCount: Word;
      idEntries: array[0..15] of TMEMICONDIRENTRY;
    end;
  type
    PICONDIRENTRY = ^TICONDIRENTRY;
    TICONDIRENTRY = packed record
      bWidth: Byte;
      bHeight: Byte;
      bColorCount: Byte;
      bReserved: Byte;
      wPlanes: Word;
      wBitCount: Word;
      dwBytesInRes: DWORD;
      dwImageOffset: DWORD;
    end;
  type
    PICONIMAGE = ^TICONIMAGE;
    TICONIMAGE = packed record
      Width,
        Height,
        Colors: UINT;
      lpBits: Pointer;
      dwNumBytes: DWORD;
      pBmpInfo: PBitmapInfo;
    end;
  type
    PICONRESOURCE = ^TICONRESOURCE;
    TICONRESOURCE = packed record
      nNumImages: UINT;
      IconImages: array[0..15] of TICONIMAGE;
    end;
    function AdjustIconImagePointers(lpImage: PICONIMAGE): Bool;
    begin
      if lpImage = nil then
      begin
        Result := False;
        exit;
      end;
      lpImage.pBmpInfo := PBitMapInfo(lpImage^.lpBits);
      lpImage.Width := lpImage^.pBmpInfo^.bmiHeader.biWidth;
      lpImage.Height := (lpImage^.pBmpInfo^.bmiHeader.biHeight) div 2;
      lpImage.Colors := lpImage^.pBmpInfo^.bmiHeader.biPlanes *
        lpImage^.pBmpInfo^.bmiHeader.biBitCount;
      Result := true;
    end;
    function WriteICOHeader(hFile: THandle; nNumEntries: UINT): Boolean;
    type
      TFIcoHeader = record
        wReserved: WORD;
        wType: WORD;
        wNumEntries: WORD;
      end;
    var
      IcoHeader: TFIcoHeader;
      dwBytesWritten: DWORD;
    begin
      Result := False;
      IcoHeader.wReserved := 0;
      IcoHeader.wType := 1;
      IcoHeader.wNumEntries := WORD(nNumEntries);
      if not WriteFile(hFile, IcoHeader, SizeOf(IcoHeader), dwBytesWritten, nil)
        then
      begin
        MessageBox(0, pchar(SysErrorMessage(GetLastError)), 'Error',
          MB_ICONERROR);
        Result := False;
        Exit;
      end;
      if dwBytesWritten <> SizeOf(IcoHeader) then
        Exit;
      Result := True;
    end;
    function CalculateImageOffset(lpIR: PICONRESOURCE; nIndex: UINT): DWORD;
    var
      dwSize: DWORD;
      i: Integer;
    begin
      dwSize := 3 * SizeOf(WORD);
      inc(dwSize, lpIR.nNumImages * SizeOf(TICONDIRENTRY));
      for i := 0 to nIndex - 1 do
        inc(dwSize, lpIR.IconImages[i].dwNumBytes);
      Result := dwSize;
    end;
    function WriteIconResourceToFile(hFile: hwnd; lpIR: PICONRESOURCE): Boolean;
    var
      i: UINT;
      dwBytesWritten: DWORD;
      ide: TICONDIRENTRY;
      dwTemp: DWORD;
    begin
      Result := False;
      for i := 0 to lpIR^.nNumImages - 1 do
      begin
        /// Convert internal format to ICONDIRENTRY
        ide.bWidth := lpIR^.IconImages[i].Width;
        ide.bHeight := lpIR^.IconImages[i].Height;
        ide.bReserved := 0;
        ide.wPlanes := lpIR^.IconImages[i].pBmpInfo.bmiHeader.biPlanes;
        ide.wBitCount := lpIR^.IconImages[i].pBmpInfo.bmiHeader.biBitCount;
        if ide.wPlanes * ide.wBitCount >= 8 then
          ide.bColorCount := 0
        else
          ide.bColorCount := 1 shl (ide.wPlanes * ide.wBitCount);
        ide.dwBytesInRes := lpIR^.IconImages[i].dwNumBytes;
        ide.dwImageOffset := CalculateImageOffset(lpIR, i);
        if not WriteFile(hFile, ide, sizeof(TICONDIRENTRY), dwBytesWritten, nil)
          then
          Exit;
        if dwBytesWritten <> sizeof(TICONDIRENTRY) then
          Exit;
      end;
      for i := 0 to lpIR^.nNumImages - 1 do
      begin
        dwTemp := lpIR^.IconImages[i].pBmpInfo^.bmiHeader.biSizeImage;
        lpIR^.IconImages[i].pBmpInfo^.bmiHeader.biSizeImage := 0;
        if not WriteFile(hFile, lpIR^.IconImages[i].lpBits^,
          lpIR^.IconImages[i].dwNumBytes, dwBytesWritten, nil) then
          Exit;
        if dwBytesWritten <> lpIR^.IconImages[i].dwNumBytes then
          Exit;
        lpIR^.IconImages[i].pBmpInfo^.bmiHeader.biSizeImage := dwTemp;
      end;
      Result := True;
    end;

  var
    h: HMODULE;
    lpMemIcon: PMEMICONDIR;
    lpIR: TICONRESOURCE;
    src: HRSRC;
    Global: HGLOBAL;
    i: integer;
    hFile: hwnd;
  begin
    Result := False;
    hFile := CreateFile(pchar(IcoFileName), GENERIC_WRITE, 0, nil,
      CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
    if hFile = INVALID_HANDLE_VALUE then
      Exit;
    h := LoadLibraryEx(pchar(ResFileName), 0, LOAD_LIBRARY_AS_DATAFILE);
    if h = 0 then
      exit;
    try
      src := FindResource(h, pchar(nIndex), RT_GROUP_ICON);
      if src = 0 then
        Src := FindResource(h, Pointer(StrToInt(nIndex)), RT_GROUP_ICON);
      if src <> 0 then
      begin
        Global := LoadResource(h, src);
        if Global <> 0 then
        begin
          lpMemIcon := LockResource(Global);
          if Global <> 0 then
          begin
            try
              lpIR.nNumImages := lpMemIcon.idCount;
              // Write the header
              for i := 0 to lpMemIcon^.idCount - 1 do
              begin
                src := FindResource(h,
                  MakeIntResource(lpMemIcon^.idEntries[i].nID), RT_ICON);
                if src <> 0 then
                begin
                  Global := LoadResource(h, src);
                  if Global <> 0 then
                  begin
                    try
                      lpIR.IconImages[i].dwNumBytes := SizeofResource(h, src);
                    except
                      MessageBox(0, PChar('Unable to Read Icon'), 'NTPacker',
                        MB_ICONERROR);
                      Result := False;
                      ExitProcess(0);
                    end;
                    GetMem(lpIR.IconImages[i].lpBits,
                      lpIR.IconImages[i].dwNumBytes);
                    CopyMemory(lpIR.IconImages[i].lpBits, LockResource(Global),
                      lpIR.IconImages[i].dwNumBytes);
                    if not AdjustIconImagePointers(@(lpIR.IconImages[i])) then
                      exit;
                  end;
                end;
              end;
              if WriteICOHeader(hFile, lpIR.nNumImages) then
                if WriteIconResourceToFile(hFile, @lpIR) then
                  Result := True;
            finally
              for i := 0 to lpIR.nNumImages - 1 do
                if assigned(lpIR.IconImages[i].lpBits) then
                  FreeMem(lpIR.IconImages[i].lpBits);
            end;
          end;
        end;
      end;
    finally
      FreeLibrary(h);
    end;
    CloseHandle(hFile);
  end;
var
  hExe: THandle;
  i: Integer;
  SL: TStringList;
  Tmp1, Tmp2: string;
  index: Word;
  myexefile: PChar;
begin
  index := 0;
  Tmp1 := exefile;
  myexefile := #0;
  myexefile := PChar(Tmp1);

  { Hier versuche ich bei NICHT-EXEn doch an das vollständige Icon zu kommen... }
  if LowerCase(ExtractFileExt(myexefile)) <> '.exe' then
  begin
    myexefile := PChar(GetProgramAssociation(ExtractFileExt(myexefile)));
    if Pos(',', myexefile) > 0 then
    begin
      Tmp1 := myexefile;
      Tmp2 := Trim(Copy(Tmp1, Pos(',', Tmp1) + 1, Length(Tmp1)));
      Tmp1 := Trim(Copy(Tmp1, 1, Pos(',', Tmp1) - 1));
      if Copy(Tmp2, 1, 1) = '-' then
        index := StrToIntDef(Tmp2, 0) + 224 // <-- Da muss ich zu meinem Korrekturwert greifen
      else
        index := StrToIntDef(Tmp2, 0);
    end;
    myexefile := PChar(Tmp1);
  end;
  Result := False;
  SL := TStringList.Create;
  hExe := LoadLibraryEx(PChar(myexefile), 0, LOAD_LIBRARY_AS_DATAFILE);
  if hExe = 0 then
    Exit;
  EnumResourceNames(hExe, RT_GROUP_ICON, @EnumResourceNamesProc, Integer(SL));
  if SL.Count = 0 then
  begin
    SL.Free;
    //MessageBox(0, 'No Icons found in the EXE/DLL', 'Error', MB_ICONERROR);
    Exit;
  end;
  ExtractIconFromFile(myexefile, icofile, SL.Strings[index]);
  FreeLibrary(hExe);
  SL.Free;
  Result := True;
end;

[mpth]

ach du meintest EnumResourceNames... ja das kenn ich

hier mal meine version deiner routine (allerdings fehlen noch einige try...finally-blöcke, ich hab deine genommen und nur so abgeändert, damit sie nach meinem verständnis einigermaßen funktionieren müsste)

Delphi-Quellcode:

function SaveApplicationIconGroup(icofile: PChar; exefile: PChar): Boolean; 
  function GetProgramAssociation(Ext: string): string; 
  var
    reg: TRegistry;
    s: string; 
    Buffer, Buffer1: array[0..MAX_PATH] of Char;
  begin
    s := '';
    reg := TRegistry.Create;
    try
      reg.RootKey := HKEY_CLASSES_ROOT;
      if reg.OpenKeyReadOnly(ext + '\DefaultIcon') <> false then
      begin
        s := reg.ReadString('');
        reg.CloseKey;
      end
      else
      begin
        if reg.OpenKeyReadOnly(ext) <> false then
        begin
          s := reg.ReadString('');
          reg.CloseKey;
          if s <> '' then
          begin
            if reg.OpenKeyReadOnly(s + '\DefaultIcon') <> false then
              s := reg.ReadString('');
            reg.CloseKey;
          end;
        end;
      end;
      if Pos('%', s) > 0 then
      begin
        FillChar(Buffer, sizeof(Buffer),#0);
        FillChar(Buffer1, sizeof(Buffer),#0);
        StrPLCopy(Buffer, s, sizeof(Buffer)-1);
        if ExpandEnvironmentStrings(Buffer, Buffer1, sizeof(Buffer1)) > 0 then
          s := Buffer1;
      end;
      // ???
      if Pos('%', s) > 0 then
        Delete(s, Pos('%', s), length(s));

      if ((length(s) > 0) and (s[1] = '"')) then
        Delete(s, 1, 1);
      if ((length(s) > 0) and (s[length(s)] = '"')) then
        Delete(s, Length(s), 1);
      while ((length(s) > 0) and ((s[length(s)] = #32) or (s[length(s)] = '"')))
        do
        Delete(s, Length(s), 1);
      result := s;
    finally
      reg.Free;
    end;
  end;
  function EnumResourceNamesProc(Module: HMODULE; ResType: PChar; ResName:
    PChar; lParam: TStringList): Integer; stdcall;
  var
    ResourceName: string;
  begin
    if hiword(Cardinal(ResName)) = 0 then
    begin
      ResourceName := IntToStr(loword(Cardinal(ResName)));
    end
    else
    begin
      ResourceName := ResName;
      if Pos('#', Resourcename) = 1 then
        Delete(Resourcename,1,1);
    end; 
    lParam.Add(ResourceName); 
    Result := 1; 
  end; 
  function ExtractIconFromFile(ResFileName: string; IcoFileName: string; nIndex: 
    string): Boolean; 

  type 
    PMEMICONDIRENTRY = ^TMEMICONDIRENTRY; 
    TMEMICONDIRENTRY = packed record 
      bWidth: Byte; 
      bHeight: Byte; 
      bColorCount: Byte; 
      bReserved: Byte; 
      wPlanes: Word; 
      wBitCount: Word; 
      dwBytesInRes: DWORD; 
      nID: Word; 
    end; 
  type 
    PMEMICONDIR = ^TMEMICONDIR; 
    TMEMICONDIR = packed record 
      idReserved: Word; 
      idType: Word; 
      idCount: Word; 
      idEntries: array[0..15] of TMEMICONDIRENTRY; 
    end; 
  type 
    PICONDIRENTRY = ^TICONDIRENTRY; 
    TICONDIRENTRY = packed record 
      bWidth: Byte; 
      bHeight: Byte; 
      bColorCount: Byte; 
      bReserved: Byte;
      wPlanes: Word; 
      wBitCount: Word; 
      dwBytesInRes: DWORD; 
      dwImageOffset: DWORD; 
    end; 
  type 
    PICONIMAGE = ^TICONIMAGE; 
    TICONIMAGE = packed record 
      Width, 
        Height, 
        Colors: UINT; 
      lpBits: Pointer; 
      dwNumBytes: DWORD; 
      pBmpInfo: PBitmapInfo; 
    end; 
  type 
    PICONRESOURCE = ^TICONRESOURCE; 
    TICONRESOURCE = packed record 
      nNumImages: UINT; 
      IconImages: array[0..15] of TICONIMAGE; 
    end; 
    function AdjustIconImagePointers(lpImage: PICONIMAGE): Bool; 
    begin 
      if lpImage = nil then 
      begin 
        Result := False; 
        exit; 
      end; 
      lpImage.pBmpInfo := PBitMapInfo(lpImage^.lpBits); 
      lpImage.Width := lpImage^.pBmpInfo^.bmiHeader.biWidth; 
      lpImage.Height := (lpImage^.pBmpInfo^.bmiHeader.biHeight) div 2; 
      lpImage.Colors := lpImage^.pBmpInfo^.bmiHeader.biPlanes * 
        lpImage^.pBmpInfo^.bmiHeader.biBitCount; 
      Result := true; 
    end; 
    function WriteICOHeader(hFile: THandle; nNumEntries: UINT): Boolean; 
    type 
      TFIcoHeader = record 
        wReserved: WORD; 
        wType: WORD; 
        wNumEntries: WORD; 
      end; 
    var 
      IcoHeader: TFIcoHeader; 
      dwBytesWritten: DWORD; 
    begin 
      Result := False; 
      IcoHeader.wReserved := 0;
      IcoHeader.wType := 1; 
      IcoHeader.wNumEntries := WORD(nNumEntries); 
      if not WriteFile(hFile, IcoHeader, SizeOf(IcoHeader), dwBytesWritten, nil) 
        then 
      begin 
        MessageBox(0, pchar(SysErrorMessage(GetLastError)), 'Error', 
          MB_ICONERROR); 
        Result := False; 
        Exit; 
      end; 
      if dwBytesWritten <> SizeOf(IcoHeader) then 
        Exit; 
      Result := True; 
    end; 
    function CalculateImageOffset(lpIR: PICONRESOURCE; nIndex: UINT): DWORD; 
    var 
      dwSize: DWORD; 
      i: Integer; 
    begin 
      dwSize := 3 * SizeOf(WORD); 
      inc(dwSize, lpIR.nNumImages * SizeOf(TICONDIRENTRY)); 
      for i := 0 to nIndex - 1 do 
        inc(dwSize, lpIR.IconImages[i].dwNumBytes); 
      Result := dwSize; 
    end; 
    function WriteIconResourceToFile(hFile: hwnd; lpIR: PICONRESOURCE): Boolean; 
    var 
      i: UINT; 
      dwBytesWritten: DWORD; 
      ide: TICONDIRENTRY; 
      dwTemp: DWORD; 
    begin 
      Result := False; 
      for i := 0 to lpIR^.nNumImages - 1 do 
      begin 
        /// Convert internal format to ICONDIRENTRY 
        ide.bWidth := lpIR^.IconImages[i].Width; 
        ide.bHeight := lpIR^.IconImages[i].Height; 
        ide.bReserved := 0; 
        ide.wPlanes := lpIR^.IconImages[i].pBmpInfo.bmiHeader.biPlanes; 
        ide.wBitCount := lpIR^.IconImages[i].pBmpInfo.bmiHeader.biBitCount; 
        if ide.wPlanes * ide.wBitCount >= 8 then 
          ide.bColorCount := 0 
        else 
          ide.bColorCount := 1 shl (ide.wPlanes * ide.wBitCount); 
        ide.dwBytesInRes := lpIR^.IconImages[i].dwNumBytes; 
        ide.dwImageOffset := CalculateImageOffset(lpIR, i); 
        if not WriteFile(hFile, ide, sizeof(TICONDIRENTRY), dwBytesWritten, nil)
          then 
          Exit; 
        if dwBytesWritten <> sizeof(TICONDIRENTRY) then 
          Exit; 
      end; 
      for i := 0 to lpIR^.nNumImages - 1 do 
      begin 
        dwTemp := lpIR^.IconImages[i].pBmpInfo^.bmiHeader.biSizeImage; 
        lpIR^.IconImages[i].pBmpInfo^.bmiHeader.biSizeImage := 0; 
        if not WriteFile(hFile, lpIR^.IconImages[i].lpBits^, 
          lpIR^.IconImages[i].dwNumBytes, dwBytesWritten, nil) then 
          Exit; 
        if dwBytesWritten <> lpIR^.IconImages[i].dwNumBytes then 
          Exit; 
        lpIR^.IconImages[i].pBmpInfo^.bmiHeader.biSizeImage := dwTemp; 
      end; 
      Result := True; 
    end; 

  var 
    h: HMODULE; 
    lpMemIcon: PMEMICONDIR; 
    lpIR: TICONRESOURCE; 
    src: HRSRC; 
    Global: HGLOBAL; 
    i: integer; 
    hFile: hwnd; 
  begin 
    Result := False; 
    hFile := CreateFile(pchar(IcoFileName), GENERIC_WRITE, 0, nil, 
      CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); 
    if hFile = INVALID_HANDLE_VALUE then 
      Exit; 
    h := LoadLibraryEx(pchar(ResFileName), 0, LOAD_LIBRARY_AS_DATAFILE); 
    if h = 0 then 
      exit; 
    try 
      src := FindResource(h, pchar(nIndex), RT_GROUP_ICON); 
      if src = 0 then 
        Src := FindResource(h, Pointer(StrToInt(nIndex)), RT_GROUP_ICON); 
      if src <> 0 then 
      begin 
        Global := LoadResource(h, src); 
        if Global <> 0 then 
        begin 
          lpMemIcon := LockResource(Global); 
          if Global <> 0 then 
          begin
            try 
              lpIR.nNumImages := lpMemIcon.idCount; 
              // Write the header 
              for i := 0 to lpMemIcon^.idCount - 1 do 
              begin 
                src := FindResource(h, 
                  MakeIntResource(lpMemIcon^.idEntries[i].nID), RT_ICON); 
                if src <> 0 then 
                begin 
                  Global := LoadResource(h, src); 
                  if Global <> 0 then 
                  begin 
                    try 
                      lpIR.IconImages[i].dwNumBytes := SizeofResource(h, src); 
                    except 
                      MessageBox(0, PChar('Unable to Read Icon'), 'NTPacker', 
                        MB_ICONERROR); 
                      Result := False; 
                      ExitProcess(0); 
                    end; 
                    GetMem(lpIR.IconImages[i].lpBits, 
                      lpIR.IconImages[i].dwNumBytes); 
                    CopyMemory(lpIR.IconImages[i].lpBits, LockResource(Global), 
                      lpIR.IconImages[i].dwNumBytes); 
                    if not AdjustIconImagePointers(@(lpIR.IconImages[i])) then 
                      exit; 
                  end; 
                end; 
              end; 
              if WriteICOHeader(hFile, lpIR.nNumImages) then 
                if WriteIconResourceToFile(hFile, @lpIR) then 
                  Result := True; 
            finally 
              for i := 0 to lpIR.nNumImages - 1 do 
                if assigned(lpIR.IconImages[i].lpBits) then 
                  FreeMem(lpIR.IconImages[i].lpBits); 
            end; 
          end; 
        end; 
      end; 
    finally 
      FreeLibrary(h); 
    end; 
    CloseHandle(hFile); 
  end; 
var 
  hExe: THandle; 
  SL: TStringList;
  Tmp1, Tmp2: string; 
  index: LongInt; // wichtig! 
  myexefile: PChar; 
begin 
  index := 0; 
  Tmp1 := exefile; 
  myexefile := PChar(Tmp1);

  { Hier versuche ich bei NICHT-EXEn doch an das vollständige Icon zu kommen... } 
  if LowerCase(ExtractFileExt(myexefile)) <> '.exe' then 
  begin 
    myexefile := PChar(GetProgramAssociation(ExtractFileExt(myexefile))); 
    if Pos(',', myexefile) > 0 then 
    begin 
      Tmp1 := myexefile; 
      Tmp2 := Trim(Copy(Tmp1, Pos(',', Tmp1) + 1, Length(Tmp1))); 
      Tmp1 := Trim(Copy(Tmp1, 1, Pos(',', Tmp1) - 1));
      index := StrToIntDef(Tmp2, 0);
    end;
    myexefile := PChar(Tmp1);
  end;
  Result := False; 
  SL := TStringList.Create; 
  hExe := LoadLibraryEx(PChar(myexefile), 0, LOAD_LIBRARY_AS_DATAFILE); 
  if hExe = 0 then 
    Exit; 
  EnumResourceNames(hExe, RT_GROUP_ICON, @EnumResourceNamesProc, Integer(SL));
  if SL.Count = 0 then 
  begin 
    SL.Free; 
    //MessageBox(0, 'No Icons found in the EXE/DLL', 'Error', MB_ICONERROR); 
    Exit; 
  end;
  if index < 0 then // falls ein negativer wert, dann nach dem namen suchen, nicht den index verwenden!
  begin
    index := sl.IndexOf(IntToStr(-index));
    if index = -1 then
      index := 0; // nicht gefunden, schade :-(
  end;
  ExtractIconFromFile(myexefile, icofile, SL[index]);
  FreeLibrary(hExe);
  SL.Free; 
  Result := True; 
end;

[FriFra]

Zitat von mpth:

hier mal meine version deiner routine

Danke , jetzt bekomme ich genau den richtigen Eintrag ohne meine ominöse "Icon-Konstante"