Private Declare Function BeginUpdateResource Lib "kernel32" _
Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal _
bDeleteExistingResources As Boolean) As Long
Private Declare Function UpdateResource Lib "kernel32" Alias _
"UpdateResourceA" (ByVal hUpdate As Long, ByVal lpType As Long, _
ByVal lpName As Long, ByVal wLanguage As Long, lpData As Any, _
ByVal cbData As Long) As Long
Private Declare Function EndUpdateResource Lib "kernel32" Alias _
"EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)


Private Const RT_ICON =  3 &
Private Const RT_GROUP_ICON =  14 

Private Type CursorOrIcon
    Reserved As Integer
    wType As Integer
    Count As Integer
End Type


Private Type ICONDIRENTRY
   bWidth As Byte
   bHeight As Byte
   bColorCount As Byte
   bReserved As Byte
   wPlanes As Integer
   wBitCount As Integer
   dwBytesInRes As Long
   dwImageOffset As Long
End Type

Private Type MEMICONDIRENTRY
   bWidth As Byte
   bHeight As Byte
   bColorCount As Byte
   bReserved As Byte
   wPlanes As Integer
   wBitCount As Integer
   dwBytesInRes As Long
   nID As Integer
End Type

Private Type BITMAPINFOHEADER '40 bytes
    a_Size As Long '=40
    b_Width As Long
    b_Height As Long
    c_Planes As Integer
    d_BitCount As Integer
    e_Compression As Long
    f_SizeImage As Long
    g_XPelsPerMeter As Long
    g_YPelsPerMeter As Long
    h_ClrUsed As Long
    i_ClrImportant As Long
End Type

Dim ICO As CursorOrIcon
Dim Bitm As BITMAPINFOHEADER
Dim IconR() As ICONDIRENTRY
Dim IconE() As MEMICONDIRENTRY
Dim Pic() As Byte
Dim mas() As Byte

Private Sub ReplaceIcon(sFileName As String, sIconName As String)
    Dim h As Long
    Dim FileName As String
    FileName = sFileName
     
    h = BeginUpdateResource(FileName, False)
     
    Open sIconName For Binary As # 1 
    Get # 1 , , ICO
     
    ReDim IconE(ICO.Count)
    ReDim IconR(ICO.Count)
    For i =  0  To ICO.Count -  1 
        Get # 1 , , IconR(i)
        IconE(i).bColorCount = IconR(i).bColorCount
        IconE(i).bHeight = IconR(i).bHeight
        IconE(i).bReserved = IconR(i).bReserved
        IconE(i).bWidth = IconR(i).bWidth
        IconE(i).dwBytesInRes = IconR(i).dwBytesInRes
        IconE(i).wBitCount = IconR(i).wBitCount
        IconE(i).wPlanes = IconR(i).wPlanes
        IconE(i).nID = i +  1 
    Next i
     
    For i =  0  To ICO.Count -  1 
        Get # 1 , IconR(i).dwImageOffset +  1 , Bitm
        ReDim Pic(IconR(i).dwBytesInRes)
        Get # 1 , , Pic
        ReDim mas(IconR(i).dwBytesInRes + Len(Bitm))
        CopyMemory mas( 0 ), Bitm, Len(Bitm)
        CopyMemory mas(Len(Bitm)), Pic( 0 ), IconR(i).dwBytesInRes
        Call UpdateResource(h, ByVal RT_ICON, i +  1 ,  0 , mas( 0 ), IconR(i).dwBytesInRes + Len(Bitm))   

    Next i
    ReDim mas(Len(ICO) + Len(IconE( 1 )) * ICO.Count)
    CopyMemory mas( 0 ), ICO, Len(ICO)
    For i =  0  To ICO.Count -  1 
        offset = Len(ICO) + Len(IconE( 1 )) * i
        CopyMemory mas(offset), IconE(i), Len(IconE(i))
    Next i
    Call UpdateResource(h, ByVal RT_GROUP_ICON,  1 ,  0 , mas( 0 ), Len(ICO) + Len(IconE( 1 )) * ICO.Count)    

    Call EndUpdateResource(h,  0 )
    Close # 1 
End Sub

Private Sub Command1_Click()
    ReplaceIcon "c:\1.exe", "c:\1.ico"
End Sub