用UpdateResource修改EXE文件图标(已修正)

  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 

 

转载于:https://www.cnblogs.com/xxaxx/archive/2009/12/29/1635326.html