Option Explicit
Public Type ICONDIR
idReserved As Integer ' Reserved (must be 0)
idType As Integer ' Resource Type (1 for icons)
idCount As Integer ' How many images?
'ICONDIRENTRY idEntries[1]; // An entry for each image (idCount of 'em)
End Type
Public Type ICONDIRENTRY
bWidth As Byte ' Width, in pixels, of the image
bHeight As Byte ' Height, in pixels, of the image
bColorCount As Byte ' Number of colors in image (0 if >=8bpp)
bReserved As Byte ' Reserved ( must be 0)
wPlanes As Integer ' Color Planes
wBitCount As Integer ' Bits per pixel
dwBytesInRes As Long ' How many bytes in this resource?
dwImageOffset As Long ' Where in the file is this image?
End Type
Public Type GRPICONDIR
idReserved As Integer ' Reserved (must be 0)
idType As Integer ' Resource Type (1 for icons)
idCount As Integer ' How many images?
'ICONDIRENTRY idEntries[1]; // An entry for each image (idCount of 'em)
End Type
Public Type GRPICONDIRENTRY
bWidth As Byte ' Width, in pixels, of the image
bHeight As Byte ' Height, in pixels, of the image
bColorCount As Byte ' Number of colors in image (0 if >=8bpp)
bReserved As Byte ' Reserved ( must be 0)
wPlanes As Integer ' Color Planes
wBitCount As Integer ' Bits per pixel
dwBytesInRes As Long ' How many bytes in this resource?
dwIconID As Integer ' Where in the file is this image?
End Type
Public Type Dat
Data() As Byte
End Type
Public Type Ico
IcoDir As ICONDIR
Entries() As ICONDIRENTRY
IcoData() As Dat
End Type
Public Type IcoExe
IcoDir As GRPICONDIR
Entries() As GRPICONDIRENTRY
End Type
Private Declare Function BeginUpdateResource Lib "kernel32.dll" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
Private Declare Function UpdateResource Lib "kernel32.dll" 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.dll" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Const RT_ICON As Long = 3&
Private Const DIFFERENCE As Long = 11
Private Const RT_GROUP_ICON As Long = (RT_ICON + DIFFERENCE)
'// ReplaceIcoInExe "C:\EXEtoReplace.exe", OpenIconFile("C:\NewIcon.ico")
Public Function OpenIconFile(FileName As String) As Ico
Dim t As Ico 'structure temporaire
Dim X As Long 'compteur
'on ouvre le fichier
Open FileName For Binary As #1
'on récupère l'entete du fichier
Get #1, , t.IcoDir
'redimensionne au nombre d'icones
ReDim t.Entries(0 To t.IcoDir.idCount - 1)
ReDim t.IcoData(0 To t.IcoDir.idCount - 1)
'pour chaque icones
For X = 0 To t.IcoDir.idCount - 1
'récupère l'entete de l'icone
Get #1, 6 + 16 * X + 1, t.Entries(X)
'redimensionne à la taille des données
ReDim t.IcoData(X).Data(t.Entries(X).dwBytesInRes - 1)
'récupère les données
Get #1, t.Entries(X).dwImageOffset + 1, t.IcoData(X).Data
Next
'ferme le fichier
Close #1
'renvoie les données
OpenIconFile = t
End Function
Private Function MakeIcoExe(IconFile As Ico) As IcoExe
Dim t As IcoExe 'structure temporaire
Dim X As Long 'compteur
'nombre d'icones
t.IcoDir.idCount = IconFile.IcoDir.idCount
'type : Icone = 1
t.IcoDir.idType = 1
'chaque entrée
ReDim t.Entries(IconFile.IcoDir.idCount - 1)
'pour chaque entrée
For X = 0 To t.IcoDir.idCount - 1
'entete d'icones
t.Entries(X).bColorCount = IconFile.Entries(X).bColorCount
t.Entries(X).bHeight = IconFile.Entries(X).bHeight
t.Entries(X).bReserved = IconFile.Entries(X).bReserved
t.Entries(X).bWidth = IconFile.Entries(X).bWidth
t.Entries(X).dwBytesInRes = IconFile.Entries(X).dwBytesInRes
t.Entries(X).dwIconID = X + 1
t.Entries(X).wBitCount = IconFile.Entries(X).wBitCount
t.Entries(X).wPlanes = IconFile.Entries(X).wPlanes
Next
'renvoie la structure
MakeIcoExe = t
End Function
Public Function ReplaceIcoInExe(FileName As String, IcoFile As Ico) As Boolean
Dim hWrite As Long 'handle de modification
Dim Exe As IcoExe 'structure de ressource icone
Dim ret As Long 'valeur de retour
Dim X As Long 'compteur
Dim D() As Byte 'buffer
'obtient un handle de modification
hWrite = BeginUpdateResource(FileName, 0)
'si échec, on quitte
If hWrite = 0 Then ReplaceIcoInExe = False: Exit Function
'sinon, on lit l'icone
Exe = MakeIcoExe(IcoFile)
'on redimmensionne le buffer
ReDim D(6 + 14 * Exe.IcoDir.idCount)
'on copie les données dans le buffer
CopyMemory ByVal VarPtr(D(0)), ByVal VarPtr(Exe.IcoDir), 6
'pour chaque icone
For X = 0 To Exe.IcoDir.idCount - 1
'on copie les données
CopyMemory ByVal VarPtr(D(6 + 14 * X)), ByVal VarPtr(Exe.Entries(X).bWidth), 14&
Next
'on met à jour la ressource groupe icone
ret = UpdateResource(hWrite, RT_GROUP_ICON, 1, 0, ByVal VarPtr(D(0)), UBound(D))
'si échec, on quitte
If ret = 0 Then ReplaceIcoInExe = False: EndUpdateResource hWrite, 1: Exit Function
'on met à jour chaque ressource icone
For X = 0 To Exe.IcoDir.idCount - 1
ret = UpdateResource(hWrite, RT_ICON, Exe.Entries(X).dwIconID, 0, ByVal VarPtr(IcoFile.IcoData(X).Data(0)), Exe.Entries(X).dwBytesInRes)
Next
'on enregsitre dans le fichier executable
ret = EndUpdateResource(hWrite, 0)
'si échec, on quitte
If ret = 0 Then ReplaceIcoInExe = False: Exit Function
'sinon succès
ReplaceIcoInExe = True
End Function
Mostrar Mensajes
