新建模块 modChangeIcon.bas,代码:
'ChangeExeIcon 图标地址, 文件地址
Option Explicit
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Public Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Public Declare Function BeginUpdateResource Lib "kernel32" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
Public 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
Public Declare Function EndUpdateResource Lib "kernel32" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetLastError Lib "kernel32" () As Long
Public Const INVALID_HANDLE_VALUE = -1
Public Const GENERIC_READ = &H80000000
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_BEGIN = 0
Public Const OPEN_EXISTING = 3
Public Const RT_ICON = 3&
Public Const DIFFERENCE As Long = 11
Public Const RT_GROUP_ICON As Long = (RT_ICON + DIFFERENCE)
Public 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
Public Type ICONDIR
idReserved As Integer
idType As Integer
idCount As Integer
'idEntries As ICONDIRENTRY
End Type
Public Type GRPICONDIRENTRY
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
Public Type GRPICONDIR
idReserved As Integer
idType As Integer
idCount As Integer
idEntries As GRPICONDIRENTRY
End Type
Public Function ChangeExeIcon(ByVal IconFile As String, ByVal ExeFile As String) As Boolean
On Error GoTo cw
Dim stID As ICONDIR
Dim stIDE As ICONDIRENTRY
Dim stGID As GRPICONDIR
Dim hFile As Long
Dim pIcon() As Byte, pGrpIcon() As Byte
Dim nSize As Long, nGSize As Long
Dim dwReserved As Long
Dim hUpdate As Long
Dim ret As Long
hFile = CreateFile(IconFile, GENERIC_READ, 0, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
If hFile = INVALID_HANDLE_VALUE Then Exit Function
ret = ReadFile(hFile, stID, Len(stID), dwReserved, ByVal 0&)
If ret = 0 Then GoTo cw
ret = ReadFile(hFile, stIDE, Len(stIDE), dwReserved, ByVal 0&)
nSize = stIDE.dwBytesInRes
ReDim pIcon(nSize - 1)
SetFilePointer hFile, stIDE.dwImageOffset, ByVal 0&, FILE_BEGIN
ret = ReadFile(hFile, pIcon(0), nSize, dwReserved, ByVal 0&)
If ret = 0 Then GoTo cw
With stGID
.idType = 1
.idCount = stID.idCount
.idReserved = 0
CopyMemory stGID.idEntries, stIDE, 12
.idEntries.nID = 0
End With
nGSize = Len(stGID)
ReDim pGrpIcon(nGSize - 1)
CopyMemory pGrpIcon(0), stGID, nGSize
hUpdate = BeginUpdateResource(ExeFile, False)
ret = UpdateResource(hUpdate, RT_GROUP_ICON, 1, 0, pGrpIcon(0), nGSize)
ret = UpdateResource(hUpdate, RT_ICON, 1, 0, pIcon(0), nSize)
EndUpdateResource hUpdate, False
If ret = 0 Then GoTo cw
ChangeExeIcon = True
cw:
CloseHandle hFile
End Function