网站建设具体需求,中国工商网查询入口,网站的技术维护一般要做些什么,dede古风类网站源码当你给一家公司做技术支持的时候#xff0c;需求各种各样的#xff0c;其中今天遇到就是要修改某个程序的图标#xff0c;代码实现如下。
// q1016058890 群 214016721 //注 意#xff1a;这个方法貌似只对有些EXE文件有效#xff0c;这不是万能的方法#xff0c;此…当你给一家公司做技术支持的时候需求各种各样的其中今天遇到就是要修改某个程序的图标代码实现如下。
// 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
