1 Option Explicit
2
3
4 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
5
6 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
7
8 Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
9
10 Private Declare Function BeginUpdateResource Lib "kernel32" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
11
12 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
13
14 Private Declare Function EndUpdateResource Lib "kernel32" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Long
15
16 Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
17
18 Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
19
20 Private Declare Function GetLastError Lib "kernel32" () As Long
21
22
23 Private Const INVALID_HANDLE_VALUE = -1
24
25 Private Const GENERIC_READ = &H80000000
26
27 Private Const FILE_ATTRIBUTE_NORMAL = &H80
28
29 Private Const FILE_BEGIN = 0
30
31 Private Const OPEN_EXISTING = 3
32
33 Private Const RT_ICON = 3&
34
35 Private Const DIFFERENCE As Long = 11
36
37 Private Const RT_GROUP_ICON As Long = (RT_ICON + DIFFERENCE)
38
39
40
41 Private Type ICONDIRENTRY
42
43 bWidth As Byte
44
45 bHeight As Byte
46
47 bColorCount As Byte
48
49 bReserved As Byte
50
51 wPlanes As Integer
52
53 wBitCount As Integer
54
55 dwBytesInRes As Long
56
57 dwImageOffset As Long
58
59 End Type
60
61
62 Private Type ICONDIR
63
64 idReserved As Integer
65
66 idType As Integer
67
68 idCount As Integer
69
70 'idEntries As ICONDIRENTRY
71
72 End Type
73
74
75 Private Type GRPICONDIRENTRY
76
77 bWidth As Byte
78
79 bHeight As Byte
80
81 bColorCount As Byte
82
83 bReserved As Byte
84
85 wPlanes As Integer
86
87 wBitCount As Integer
88
89 dwBytesInRes As Long
90
91 nID As Integer
92
93 End Type
94
95
96 Private Type GRPICONDIR
97
98 idReserved As Integer
99
100 idType As Integer
101
102 idCount As Integer
103
104 idEntries As GRPICONDIRENTRY
105
106 End Type
107
108
109
110 '//////////////////////////////////////////////
111
112 '//函数说明：修改EXE图标
113
114 '//
115
116 '//参 数：IconFile 图标文件
117
118 '// ExeFile 被修改的EXE文件
119
120 '//
121
122 '//返回值： 成功为True，否则False
123
124 '/////////////////////////////////////////////////////
125
126 Private Function ChangeExeIcon(ByVal IconFile As String, ByVal ExeFile As String) As Boolean
127
128 On Error GoTo cw
129
130
131
132 Dim stID As ICONDIR
133
134 Dim stIDE As ICONDIRENTRY
135
136 Dim stGID As GRPICONDIR
137
138
139
140 Dim hFile As Long
141
142 Dim pIcon() As Byte, pGrpIcon() As Byte
143
144 Dim nSize As Long, nGSize As Long
145
146 Dim dwReserved As Long
147
148 Dim hUpdate As Long
149
150 Dim ret As Long
151
152
153
154 hFile = CreateFile(IconFile, GENERIC_READ, 0, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
155
156 If hFile = INVALID_HANDLE_VALUE Then Exit Function
157
158
159 ret = ReadFile(hFile, stID, Len(stID), dwReserved, ByVal 0&)
160
161 If ret = 0 Then GoTo cw
162
163
164
165 ret = ReadFile(hFile, stIDE, Len(stIDE), dwReserved, ByVal 0&)
166
167
168 nSize = stIDE.dwBytesInRes
169
170 ReDim pIcon(nSize - 1)
171
172 SetFilePointer hFile, stIDE.dwImageOffset, ByVal 0&, FILE_BEGIN
173
174 ret = ReadFile(hFile, pIcon(0), nSize, dwReserved, ByVal 0&)
175
176 If ret = 0 Then GoTo cw
177
178
179
180 With stGID
181
182 .idType = 1
183
184 .idCount = stID.idCount
185
186 .idReserved = 0
187
188 CopyMemory stGID.idEntries, stIDE, 12
189
190 .idEntries.nID = 0
191
192 End With
193
194
195
196 nGSize = Len(stGID)
197
198 ReDim pGrpIcon(nGSize - 1)
199
200 CopyMemory pGrpIcon(0), stGID, nGSize
201
202
203
204
205
206 hUpdate = BeginUpdateResource(ExeFile, False)
207
208 ret = UpdateResource(hUpdate, RT_GROUP_ICON, 1, 0, pGrpIcon(0), nGSize)
209
210 ret = UpdateResource(hUpdate, RT_ICON, 1, 0, pIcon(0), nSize)
211
212 EndUpdateResource hUpdate, False
213
214
215 If ret = 0 Then GoTo cw
216
217 ChangeExeIcon = True
218
219
220
221 cw:
222
223 CloseHandle hFile
224
225
226
227 End Function
228
2
3
4 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
5
6 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
7
8 Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
9
10 Private Declare Function BeginUpdateResource Lib "kernel32" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
11
12 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
13
14 Private Declare Function EndUpdateResource Lib "kernel32" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Long
15
16 Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
17
18 Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
19
20 Private Declare Function GetLastError Lib "kernel32" () As Long
21
22
23 Private Const INVALID_HANDLE_VALUE = -1
24
25 Private Const GENERIC_READ = &H80000000
26
27 Private Const FILE_ATTRIBUTE_NORMAL = &H80
28
29 Private Const FILE_BEGIN = 0
30
31 Private Const OPEN_EXISTING = 3
32
33 Private Const RT_ICON = 3&
34
35 Private Const DIFFERENCE As Long = 11
36
37 Private Const RT_GROUP_ICON As Long = (RT_ICON + DIFFERENCE)
38
39
40
41 Private Type ICONDIRENTRY
42
43 bWidth As Byte
44
45 bHeight As Byte
46
47 bColorCount As Byte
48
49 bReserved As Byte
50
51 wPlanes As Integer
52
53 wBitCount As Integer
54
55 dwBytesInRes As Long
56
57 dwImageOffset As Long
58
59 End Type
60
61
62 Private Type ICONDIR
63
64 idReserved As Integer
65
66 idType As Integer
67
68 idCount As Integer
69
70 'idEntries As ICONDIRENTRY
71
72 End Type
73
74
75 Private Type GRPICONDIRENTRY
76
77 bWidth As Byte
78
79 bHeight As Byte
80
81 bColorCount As Byte
82
83 bReserved As Byte
84
85 wPlanes As Integer
86
87 wBitCount As Integer
88
89 dwBytesInRes As Long
90
91 nID As Integer
92
93 End Type
94
95
96 Private Type GRPICONDIR
97
98 idReserved As Integer
99
100 idType As Integer
101
102 idCount As Integer
103
104 idEntries As GRPICONDIRENTRY
105
106 End Type
107
108
109
110 '//////////////////////////////////////////////
111
112 '//函数说明：修改EXE图标
113
114 '//
115
116 '//参 数：IconFile 图标文件
117
118 '// ExeFile 被修改的EXE文件
119
120 '//
121
122 '//返回值： 成功为True，否则False
123
124 '/////////////////////////////////////////////////////
125
126 Private Function ChangeExeIcon(ByVal IconFile As String, ByVal ExeFile As String) As Boolean
127
128 On Error GoTo cw
129
130
131
132 Dim stID As ICONDIR
133
134 Dim stIDE As ICONDIRENTRY
135
136 Dim stGID As GRPICONDIR
137
138
139
140 Dim hFile As Long
141
142 Dim pIcon() As Byte, pGrpIcon() As Byte
143
144 Dim nSize As Long, nGSize As Long
145
146 Dim dwReserved As Long
147
148 Dim hUpdate As Long
149
150 Dim ret As Long
151
152
153
154 hFile = CreateFile(IconFile, GENERIC_READ, 0, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
155
156 If hFile = INVALID_HANDLE_VALUE Then Exit Function
157
158
159 ret = ReadFile(hFile, stID, Len(stID), dwReserved, ByVal 0&)
160
161 If ret = 0 Then GoTo cw
162
163
164
165 ret = ReadFile(hFile, stIDE, Len(stIDE), dwReserved, ByVal 0&)
166
167
168 nSize = stIDE.dwBytesInRes
169
170 ReDim pIcon(nSize - 1)
171
172 SetFilePointer hFile, stIDE.dwImageOffset, ByVal 0&, FILE_BEGIN
173
174 ret = ReadFile(hFile, pIcon(0), nSize, dwReserved, ByVal 0&)
175
176 If ret = 0 Then GoTo cw
177
178
179
180 With stGID
181
182 .idType = 1
183
184 .idCount = stID.idCount
185
186 .idReserved = 0
187
188 CopyMemory stGID.idEntries, stIDE, 12
189
190 .idEntries.nID = 0
191
192 End With
193
194
195
196 nGSize = Len(stGID)
197
198 ReDim pGrpIcon(nGSize - 1)
199
200 CopyMemory pGrpIcon(0), stGID, nGSize
201
202
203
204
205
206 hUpdate = BeginUpdateResource(ExeFile, False)
207
208 ret = UpdateResource(hUpdate, RT_GROUP_ICON, 1, 0, pGrpIcon(0), nGSize)
209
210 ret = UpdateResource(hUpdate, RT_ICON, 1, 0, pIcon(0), nSize)
211
212 EndUpdateResource hUpdate, False
213
214
215 If ret = 0 Then GoTo cw
216
217 ChangeExeIcon = True
218
219
220
221 cw:
222
223 CloseHandle hFile
224
225
226
227 End Function
228