改EXE图标的代码代码,VB.Net代码库,德仔网

代码语言
代码分类
【VB.Net】改EXE图标的代码
作者:Dezai.CN / 发布于2012/11/28/ 960
Option Explicit



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





'//////////////////////////////////////////////

'//函数说明：修改EXE图标

'//

'//参    数：IconFile 图标文件

'//              ExeFile 被修改的EXE文件

'//

'//返回值： 成功为True，否则False

'/////////////////////////////////////////////////////

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
试试其它关键字
　改EXE图标　
同语言下
可能有用的
Dezai.CN贡献的其它代码(4037)