Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Sonstige Fragen zu Delphi (https://www.delphipraxis.net/19-sonstige-fragen-zu-delphi/)
-   -   Delphi IconIndex aus "DefaultIcon"-Eintrag in der Registry... (https://www.delphipraxis.net/83225-iconindex-aus-defaulticon-eintrag-der-registry.html)

FriFra 29. Dez 2006 13:39
IconIndex aus "DefaultIcon"-Eintrag in der Registr
 
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 29. Dez 2006 13:49
Re: IconIndex aus "DefaultIcon"-Eintrag in der Reg
 
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 29. Dez 2006 13:52
Re: IconIndex aus "DefaultIcon"-Eintrag in der Reg
 
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 29. Dez 2006 13:57
Re: IconIndex aus "DefaultIcon"-Eintrag in der Reg
 
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 :gruebel:, allerdings frage ich mich schon: warum 224?

mpth 29. Dez 2006 14:07
Re: IconIndex aus "DefaultIcon"-Eintrag in der Reg
 
EnumResources? kenn ich so gar nicht... meinst du IShellItem.EnumResources?

//edit
meinte natürlich IShellItemResources.EnumResources :wall:

FriFra 29. Dez 2006 14:15
Re: IconIndex aus "DefaultIcon"-Eintrag in der Reg
 
Zitat:
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 29. Dez 2006 14:49
Re: IconIndex aus "DefaultIcon"-Eintrag in der Reg
 
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 29. Dez 2006 15:05
Re: IconIndex aus "DefaultIcon"-Eintrag in der Reg
 
Zitat:
Zitat von mpth
hier mal meine version deiner routine
Danke :thumb: , jetzt bekomme ich genau den richtigen Eintrag ohne meine ominöse "Icon-Konstante" :mrgreen:


Alle Zeitangaben in WEZ +1. Es ist jetzt 10:55 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz