unit Unit1;

interface

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls;

type
   TForm1 = class(TForm)
     Button1: TButton;
     procedure Button1Click(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
   end;

var
   Form1: TForm1;

implementation

{$R *.dfm}

procedure updateIcons(const fileName, icoFileName: string);    
  {-------------------------------------------------------------}    
  {|    Функция замены значка MAINICON в исполняемом файле     |}    
  {-------------------------------------------------------------}    
  {| Параметры:                    |}    
  {|  fileName - файл, в котором производится изменение значка;|}    
  {|  icoFileName - значок на который проходит замена          |}    
  {-------------------------------------------------------------}    
  type    
    PIcoItemHeader = ^TIcoItemHeader;     
    TIcoItemHeader = packed record     
      Width: byte;    
      Height: byte;    
      Colors: byte;    
      Reserved: byte;    
      Planes: word;    
      BitCount: word;    
      ImageSize: dword;    
    end;    
    
    PIcoItem = ^TIcoItem;    
    TIcoItem = packed record    
      Header: TIcoItemHeader;    
      Offset: dword;    
    end;    
    
    PIcoHeader = ^TIcoHeader;     
    TIcoHeader = packed record     
      Reserved: word;    
      Typ: word;    
      ItemCount: word;    
      Items: array [0..MaxInt shr 4 - 1] of TIcoItem;     
    end;    
    
    PGroupIconDirItem = ^TGroupIconDirItem;     
    TGroupIconDirItem = packed record     
      Header: TIcoItemHeader;     
      Id: word;    
    end;    
    
    PGroupIconDir = ^TGroupIconDir;    
    TGroupIconDir = packed record    
      Reserved: word;    
      Typ: word;    
      ItemCount: word;    
      Items: array [0..MaxInt shr 4 - 1] of TGroupIconDirItem;    
    end;    
    
    function IsValidIcon(fP: pointer; fSize: cardinal): boolean;    
    { Проверка корректности внедряемого значка для MAINICON }    
    var    
      itemCount: cardinal;    
    begin    
      result:=false;    
      if fSize < cardinal(sizeOf(word) * 3) then exit;    
      if (pChar(fP)[0] = 'M') and (pChar(fP)[1] = 'Z') then exit;    
      ItemCount:=PIcoHeader(fP).ItemCount;    
      if fSize < Cardinal((sizeOf(Word) * 3) + (itemCount * sizeOf(TIcoItem))) then exit;    
      fP:=@PIcoHeader(fP).Items;    
      while ItemCount > Cardinal(0) do    
        begin    
          if (Cardinal(PIcoItem(fP).Offset + PIcoItem(fP).Header.ImageSize) < Cardinal(PIcoItem(fP).Offset)) or    
             (Cardinal(PIcoItem(fP).Offset + PIcoItem(fP).Header.ImageSize) > Cardinal(fSize)) then exit;    
          inc(PIcoItem(fP));    
          dec(itemCount)    
        end;    
      result:=true    
    end;    
    
  var    
    ch: char;    
    H: THandle;    
    M: HMODULE;    
    R: HRSRC;    
    Res: HGLOBAL;    
    GroupIconDir, NewGroupIconDir: PGroupIconDir;    
    I: integer;    
    wLanguage: word;    
    FS: TFileStream;    
    Ico: PIcoHeader;    
    N: cardinal;    
    NewGroupIconDirSize: longint;    
    
  begin    
    if Win32Platform <> VER_PLATFORM_WIN32_NT then    
      showMessage('Возможность поддерживается только для' + #13#10 +    
                  'платформы Windows NT и более поздней');    
    Ico:=nil;    
    try    
      { Загрузка значка }    
      fs:=TFileStream.Create(IcoFileName,fmOpenRead,fmShareDenyWrite);    
      try    
        N:=fs.Size;    
        if cardinal(N) > cardinal($100000) then    
          showMessage('Файл со значком слишком большой');    
        GetMem(Ico, N); fs.Read(Ico^,N)    
      finally    
          fs.Free    
      end;    
      { .... проверка правильности значка }    
      if not IsValidIcon(Ico, N) then    
        showMessage('Файл значка поврежден');    
      { ... обновление ресурсов в файле }    
      H:=BeginUpdateResource(pChar(FileName), false);    
      if H = 0 then    
        showMessage('Ошибка начала обновления (BeginUpdateResource failed (1))');    
      try     
        M:=LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE);    
        if M = 0 then     
          ShowMessage('LoadLibraryEx failed (1)');     
        try    
          { ... загрузка значков для 'MAINICON' из ресурса }    
          R := FindResource(M, 'MAINICON', RT_GROUP_ICON);    
          if R = 0 then    
            showMessage('Ошибка поиска ресурса (FindResource failed (1))');    
          Res:=LoadResource(M, R);    
          if Res = 0 then    
            showMessage('Ошибка загрузки ресурса (LoadResource failed (1))');    
          GroupIconDir:=LockResource(Res);    
          if GroupIconDir = nil then    
            showMessage('Ресурс защищен от изменения (LockResource failed (1))');    
          { ... удаление начального значка 'MAINICON' }    
          wLanguage:=GetSystemDefaultLangID;    
          if not UpdateResource(H, RT_GROUP_ICON, 'MAINICON', wLanguage, nil, 0) then    
            showMessage('Ошибка обновления ресурса (UpdateResource failed (1))');    
          for I:=0 to GroupIconDir.ItemCount-1 do    
            begin    
              wLanguage:=GetSystemDefaultLangID;    
              if not UpdateResource(H, RT_ICON, MakeIntResource(GroupIconDir.Items[I].Id), wLanguage, nil, 0) then    
                showMessage('Ошибка обновления ресурса (UpdateResource failed (2))')    
            end;    
          { ... создание новой группы ресурсов из значков }    
          NewGroupIconDirSize:=3*SizeOf(word)+Ico.ItemCount*sizeOf(TGroupIconDirItem);    
          GetMem(NewGroupIconDir, NewGroupIconDirSize);    
          try    
            NewGroupIconDir.Reserved:=GroupIconDir.Reserved;    
            NewGroupIconDir.Typ:=GroupIconDir.Typ;    
            NewGroupIconDir.ItemCount:=Ico.ItemCount;    
            for I:=0 to NewGroupIconDir.ItemCount-1 do    
              begin    
                NewGroupIconDir.Items[I].Header:=Ico.Items[I].Header;    
                NewGroupIconDir.Items[I].Id:=I+1    
              end;    
            { ... обновление значка 'MAINICON' }    
            for I:=0 to NewGroupIconDir.ItemCount-1 do    
              if not UpdateResource(H, RT_ICON, MakeIntResource(NewGroupIconDir.Items[I].Id),    
                     1033, Pointer(DWORD(Ico) + Ico.Items[I].Offset), Ico.Items[I].Header.ImageSize) then    
                showMessage('Ошибка обновления ресурса (UpdateResource failed (3))');    
            if not UpdateResource(H, RT_GROUP_ICON, 'MAINICON', 1033, NewGroupIconDir, NewGroupIconDirSize) then    
              showMessage('Ошибка обновления ресурса (UpdateResource failed (4))');    
            if not UpdateResource(H,RT_RCDATA, 'URL', wLanguage, addr(ch), 1024) then    
              showMessage('Ошибка записи для значения URL')    
          finally    
            FreeMem(NewGroupIconDir)    
          end    
        finally    
          FreeLibrary(M)    
        end    
      except    
        EndUpdateResource(H, true);    
        raise    
      end;    
      if not EndUpdateResource(H, False) then    
        ShowMessage('Ошибка завершения обновления (EndUpdateResource failed)')    
    finally     
      FreeMem(Ico)    
    end    
  end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   updateIcons('C:\test.exe', 'C:\icon.ico');
end;

end.