procedure TForm1.Button1Click(Sender: TObject);
var dwResSize, dwRead:DWORD;
hUpdateRes:Cardinal;
pRes: PChar;
f:thandle;
begin
F:=CreateFile('new.bmp', GENERIC_READ, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
// Если открыть не удалось, то выходим
if F=INVALID_HANDLE_VALUE then begin
CloseHandle(F);
exit;
end;
dwResSize:=GetFileSize(F, nil)-sizeof(BITMAPFILEHEADER);
pRes:=SysGetMem(dwResSize);
SetFilePointer(F,sizeof(BITMAPFILEHEADER),nil,0);
ReadFile(F, pRes^, dwResSize, dwRead, nil);
hUpdateRes:=BeginUpdateResource('ResourceKeeper.exe', FALSE);
UpdateResource(hUpdateRes, RT_BITMAP, 'bmp', LANG_NEUTRAL, pRes, dwResSize);
EndUpdateResource(hUpdateRes, FALSE);
CloseHandle(F);
end;

{
 Модуль содержит класс для записи ресурсов в exe файл
}

unit isResourceWriterUnit;

interface

uses
 Windows, SysUtils, Classes;

type
 //Класс для записи ресурсов в exe файл
 TisResourceWriter = class
 private
   FExeName: TFileName;
   FResHandle: THandle;
   FAutoCommit: Boolean;
 public
   constructor Create(const ExeName: TFileName);
   procedure Commit;

   procedure UpdateIco(const IcoFileName: TFileName);
   procedure WriteString(const ResName, Value: string);
   procedure WriteBuffer(const ResName: string; const Buffer; BufferSize: LongWord; lpType: PChar = RT_RCDATA);

   property AutoCommit: Boolean read FAutoCommit write FAutoCommit;
 end;

implementation

procedure ErrorWithLastError(const Message: string);
begin
 raise Exception.CreateFmt('%s: %s (#%d)', [Message, SysErrorMessage(GetLastError), GetLastError]);
end;

procedure Error(const Message: string);
begin
 raise Exception.Create(Message);
end;

function EnumLangsFunc(hModule: Cardinal; lpType, lpName: PAnsiChar; wLanguage: Word; lParam: Integer): Boolean; stdcall;
begin
 PWord(lParam)^ := wLanguage;
 Result := False;
end;

function GetResourceLanguage(hModule: Cardinal; lpType, lpName: PAnsiChar; var wLanguage: Word): Boolean;
begin
 wLanguage := 0;
 EnumResourceLanguages(hModule, lpType, lpName, @EnumLangsFunc, Integer(@wLanguage));
 Result := True;
end;

{ TisResourceWriter }

procedure TisResourceWriter.Commit;
begin
 try
   if FResHandle = 0 then
     Error('noting data to commit');

   if not EndUpdateResource(FResHandle, False) then
     ErrorWithLastError('');

   FResHandle := 0;
 except
   on E:Exception do
     raise Exception.CreateFmt('An exception while trying commit resource: %s', [E.Message]);
 end;
end;

constructor TisResourceWriter.Create(const ExeName: TFileName);
begin
 inherited Create;

 FExeName := ExeName;
end;

procedure TisResourceWriter.WriteString(const ResName, Value: string);
begin
 WriteBuffer(ResName, Value[1], Length(Value) * SizeOf(Char));
end;

procedure TisResourceWriter.WriteBuffer(const ResName: string; const Buffer; BufferSize: LongWord; lpType: PChar);
begin
 try
   if not AnsiSameStr(AnsiUpperCase(ResName), ResName) then
     Error('resource name can by only upper case');

   //Если режим работы не автокоммит
   if AutoCommit then
     if FResHandle <> 0 then
       Error('not committed update in last not autommit session')
     else
       FResHandle := BeginUpdateResource(PChar(FExeName), False);

   if (not AutoCommit) and (FResHandle = 0) then
     FResHandle := BeginUpdateResource(PChar(FExeName), False);

   if FResHandle = 0 then
     ErrorWithLastError('');

   try
     if not UpdateResource(FResHandle, lpType, PChar(ResName), SUBLANG_SYS_DEFAULT * 2048 or LANG_NEUTRAL, @Buffer, BufferSize) then
       ErrorWithLastError('');
   finally
     if AutoCommit then
       Commit;
   end;
 except
   on E: Exception do
     raise Exception.CreateFmt('An exception while trying write resource \"%s\": %s', [ResName, E.Message]);
 end;
end;

//Замена страндартной иконки. Взято из исхоников InnoSetup
procedure TisResourceWriter.UpdateIco(const IcoFileName: TFileName);
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(P: Pointer; Size: Cardinal): Boolean;
 var
   ItemCount: Cardinal;
 begin
   Result := False;
   if Size < Cardinal(SizeOf(Word) * 3) then
     Exit;
   if (PChar(P)[0] = 'M') and (PChar(P)[1] = 'Z') then
     Exit;
   ItemCount := PIcoHeader(P).ItemCount;
   if Size < Cardinal((SizeOf(Word) * 3) + (ItemCount * SizeOf(TIcoItem))) then
     Exit;
   P := @PIcoHeader(P).Items;
   while ItemCount > Cardinal(0) do begin
     if (Cardinal(PIcoItem(P).Offset + PIcoItem(P).Header.ImageSize) < Cardinal(PIcoItem(P).Offset)) or
       (Cardinal(PIcoItem(P).Offset + PIcoItem(P).Header.ImageSize) > Cardinal(Size)) then
       Exit;
     Inc(PIcoItem(P));
     Dec(ItemCount);
   end;
   Result := True;
 end;

var
 R: HRSRC;
 H: THandle;
 M: HMODULE;
 I: Integer;
 N: Cardinal;
 Res: HGLOBAL;
 F: TFileStream;
 Ico: PIcoHeader;
 wLanguage: Word;
 NewGroupIconDirSize: LongInt;
 GroupIconDir: PGroupIconDir;
 NewGroupIconDir: PGroupIconDir;

begin
 if Win32Platform <> VER_PLATFORM_WIN32_NT then
   Error('Only supported on Windows NT and above');

 Ico := nil;

 try
   //Load the icons
   F := TFileStream.Create(IcoFileName, fmOpenRead);
   try
     N := F.Size;
     if Cardinal(N) > Cardinal($100000) then  { sanity check }
       Error('Icon file is too large');
     GetMem(Ico, N);
     F.ReadBuffer(Ico^, N);
   finally
     F.Free;
   end;

   //Ensure the icon is valid
   if not IsValidIcon(Ico, N) then
     Error('Icon file is invalid');

   { Update the resources }
   H := BeginUpdateResource(PChar(FExeName), False);
   if H = 0 then
     ErrorWithLastError('BeginUpdateResource failed (1)');
   try
     M := LoadLibraryEx(PChar(FExeName), 0, LOAD_LIBRARY_AS_DATAFILE);
     if M = 0 then
       ErrorWithLastError('LoadLibraryEx failed (1)');
     try
       { Load the 'MAINICON' group icon resource }
       R := FindResource(M, 'MAINICON', RT_GROUP_ICON);
       if R = 0 then
         ErrorWithLastError('FindResource failed (1)');
       Res := LoadResource(M, R);
       if Res = 0 then
         ErrorWithLastError('LoadResource failed (1)');
       GroupIconDir := LockResource(Res);
       if GroupIconDir = nil then
         ErrorWithLastError('LockResource failed (1)');

       { Delete 'MAINICON' }
       if not GetResourceLanguage(M, RT_GROUP_ICON, 'MAINICON', wLanguage) then
         Error('GetResourceLanguage failed (1)');
       if not UpdateResource(H, RT_GROUP_ICON, 'MAINICON', wLanguage, nil, 0) then
         ErrorWithLastError('UpdateResource failed (1)');

       { Delete the RT_ICON icon resources that belonged to 'MAINICON' }
       for I := 0 to GroupIconDir.ItemCount-1 do begin
         if not GetResourceLanguage(M, RT_ICON, MakeIntResource(GroupIconDir.Items[I].Id), wLanguage) then
           Error('GetResourceLanguage failed (2)');
         if not UpdateResource(H, RT_ICON, MakeIntResource(GroupIconDir.Items[I].Id), wLanguage, nil, 0) then
           ErrorWithLastError('UpdateResource failed (2)');
       end;

       { Build the new group icon resource }
       NewGroupIconDirSize := 3*SizeOf(Word)+Ico.ItemCount*SizeOf(TGroupIconDirItem);
       GetMem(NewGroupIconDir, NewGroupIconDirSize);
       try
         { Build the new group icon resource }
         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; //assumes that there aren't any icons left
         end;

         { Update '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
             ErrorWithLastError('UpdateResource failed (3)');

         { Update the icons }
         if not UpdateResource(H, RT_GROUP_ICON, 'MAINICON', 1033, NewGroupIconDir, NewGroupIconDirSize) then
           ErrorWithLastError('UpdateResource failed (4)');
       finally
         FreeMem(NewGroupIconDir);
       end;
     finally
       FreeLibrary(M);
     end;
   except
     EndUpdateResource(H, True);  { discard changes }
     raise;
   end;
   if not EndUpdateResource(H, False) then
     ErrorWithLastError('EndUpdateResource failed');
 finally
   FreeMem(Ico);
 end;
end;

end.