VB 替换EXE文件图标

fdcube 2008-07-19 05:56:06
我有一个VC版的替换图标代码，但是用到VB就不行了，大家帮忙下，能不能实现，还有就是在提问之前我看了相关的帖子，都没有给出一个答案，所以就又问了一次。

VC核心代码如下：
   HINSTANCE hInstance=LoadLibrary("D:\\dd.exe");//载入图标源文件

    HRSRC hRsrc = FindResource(hInstance,(LPCSTR)1,(LPCSTR)RT_ICON); //查找源文件中的图标文件

    LPVOID lpRes = LockResource(LoadResource(hInstance,hRsrc)); //锁定资源

    HANDLE hUpdateRes = BeginUpdateResource("D:\\dd2.exe", FALSE); //更新dd2文件图标为dd的

    UpdateResource(hUpdateRes,(LPCSTR)RT_ICON, (LPCSTR)1,0,lpRes,SizeofResource(hInstance,hRsrc)); //更新图标资源

    EndUpdateResource(hUpdateRes,FALSE);   //结束更新资源

    CloseHandle(hRsrc); //关闭句柄

    CloseHandle(hUpdateRes);//关闭句柄

    FreeLibrary(hInstance); //释放载入的源文件

我照着VC的代码抄的VB代码如下：
Private Declare Function FindResource Lib "kernel32" Alias "FindResourceA" (ByVal hInstance As Long, ByVal lpName As String, ByVal lpType As String) As Long

Private Declare Function LockResource Lib "kernel32" (ByVal hResData As Long) As Long

Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) 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 String, ByVal lpName As String, 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 Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

Private Declare Function LoadResource Lib "kernel32" (ByVal hInstance As Long, ByVal hResInfo As Long) As Long

Private Declare Function SizeofResource Lib "kernel32" (ByVal hInstance As Long, ByVal hResInfo As Long) As Long

Dim chan As Boolean

Dim chan2 As Boolean





Private Sub Command1_Click()

lpLibFileName = "d:\\dd.exe"

hInstance = LoadLibrary(lpLibFileName)

hResInfo = FindResource(hInstance, 1, RT_ICON)

lpData = LockResource(LoadResource(hInstance, hResInfo))

hUpdate = BeginUpdateResource("d:\\dd2.exe", False)

chan = UpdateResource(hUpdate, Icon, RT_ICON, 0, lpData, SizeofResource(hInstance, hResInfo))

chan2 = EndUpdateResource(hUpdate, False)

CloseHandle (hResInfo)

CloseHandle (hUpdate)

FreeLibrary (hInstance)

End Sub


大家帮忙看下该怎么办，我写的那个垃圾VB代码是相当的垃圾，一运行就内存指令完蛋。。
...全文
554 9 打赏 收藏 转发到动态 举报
写回复
用AI写文章
9 条回复
切换为时间正序
请发表友善的回复…
发表回复
fdcube 2008-07-20
  • 打赏
  • 举报
 回复
其实偶想要的是 先提取一个EXE的图标，然后将这个提取到的图标再换到另外一个EXE上。。。
huangct 2008-07-20
  • 打赏
  • 举报
 回复
晕啊，这是我刚想问的问题，我前两天在黑客防线上看到的楼主的vc源码，移植到vb上却出错了，我想知道为什么出错，还有
我没犯3楼所说的错误
fdcube 2008-07-20
  • 打赏
  • 举报
 回复
啊哦。。。马大哥也来咯。。。。说说你的意见也好啊。。。多一个人的意见多点只是啊，不行的话，
可以加分啊。
嗷嗷叫的老马 2008-07-19
  • 打赏
  • 举报
 回复
靠,20分就这么没了......来迟了
fdcube 2008-07-19
  • 打赏
  • 举报
 回复
先看看，明天试验试验在结贴。。
fdcube 2008-07-19
  • 打赏
  • 举报
 回复
我感觉楼上的说得挺对的。。。
zzyong00 2008-07-19
  • 打赏
  • 举报
 回复
楼主把C++到VB翻译的太“直”了
如：d:\\dd.exe
迈克揉索芙特 2008-07-19
  • 打赏
  • 举报
 回复
注:转帖请包函作者信息.(作者：菜新)

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
迈克揉索芙特 2008-07-19
  • 打赏
  • 举报
 回复
http://blog.csdn.net/Modest/archive/2008/07/19/2678394.aspx
VB生成EXE文件图标ICO替换(不限于VB)
VB自带的图标都很丑，本工具对生成的EXE文件图标能够快捷的替换，可以换成各种自己希望的ico格式的图标，非常方便
VB修改EXE文件图标实现
内容索引:VB源码,图形处理,图标　　利用VB编写的一个小工具，用于实现修改EXE文件的图标，测试抓图如上所示，选择你要更改的EXE文件的址，再选择一个你准备好的图标文件，点击“修改图标”，原EXE文件的图标就被修改成了你选择的图标，其实不知道有什么用，我们一般不会去修改图标的，只是让理解一下内部机理，有助于我们学习编程。
计算机二级（VB）
计算机二级（VB）教程，全面、系统、细致地介绍了计算机二级（VB）的相关知识点。 课程能够帮助学习者快速入门。 该课程面向对象： 备考计算机二级（VB）的课程 备课期末考试 自学VB程序设计 课程注意提高学习者实战...
替换exe文件的图标
原VS2010里生成的图标太丑，需要最求自己的个性化的的图标
VB制作播放器的播放列表控件，十分漂亮.rar
VB制作播放器的播放列表控件，十分漂亮，这个列表看上去像是早几年的QQ音乐播放器的风格，现在QQ播放器不是这样子了，MLIST目录中为该列表的控件源码，调用前请编译此项目生成ocx文件，放在示例文件夹下。只花费了一个早上，因为有前一个基础，帮一个网吧写点歌系统，写了一个播放列表控件，因为是自己用，所以功能和样式都是固定的，所以在前面的基础上，重写了这个播放列表 　　有Bug，就是绘画底部的项如果是空白的不会擦除，如果每次擦除，会闪烁，肯定是我的思路里有很大的BUG 　　PS：因为找不到QQ音乐的那个绿色的播放图标,打开下面的所有EXE、DLL、ICO、Image都找不到。。。所以用另外一个图标代替了。图标放在资源文件 TCICON 中的 PLAYICON 里。 　　支持真彩色带 Alpha 通道的图标，替换只要替换这个资源就可以了，替换后修改一下 Private Const ICON_SIZE As Long = 12 '图标的尺寸。
API

1,486

社区成员

23,279

社区内容

发帖
与我相关
我的任务
社区描述
VB API
社区管理员
  • API
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章