Icon anderer EXE Datei ändern

[SMO]

Probier's mal damit:

Delphi-Quellcode:

// Transplant / inject icon resources.
// Author: SMO, DelphiPraxis.net, 2015

uses
  System.Types;  // TWordDynArray

const
  ICON_HEADER_RESERVED = 0;
  ICON_HEADER_TYPE_ICO = 1;
  ICON_HEADER_TYPE_CUR = 2;

type
  PGroupIconRsrcEntry = ^TGroupIconRsrcEntry;
  TGroupIconRsrcEntry = packed record
    bWidth, bHeight: Byte;    // 0 means 256, which is the maximum
    bColorCount:     Byte;    // number of colors in image (0 if wBitCount > 8)
    bReserved:       Byte;    // 0
    wPlanes:         Word;    // 1
    wBitCount:       Word;    // number of bits per pixel
    dwSize:          DWORD;   // size of the icon data, in bytes
    wID:             Word;    // resource ID of the icon (for RT_ICON entry)
  end;

  PGroupIconRsrcHeader = ^TGroupIconRsrcHeader;
  TGroupIconRsrcHeader = packed record
    wReserved: Word;    // 0
    wType:     Word;    // 1 for icons
    wCount:    Word;    // number of icons in this group, each has a following TGroupIconRsrcEntry
    // Entries: array [0..idType - 1] of TGroupIconRsrcEntry;
  end;


  TSmoGroupIcon = record
    Header:   TGroupIconRsrcHeader;
    Entries:  array of TGroupIconRsrcEntry;
    IconData: array of array of Byte;
  end;


function GetGroupIconFromIcoFile(const FileName: string; out GroupIcon: TSmoGroupIcon): Boolean;
var
  hFile: THandle;
  i, Size: Integer;
  Offsets: array of DWORD;
begin
  // clear the output record
  Finalize(GroupIcon);
  FillChar(GroupIcon.Header, SizeOf(GroupIcon.Header), 0);

  hFile := FileOpen(FileName, fmOpenRead or fmShareDenyNone);
  Result := hFile <> INVALID_HANDLE_VALUE;
  if Result then
  try
    // read header
    Size := SizeOf(GroupIcon.Header);
    Result := FileRead(hFile, GroupIcon.Header, Size) = Size;
    if not Result then Exit;
    with GroupIcon.Header do
      if (wReserved <> ICON_HEADER_RESERVED) or (wType <> ICON_HEADER_TYPE_ICO) then
      begin
        SetLastError(ERROR_BAD_FORMAT);
        Exit(False); // invalid data in header
      end;
    // read entries...
    // ico file entries are almost identical to TGroupIconRsrcEntry, with one small difference
    SetLength(GroupIcon.Entries, GroupIcon.Header.wCount);
    SetLength(Offsets, GroupIcon.Header.wCount);
    Size := SizeOf(GroupIcon.Entries[0]) - 2;
    for i := 0 to High(GroupIcon.Entries) do
    begin
      // read a TGroupIconRsrcEntry but without the last "wID" field
      Result := Result and (FileRead(hFile, GroupIcon.Entries[i], Size) = Size);
      // ico files have a dwFileOffset field there instead, read it separately
      Result := Result and (FileRead(hFile, Offsets[i], 4) = 4);
      GroupIcon.Entries[i].wID := i + 1;
    end;
    if not Result then Exit;
    // read icon image data
    SetLength(GroupIcon.IconData, GroupIcon.Header.wCount);
    for i := 0 to High(GroupIcon.IconData) do
    begin
      Size := GroupIcon.Entries[i].dwSize;
      SetLength(GroupIcon.IconData[i], Size);
      FileSeek(hFile, Offsets[i], FILE_BEGIN);
      Result := FileRead(hFile, GroupIcon.IconData[i, 0], Size) = Size;
      if not Result then Exit;
    end;
  finally
    FileClose(hFile);
    if not Result then
    begin
      // clear the output record
      Finalize(GroupIcon);
      FillChar(GroupIcon.Header, SizeOf(GroupIcon.Header), 0);
    end;
  end;
end;


// GetRsrcPointer: get pointer to the specified resource
// Returns nil on error
function GetRsrcPointer(hModule: HMODULE; lpName, lpType: PChar): Pointer;
var
  hResInfo: HRSRC;
  hResData: HGLOBAL;
begin
  Result := nil;
  hResInfo := FindResource(hModule, lpName, lpType);
  if hResInfo <> 0 then
  begin
    hResData := LoadResource(hModule, hResInfo);
    if hResData <> 0 then
      Result := LockResource(hResData);
    // UnlockResource & FreeResource are not necessary in 32 & 64 bit Windows
  end;
end;


// GetGroupIcon: get the complete data from the specified RT_GROUP_ICON resource.
// Returns true on success and false on error.
function GetGroupIcon(const FileName: string; GroupName: PChar; out GroupIcon: TSmoGroupIcon): Boolean;
var
  hLib: HMODULE;
  PData: Pointer;
  PEntry: PGroupIconRsrcEntry;
  LastError: DWORD;
  i: Integer;
begin
  // clear the output record
  Finalize(GroupIcon);
  FillChar(GroupIcon.Header, SizeOf(GroupIcon.Header), 0);

  hLib := LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE);
  Result := hLib <> 0;
  if Result then
  try
    PData := GetRsrcPointer(hLib, PChar(GroupName), RT_GROUP_ICON);

    if not Assigned(PData) then Exit(False); // resource not found
    with PGroupIconRsrcHeader(PData)^ do
      if (wReserved <> ICON_HEADER_RESERVED) or (wType <> ICON_HEADER_TYPE_ICO) then
      begin
        SetLastError(ERROR_BAD_FORMAT);
        Exit(False); // invalid data in header
      end;
    // copy header
    GroupIcon.Header := PGroupIconRsrcHeader(PData)^;
    i := GroupIcon.Header.wCount;
    SetLength(GroupIcon.Entries, i);
    SetLength(GroupIcon.IconData, i);
    // copy entries & icon data
    PEntry := PGroupIconRsrcEntry(UIntPtr(PData) + SizeOf(TGroupIconRsrcHeader));
    for i := 0 to i - 1 do
    begin
      GroupIcon.Entries[i] := PEntry^;
      // load icon data (bitmap or PNG)
      PData := GetRsrcPointer(hLib, MakeIntResource(PEntry^.wID), RT_ICON);
      if Assigned(PData) then
      begin
        SetLength(GroupIcon.IconData[i], PEntry^.dwSize);
        Move(PData^, GroupIcon.IconData[i, 0], PEntry^.dwSize);
      end
      else // icon data wasn't found... wrong ID? Should not happen...
        GroupIcon.Entries[i].dwSize := 0;
      Inc(PEntry);
    end;
  finally
    LastError := GetLastError;
    FreeLibrary(hLib);
    if LastError <> ERROR_SUCCESS then SetLastError(LastError);
  end;
end;


function EnumResLangProc(hModule: HMODULE; lpszType, lpszName: PChar; wIDLanguage: Word;
  var LangArray: TWordDynArray): BOOL; stdcall;
var
  i: Integer;
begin
  i := Length(LangArray);
  SetLength(LangArray, i + 1);
  LangArray[i] := wIDLanguage;
  Result := True;
end;

function GetResourceLangIDs(hModule: HMODULE; lpType, lpName: PChar): TWordDynArray;
begin
  Result := nil;
  if not EnumResourceLanguages(hModule, lpType, lpName, @EnumResLangProc, IntPtr(@Result)) then
    Result := nil;
end;


// DeleteIconGroup: deletes the specified RT_GROUP_ICON resource and the referenecd RT_ICON
// resources. Deletes ALL language versions, if several exist.
// Returns true if the resource does not exist or was deleted successfully.
// Returns false if an error occured.
function DeleteGroupIcon(const FileName: string; GroupName: PChar): Boolean;
var
  GroupIcon: TSmoGroupIcon;
  hUpdate: THandle;
  hLib: HMODULE;
  LastError: DWORD;
  i, n: Integer;
  LangArray: TWordDynArray;
begin
  Result := GetGroupIcon(FileName, GroupName, GroupIcon);
  if not Result then
  begin
    case GetLastError of
      ERROR_RESOURCE_DATA_NOT_FOUND,
      ERROR_RESOURCE_TYPE_NOT_FOUND,
      ERROR_RESOURCE_NAME_NOT_FOUND,
      ERROR_RESOURCE_LANG_NOT_FOUND: Result := True;
    end;
    Exit;
  end;
  Assert(GroupIcon.Header.wCount = Length(GroupIcon.Entries));

  hLib := 0;
  hUpdate := 0;
  try
    hUpdate := BeginUpdateResource(PChar(FileName), False);
    if hUpdate <> 0 then
      hLib := LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE);
    Result := (hUpdate <> 0) and (hLib <> 0);
    if not Result then Exit;

    // delete the RT_GROUP_ICON, all languages
    LangArray := GetResourceLangIDs(hLib, RT_GROUP_ICON, PChar(GroupName));
    for n := 0 to High(LangArray) do
      Result := Result and UpdateResource(hUpdate, RT_GROUP_ICON, PChar(GroupName),
        LangArray[n], nil, 0);
    // delete the actual icon data (RT_ICON), all languages
    // TODO: check if we're actually allowed to do that... other RT_GROUP_ICON could still
    // be referencing some of these RT_ICON we're about to delete!
    for i := 0 to High(GroupIcon.Entries) do
    begin
      if not Result then Break;
      LangArray := GetResourceLangIDs(hLib, RT_ICON, MakeIntResource(GroupIcon.Entries[i].wID));
      for n := 0 to High(LangArray) do
        Result := Result and UpdateResource(hUpdate, RT_ICON,
          MakeIntResource(GroupIcon.Entries[i].wID), LangArray[n], nil, 0);
    end;
  finally
    LastError := GetLastError;
    if hLib <> 0 then FreeLibrary(hLib);
    if hUpdate <> 0 then EndUpdateResource(hUpdate, not Result);
    if LastError <> ERROR_SUCCESS then SetLastError(LastError);
  end;
end;

// FindUnusedIconID: returns the first unused RT_ICON resource ID in the specified module.
// A return value of 0 means that no unused ID could be found.
function FindUnusedIconID(const hModule: HMODULE; const StartID: Word = 0): Word;
var
  hResInfo: HRSRC;
begin
  Result := StartID;
  if Result = 0 then Inc(Result);
  while Result > 0 do
  begin
    hResInfo := FindResource(hModule, MakeIntResource(Result), RT_ICON);
    if hResInfo = 0 then Break;
    Inc(Result);
  end;
end;


// SetGroupIcon: set the complete data of the specified RT_GROUP_ICON resource, and add the
// referenced RT_ICON resources. If a RT_GROUP_ICON of the same name exists, it'll be deleted
// first, including all RT_ICON resources it references.
// Returns true on success and false on error.
function SetGroupIcon(const FileName: string; GroupName: PChar; var GroupIcon: TSmoGroupIcon): Boolean;
var
  hLib: HMODULE;
  hUpdate: THandle;
  PData: Pointer;
  LastError: DWORD;
  i, SizeOfEntries: Integer;
  wLanguage, IconID: Word;
begin
  Assert(GroupIcon.Header.wCount = Length(GroupIcon.Entries));
  Assert(Length(GroupIcon.Entries) = Length(GroupIcon.IconData));
  // if the group already exists, then delete it first
  Result := DeleteGroupIcon(FileName, GroupName);
  hLib := 0;
  hUpdate := 0;
  PData := nil;
  if Result then
  try
    hUpdate := BeginUpdateResource(PChar(FileName), False);
    if hUpdate <> 0 then
      hLib := LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE);
    Result := (hUpdate <> 0) and (hLib <> 0);
    if not Result then Exit;

    wLanguage := MAKELANGID(LANG_NEUTRAL, SUBLANG_NEUTRAL);
    IconID := 0;
    // add the RT_ICON data
    for i := 0 to High(GroupIcon.Entries) do
    begin
      // find the next unused ID
      IconID := FindUnusedIconID(hLib, IconID + 1);
      Result := Result and (IconID > 0) and
        UpdateResource(hUpdate, RT_ICON, MakeIntResource(IconID), wLanguage,
        @GroupIcon.IconData[i, 0], Length(GroupIcon.IconData[i]));
      // update the entry's ID with the new value
      GroupIcon.Entries[i].wID := IconID;
    end;
    // add the RT_GROUP_ICON data
    if Result then
    begin
      // copy data from the GroupIcon structure to a contiguous block of memory
      i := SizeOf(GroupIcon.Header);
      SizeOfEntries := GroupIcon.Header.wCount * SizeOf(GroupIcon.Entries[0]);
      GetMem(PData, i + SizeOfEntries);
      PGroupIconRsrcHeader(PData)^ := GroupIcon.Header;
      Move(GroupIcon.Entries[0], Pointer(IntPtr(PData) + i)^, SizeOfEntries);
      Result := UpdateResource(hUpdate, RT_GROUP_ICON, PChar(GroupName), wLanguage,
        PData, i + SizeOfEntries);
    end;
  finally
    LastError := GetLastError;
    if Assigned(PData) then FreeMem(PData);
    if hLib <> 0 then FreeLibrary(hLib);
    if hUpdate <> 0 then EndUpdateResource(hUpdate, not Result);
    if LastError <> ERROR_SUCCESS then SetLastError(LastError);
  end;
end;

Benutzt wird das ganze dann so:

Delphi-Quellcode:

procedure Test;
var
  IconA, IconB, IconC: TSmoGroupIcon;
begin
  // Hole die Symbolgruppe "ICO_MYCOMPUTER" aus Explorer.exe
  if not GetGroupIcon('C:\Windows\System32\Explorer.exe', 'ICO_MYCOMPUTER', IconA) then
    RaiseLastOSError;
  // Hole die Symbolgruppe mit der ID 2 aus Notepad.exe
  if not GetGroupIcon('C:\Windows\System32\Notepad.exe', MakeIntResource(2), IconB) then
    RaiseLastOSError;
  // Lade eine Symbolgruppe aus einer Ico-Datei
  if not GetGroupIconFromIcoFile('D:\Test.ico', IconC) then
    RaiseLastOSError;
  // Speichere die Symbolgruppen in Test.exe unter verschiedenen Namen/IDs
  if not (SetGroupIcon('D:\Test.exe', 'MAINICON', IconA) 
    and SetGroupIcon('D:\Test.exe', MakeIntResource(123), IconB)
    and SetGroupIcon('D:\Test.exe', 'A', IconC)) then
    RaiseLastOSError;
end;

Der Code ist nicht perfekt, er löscht eventuell Symbole, die noch von anderen Gruppen referenziert werden. Außerdem könnte man eine schöne Klasse daraus machen, oder einen Record mit Methoden, aber für den Anfang sollte es reichen.