當前位置:編程學習大全網 - 源碼下載 - VB編程問題

VB編程問題

使用UpdateResource函數即可修改壹個可執行文件(EXE,DLL等)的資源。包括程序的圖標。

壹般顯示出來的圖標的ID號都是1。

具體的代碼可以參考菜新的~

'EXE圖標修改源碼。

'註:轉帖請包含作者信息.(作者:菜新)

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

  • 上一篇:關於酒店服務質量指標的統計和評價,怎麽才能有比較好的素材?
  • 下一篇:asp能承受多少訪問量?
  • copyright 2024編程學習大全網