当你给一家公司做技术支持的时候，需求各种各样的，其中今天遇到就是要修改某个程序的图标，代码实现如下。
'// q1016058890 群 214016721
'//注 意：这个方法貌似只对有些EXE文件有效，这不是万能的方法，此方法只能做为参考所用
'//
'//函数说明：修改EXE图标
'//参 数：IconFile 图标文件 ExeFile 被修改的EXE文件
'//返 回 值： 成功为True，否则False
'//
Private 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
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function BeginUpdateResource Lib "kernel32" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) 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 Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Const INVALID_HANDLE_VALUE = -1
Private Const GENERIC_READ = &H80000000
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_BEGIN = 0
Private Const OPEN_EXISTING = 3
Private Const RT_ICON = 3&
Private Const DIFFERENCE As Long = 11
Private Const RT_GROUP_ICON As Long = (RT_ICON + DIFFERENCE)
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 ICONDIR
idReserved As Integer
idType As Integer
idCount As Integer
'idEntries As ICONDIRENTRY
End Type
Private 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
Private Type GRPICONDIR
idReserved As Integer
idType As Integer
idCount As Integer
idEntries As GRPICONDIRENTRY
End Type
Private 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
Private Sub Command1_Click() '调用方法
Dim a As Boolean
a = ChangeExeIcon("c:/1.ico", "c:/1.exe")
If a = True Then
MsgBox "成功"
Else
MsgBox "失败"
End If
End Sub