A pedido de KiZar me puse a investigar y logré escribir un code que funciona tanto en Win9X como en Win2K y demás.
El problema erradicaba en los datos que había que ingresar en el ejecutable, no tanto en la llamada a UpdateResource. Así que escribí una función que extrae los datos crudos de un archivo de ícono (*.ico), o sea, la imagen en sí, de esta manera ya funciona perfectamente.
Módulo basChangeRes.bas
'
'Coded by Slasher-K
'
Public Declare Function BeginUpdateResource Lib "unicows.dll" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
Public Declare Function UpdateResource Lib "unicows.dll" 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
Public Declare Function EndUpdateResource Lib "unicows.dll" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Long
Function ChangeIcon(Filename As String, IconFilename As String) As Boolean
On Error GoTo ErrRes
Dim hRes&, r&
Dim btData() As Byte
hRes = BeginUpdateResource(Filename, False)
If hRes = 0 Then
Debug.Print "No se pudo abrir el archivo"
Exit Function
End If
btData = GetIconData(IconFilename)
r = UpdateResource(hRes, RT_ICON, 1, 3082, btData(0), UBound(btData))
ErrRes:
r = EndUpdateResource(hRes, False)
End Function
Módulo basIcons.bas
'
'Coded by Slasher-K
'
Option Explicit
Type ICONDIRENTRY
bWidth As Byte ' Ancho, en píxeles, de la imagen.
bHeight As Byte ' Alto, en píxeles, de la imagen.
bColorCount As Byte ' Número de colores en la imagen (0 si >=8bpp).
bReserved As Byte ' Reservado ( debe ser 0).
wPlanes As Integer ' Color Planes.
wBitCount As Integer ' Bits por pixel.
dwBytesInRes As Long ' Bytes in the resource.
dwImageOffset As Long ' Puntero a los datos en el archivo.
End Type
Type ICONDIR
idReserved As Integer
idType As Integer
idCount As Integer
End Type
Function GetIconData(IcoFile As String, Optional IconIndex As Integer) As Byte()
On Error Resume Next
Dim lpIconDir As ICONDIR
Dim lpIconEntry As ICONDIRENTRY
Dim btData() As Byte
Dim lOffset&, iCnt%
Dim hFile%, i%
hFile = FreeFile
Open IcoFile For Binary As #hFile
Get #hFile, 1, lpIconDir
With lpIconDir
lOffset = Len(lpIconDir) + 1
If (IconIndex > .idCount) Or (IconIndex < 1) Then IconIndex = 1
For i = 1 To .idCount
Get #hFile, lOffset, lpIconEntry
If i = IconIndex Then
ReDim btData(lpIconEntry.dwBytesInRes) As Byte
Get #hFile, lpIconEntry.dwImageOffset + 1, btData
GetIconData = btData
Exit For
End If
lOffset = lOffset + Len(lpIconEntry)
Next
End With
ErrRead:
Close #hFile
End Function
RT_ICON = ¿?
Salu2
RT_ICON = 3
Declarada en win.tlb
Yo tengo windows XP y pongo:
Private Sub Form_Load()
ChangeIcon "C:\f.exe", "C:\a.ico"
End Sub
Y el programa se cuelga y deja el exe como esta sin cambiar el icono....
Bajate unicows.dll y copiala al direcotorio del sistema, si no funciona cambia las declaraciones para usar las de kernel32.dll.
Descargar unicows.dll (http://download.microsoft.com/download/b/7/5/b75eace3-00e2-4aa0-9a6f-0b6882c71642/unicows.exe)
Saludos.
Ya la tenia instalada de antes, pero el problema no es ese, el problema es que da un fallo de windows que pone que:
"La aplicacion ha provocado un error y debe ser cerrada..."
Ya es tarde aqui , mañana busco informacion sobre el uso de esas apis y algun ejemplo, aunke hay poca cosa en internet....
Salu2
El problema está en que Windows 9x no implementa esas llamadas porque son funciones Unicode, por eso hay que usar la otra librería (unicows.dll), en cambio Windows NT/2k sí, por lo que se pueden usar tranquilamente las funciones de kernel32.dll, pero las Unicode, o sea, BeginUpdateResourceW, etc.
Por eso lo que se puede hacer es verificar qué sistema es y usar distintas llamadas dependiendo de la versión. Dejo el code modificado para que sea independiente del SO.
Public Declare Function BeginUpdateResource9x Lib "unicows.dll" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
Public Declare Function UpdateResource9x Lib "unicows.dll" 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
Public Declare Function EndUpdateResource9x Lib "unicows.dll" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Long
Public Declare Function BeginUpdateResourceNT Lib "kernel32" Alias "BeginUpdateResourceW" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
Public Declare Function UpdateResourceNT Lib "kernel32" Alias "UpdateResourceW" (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
Public Declare Function EndUpdateResourceNT Lib "kernel32" Alias "EndUpdateResourceW" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Long
Function ChangeIcon(Filename As String, IconFilename As String) As Boolean
On Error GoTo ErrRes
Dim hRes&, r&
Dim btData() As Byte
If IsWin9x Then
hRes = BeginUpdateResource9x(Filename, False)
Else
hRes = BeginUpdateResourceNT(Filename, False)
End If
If hRes = 0 Then
Debug.Print "No se pudo abrir el archivo"
Exit Function
End If
btData = GetIconData(IconFilename)
If IsWin9x Then
r = UpdateResource9x(hRes, RT_ICON, 1, 3082, btData(0), UBound(btData))
Else
r = UpdateResourceNT(hRes, RT_ICON, 1, 3082, btData(0), UBound(btData))
End If
ErrRes:
If IsWin9x Then
r = EndUpdateResource9x(hRes, False)
Else
r = EndUpdateResourceNT(hRes, False)
End If
End Function
Function IsWin9x() As Boolean
Dim lpVerInfo As OSVERSIONINFO
Dim r&
lpVerInfo.dwOSVersionInfoSize = Len(lpVerInfo)
r = GetVersionEx(lpVerInfo)
IsWin9x = (lpVerInfo.dwPlatformId = 1)
End Function
Eso debería funcionar. A mi en win9x me funciona perfecto. Y por inet no vas a encontrar mucho ni menos código, te lo aseguro :P.
Cita de: .Slasher-K. en 8 Marzo 2006, 22:17 PM
Eso debería funcionar. A mi en win9x me funciona perfecto. Y por inet no vas a encontrar mucho ni menos código, te lo aseguro :P.
Encontre algo, pero en frances y era muy largo el code, porl o menos ahora ya no da el error, pero no cambia el icono. (llorar)
Mañana mirare a ver lo que pasa.
¿A ver, pero cómo lo llamas?
El argumento IconFilename tiene que ser un archivo *.ico. Probando en XP (gracias Crack_X ;D), me di cuenta que las llamadas unicode no funcionan, tienen que ser las Ansi
Public Declare Function BeginUpdateResourceNT Lib "kernel32" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
Public Declare Function UpdateResourceNT 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
Public Declare Function EndUpdateResourceNT Lib "kernel32" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Long
Private Sub Form_Load()
ChangeIcon "C:\f.exe", "C:\a.ico"
End Sub
Salu2
Bueh qué sé yo, andá probando el código con F8 y fijate donde falla. Pasteo una conversación por irc que te puede ayudar xD.
Citar
[18:32:56] <Crack_X> Angellore, al ejecutar el programa para cambiar el icono da un debug.print no se pudo abrir el archivo
[18:33:02] <Angellore> Ahhh
[18:33:14] <Angellore> entonces falla BeginUpdateResource
[18:33:18] <Angellore> donde dice
[18:33:25] <Angellore> BeginUpdateResourceNT
[18:33:35] <Angellore> que dice lib "kernel32"
[18:33:47] <Angellore> cambiale en los alias la W por la A
[18:33:52] <Crack_X> ok
[18:34:35] <Crack_X> aun no funca
[18:34:39] <Angellore> qué dice
[18:35:01] <Crack_X> No se pudo abrir el archivo
[18:35:03] <Angellore> metele un punto de interrupción en If IsWin9x Then
[18:35:09] <Crack_X> Public Declare Function BeginUpdateResourceNT Lib "kernel32" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
[18:35:09] <Crack_X> Public Declare Function UpdateResourceNT 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
[18:35:09] <Crack_X> Public Declare Function EndUpdateResourceNT Lib "kernel32" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Long
[18:35:12] <Crack_X> los cambie por A
[18:35:15] <Angellore> está bien
[18:35:18] <Angellore> metele un punto de interrupción en If IsWin9x Then
[18:35:38] <Angellore> cuando el programa se pare
[18:35:46] <Angellore> Apretá Shift+F8
[18:35:51] <Angellore> y fijate a qué instrucción pasa
[18:35:52] <Crack_X> If IsWin9x Then
[18:35:52] <Crack_X> hRes = BeginUpdateResource9x(Filename, False)
[18:35:52] <Crack_X> MsgBox "punto"
[18:35:55] <Crack_X> no llega ahi
[18:36:09] <Angellore> Cómo que no llega
[18:36:17] <Crack_X> estoy en winXP no 9x :P
[18:36:23] <Angellore> pero debería devolver false
[18:36:25] <Angellore> esa función
[18:36:31] <Angellore> no llega a la condición?
[18:36:38] <Angellore> :S
[18:36:45] <Crack_X> quieres que ponga la interrumpcion en la funcion o en el if?
[18:36:52] <Angellore> en el if
[18:37:11] <Crack_X> dime que pongo
[18:37:23] <Angellore> poné el cursor en la linea
[18:37:25] <Angellore> del If
[18:37:30] <Angellore> y apretá F9
[18:37:41] <Angellore> nunca usaste el debugger de VB?
[18:37:42] <Angellore> :S
[18:37:45] <Crack_X> no :p
[18:37:50] <Angellore> es lo mejor que existe
[18:37:53] <Angellore> ahora aparece en rojo
[18:37:56] <Angellore> no?
[18:38:01] <Crack_X> si me di cuenta, me recuerda al olly xD
[18:38:08] <Angellore> bueh
[18:38:11] <Angellore> ejecutá el código
[18:38:27] <Angellore> cuando se detenga avisame
[18:38:44] <Crack_X> esta detenido
[18:38:57] <Angellore> ahora te enseño a usar ya que estás
[18:39:01] <Angellore> ves que está en amarillo
[18:39:02] <Angellore> no?
[18:39:05] <Crack_X> si
[18:39:07] <Angellore> eso es la instrucción actual
[18:39:15] <Angellore> en el costado te aparece un indicador
[18:39:17] <Angellore> del mismo color
[18:39:38] <Angellore> fijate que con el mouse, si mantenés la tecla apretada, podés pasar a la instrucción que quieras
[18:39:43] <Angellore> probá eso
[18:39:47] <Crack_X> en el costado? que costado? a la izquierda aparece un puntito rojo con una flechita amarilla
[18:39:52] <Angellore> si
[18:39:55] <Angellore> la felchita amarilla
[18:39:58] <Angellore> la podés arrastras
[18:40:01] <Angellore> arrastrar
[18:40:03] <Angellore> a la linea que quieras
[18:40:06] <Angellore> que se ejecute
[18:40:09] <Crack_X> ok se puede arrastrar la flechita
[18:40:17] <Crack_X> que divertido :p
[18:40:22] <Angellore> ahora dejala donde está
[18:40:23] <Angellore> en el If
[18:40:34] <Angellore> si apretás F8, va paso a paso entrando en los procedimientos
[18:40:48] <Crack_X> ok, muy parecido al olly :p
[18:40:50] <Angellore> si apretás Shift+F8, va paso a paso en ese procedimiento
[18:40:53] <Angellore> apretá F8
[18:41:02] <Angellore> y mirá cómo va ejecutando cada linea
[18:41:10] <Angellore> y si ponés el mouse sobre las variables
[18:41:13] <Angellore> dice el valor
[18:41:19] <Crack_X> ok salto al else :p
[18:41:29] <Angellore> perfecto
[18:41:34] <Angellore> ahora que ejecute la llamada
[18:41:37] <Crack_X> shit no vi lo de la variable :p
[18:41:39] <Angellore> a BeginUpdateResource
[18:41:47] <Angellore> En cualquier variable
[18:41:50] <Crack_X> hres = 0
[18:41:57] <Angellore> ya la ejecutaste?
[18:42:07] <Angellore> y devolvió 0
[18:42:07] <Angellore> ?
[18:42:14] <Crack_X> la linea esta ahi en el hres=BeginUpdateResourceblabla
[18:42:18] <Angellore> bueno
[18:42:20] <Angellore> apretá F9
[18:42:21] <Angellore> F8
[18:42:23] <Angellore> *
[18:42:28] <Angellore> para que la ejecute
[18:42:38] <Angellore> y fijate que valor tiene hRes después de la llamada
[18:42:47] <Crack_X> hres = 15532212
[18:42:52] <Angellore> entonces funciona
[18:42:52] <Angellore> :P
[18:42:56] <Angellore> ahora
[18:43:05] <Angellore> pasá a la siguiente instrucción con F8
[18:43:22] <Crack_X> va por if hres = 0 then, sigo?
[18:43:26] <Angellore> sí
[18:43:34] <Angellore> hasta el próximo condicional
[18:44:00] <Crack_X> salto al end if
[18:44:05] <Angellore> claro
[18:44:09] <Angellore> porque hRes no es 0
[18:44:09] <Angellore> :P
[18:44:20] <Angellore> No es precioso este debugger?
[18:44:21] <Angellore> xD
[18:44:41] <Crack_X> de aqui
[18:44:41] <Crack_X> Else
[18:44:41] <Crack_X> r = UpdateResourceNT(hRes, RT_ICON, 1, 3082, btData(0), UBound(btData))
[18:44:48] <Crack_X> salto al ErrRes:
[18:44:58] <Angellore> mmm
[18:45:06] <Angellore> el problema está ahí
[18:45:08] <Angellore> fijate
[18:45:10] <Angellore> que valor tiene r
[18:45:16] <Crack_X> 0
[18:45:22] <Angellore> ese es el arror
[18:45:25] <Angellore> error
[18:45:25] <Angellore> ahora
[18:45:30] <Angellore> veamo que error pasó
[18:45:34] <Angellore> apretá Ctrl+G
[18:45:38] <Angellore> para que salga la ventana inmediato
[18:45:49] <Crack_X> yes
[18:45:51] <Angellore> En esa ventana
[18:45:56] <Angellore> podés ejecutar cualquier comando
[18:45:58] <Angellore> al instante
[18:46:02] <Angellore> escribi
[18:46:10] <Angellore> Debug.Print Err.LastDllError
[18:46:24] <Angellore> y dale enter
[18:46:26] <Crack_X> Debug.Print Err.LastDllError
[18:46:26] <Crack_X> 0
[18:46:31] <Angellore> mmm
[18:46:44] <Angellore> volvé la flechita a la instrucción esa
[18:46:48] <Angellore> UpdateResource
[18:46:50] <Angellore> NT
[18:46:54] <Angellore> arrastrala
[18:46:57] <Angellore> la de ejecución
[18:47:02] <Crack_X> ya
[18:47:09] <Angellore> y volvé a apretar F8
[18:47:21] <Angellore> rápido andá a la ventana inmediato
[18:47:22] <Crack_X> run time error :S
[18:47:27] <Angellore> qué error
[18:47:37] <Crack_X> Subscript out of range
[18:47:40] <Angellore> ahhhhh
[18:47:48] <Crack_X> reinicio la ejecucion?
[18:47:48] <Angellore> el problema está en GetIconData
[18:47:49] <Angellore> :)
[18:47:50] <Angellore> no
[18:48:01] <Angellore> Escribí en la ventana de depuración (inmediato)
[18:48:04] <Angellore> Call Err.Clear
[18:48:04] <Commodore64> jjaja Angellore
[18:48:11] <Commodore64> eso es de lo que querias hacer?
[18:48:20] <Commodore64> para la barra de tareas?
[18:48:23] <Angellore> No
[18:48:24] <Crack_X> Angellore, pero el programa ahora se va cerrar por el run time error
[18:48:26] <Angellore> Es otra cosa
[18:48:32] <Angellore> Crack_X, no
[18:48:37] <Angellore> es error de windows?
[18:48:44] <Angellore> o de VB?
[18:48:47] <Crack_X> no, vb
[18:48:49] <Angellore> entonces
[18:48:53] <Crack_X> dice end debug help
[18:48:54] <Angellore> Call Err.Clear
[18:49:00] <Angellore> En la ventana inmediato
[18:49:02] <Angellore> y listo
[18:49:10] <Angellore> ya reestablece el controlador de errores
[18:49:23] <Crack_X> ya le di
[18:49:24] <Angellore> mmm
[18:49:26] <Angellore> pregunta
[18:49:32] <Angellore> en el argumento IconFilename
[18:49:39] <Angellore> le pasaste el path a un archivo de icono?
[18:49:41] <Angellore> .ico
[18:49:42] <Angellore> ?
[18:50:13] <Crack_X> nop, esta en el mismo path del ejecutable
[18:50:19] <Angellore> xDDDDDDDDDDDDDDDDDDDDDDDD
[18:50:21] <Angellore> con razón
[18:50:27] <Angellore> tiene que ser un archivo .ico
[18:50:32] <Angellore> para que lo cambie por ese
[18:50:33] <Angellore> :p
[18:51:00] <Angellore> Crack_X, pará la ejecución y cambiale eso
[18:51:01] <Angellore> dale
[18:51:06] <Angellore> ponele un archivo de ícono
[18:51:33] <Crack_X> Angellore, se llama angry.ico y si es .ico :p
[18:51:59] <Crack_X> En GetIconData cae en
[18:52:00] <Crack_X> ErrRead:
[18:52:00] <Crack_X> Close #hFile
[18:52:14] <Angellore> mmm
[18:52:20] <Angellore> luego de qué instrucción
[18:52:22] <Angellore> cae ahí
[18:52:49] <Crack_X> Exit For
[18:52:57] <Angellore> ahhh bien
[18:53:00] <Angellore> pero entonces funciona
[18:53:04] <Angellore> ahora seguí
[18:53:07] <Angellore> ya tiene que funcionar
[18:53:19] <Angellore> dale F5
[18:53:22] <Angellore> así lo hace tood
[18:53:24] <Angellore> todo
[18:53:24] <Angellore> :p
[18:54:01] <Crack_X> ains no funciono, pero empiezo de nuevo con f5 :p
[18:54:19] <Angellore> dale
[18:55:02] <Crack_X> r = UpdateResourceNT(hRes, RT_ICON, 1, 3082, btData(0), UBound(btData))
[18:55:09] <Crack_X> esto devuelve 1 asi que deberia de funcionar
[18:55:20] <Angellore> sí
[18:55:31] <Angellore> ahora pasá a EndUpdateResource
[18:55:33] <Angellore> y listo
[18:55:54] <Crack_X> pero el icono no cambia :p
[18:55:56] <Angellore> mmm
[18:56:14] <Angellore> a ver
[18:56:21] <Angellore> en la llamada a UpdateResource
[18:56:37] <Angellore> pasá el mouse por arriba de UBound(btData)
[18:56:42] <Angellore> y fijate qué valor tiene
[18:56:49] <Angellore> o sea, cuántos bytes hay
[18:57:21] <Crack_X> oki
[18:58:31] <Crack_X> 1360
[18:58:41] <Angellore> el tamaño del ícono es ese
[18:58:45] <Angellore> tiene que funcionar
[18:58:45] <Angellore> :S
[18:58:49] <Angellore> qué raro
[18:58:52] <Angellore> a ver
[18:58:55] <Angellore> tenés el reshacker?
[18:59:02] <Kalisto> :O
[18:59:03] <Crack_X> umms dejame ver
[18:59:19] <Crack_X> nop no lo tengo
Si alguien tiene el ResHacker que se fije en los recursos de Icono, tiene que aparecer el primero con id 1 y el recurso 3082
Icono/1/3082
Debería cambiar el icono, lo raro es que a mí me funciona perfecto en Win9X, ahora lo compilo y subo el ejecutable a ver qué tal va en XP.
Cualquier cosa: irc.emule-spain.org, #elhacker.net
Bueno después de luchar un rato con este código pude hacer que cambie el ícono de cualquier aplicación. El problema estaba en que sólo cambiaba el icono de la página de códigos 3082 y del ícono con el nombre '1', pero no todas las aplicaciones usan ese ícono como el predeterminado, y por supuesto no todas tienen el mismo idioma.
Existen dos opciones, leer el ejecutable para determinar qué id de ícono usa como el predeterminado, o cambiar todos los iconos que es mucho más sencillo y menos código, yo opté por la 2ª porque ando con poco tiempo xD.
Lo que hace el siguiente código es buscar todos los recursos de íconos y en todos los idiomas y reemplazarlo por el que nosotros queramos, así nos aseguramos que el ícono que usa como predeterminado cambie.
Option Explicit
Type RES_ICON
ResName As Integer
ResLang As Integer
End Type
Public Declare Function BeginUpdateResource9x Lib "unicows.dll" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
Public Declare Function UpdateResource9x Lib "unicows.dll" 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
Public Declare Function EndUpdateResource9x Lib "unicows.dll" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Long
Public Declare Function BeginUpdateResourceNT Lib "kernel32" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
Public Declare Function UpdateResourceNT 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
Public Declare Function EndUpdateResourceNT Lib "kernel32" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Long
Public Declare Function EnumResourceLanguages Lib "kernel32" Alias "EnumResourceLanguagesA" (ByVal hModule As Long, ByVal lpType As Long, ByVal lpName As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public Declare Function EnumResourceNames Lib "kernel32" Alias "EnumResourceNamesA" (ByVal hModule As Long, ByVal lpType As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private iResLangId As Integer
Private lResName As Long
Private lpIcons() As RES_ICON
Private lIcons As Long
Function ChangeIcon(Filename As String, IconFilename As String) As Boolean
On Error GoTo ErrRes
Dim btIconData() As Byte
Dim lpResIcon() As RES_ICON
Dim hRes&, lCnt&
Dim i%, r&
lCnt = EnumIcons(Filename, lpResIcon)
If IsWin9x Then
hRes = BeginUpdateResource9x(Filename, False)
Else
hRes = BeginUpdateResourceNT(Filename, False)
End If
If hRes = 0 Then
Debug.Print "No se pudo abrir el archivo"
Exit Function
End If
btIconData = GetIconData(IconFilename)
For i = 1 To lCnt
If IsWin9x Then
r = UpdateResource9x(hRes, RT_ICON, lpResIcon(i).ResName, lpResIcon(i).ResLang, btIconData(0), UBound(btIconData))
Else
r = UpdateResourceNT(hRes, RT_ICON, lpResIcon(i).ResName, lpResIcon(i).ResLang, btIconData(0), UBound(btIconData))
End If
Next
ChangeIcon = True
ErrRes:
If IsWin9x Then
r = EndUpdateResource9x(hRes, False)
Else
r = EndUpdateResourceNT(hRes, False)
End If
End Function
Function IsWin9x() As Boolean
Dim lpVerInfo As OSVERSIONINFO
Dim r&
lpVerInfo.dwOSVersionInfoSize = Len(lpVerInfo)
r = GetVersionEx(lpVerInfo)
IsWin9x = (lpVerInfo.dwPlatformId = 1)
End Function
Function EnumIcons(Filename As String, outResIcon() As RES_ICON) As Long
Call EnumResNames(Filename)
outResIcon = lpIcons
EnumIcons = lIcons
lIcons = 0
Erase lpIcons
End Function
Function EnumResNames(AppFilename As String) As Long
Dim hModule&, r&
hModule = LoadLibraryEx(ByVal AppFilename, 0, LOAD_LIBRARY_AS_DATAFILE)
r = EnumResourceNames(hModule, RT_ICON, AddressOf EnumResNameProc, 0)
Call FreeLibrary(hModule)
EnumResNames = r
End Function
Function EnumResLangProc(ByVal hModule As Long, ByVal dwType As Long, ByVal dwName As Long, ByVal wIDLanguage As Integer, ByVal lParam As Long) As Long
Dim r&
iResLangId = wIDLanguage
lIcons = lIcons + 1
ReDim Preserve lpIcons(lIcons) As RES_ICON
With lpIcons(lIcons)
.ResLang = iResLangId
.ResName = lResName
End With
EnumResLangProc = 1
End Function
Function EnumResNameProc(ByVal hModule As Long, ByVal dwType As Long, ByVal dwName As Long, ByVal lParam As Long) As Long
Dim r&
lResName = dwName
If lResName >= 0 Then
r = EnumResourceLanguages(hModule, RT_ICON, lResName, AddressOf EnumResLangProc, 0)
End If
EnumResNameProc = 1
End Function
Curioso...... Mira como kedo el emule xD
(http://img332.imageshack.us/img332/804/emule1vw.png)
Ya va perfecto Salu2
Muy bueno el ejemplo felicitaciones, lo prove asi medio a la ligera tuve algunos errores, y creo que en la mayoria de los casos son con aplicaciones pequeñas(el ejecutable queda corrupto ) pero con las grandes funciono muy bien
Un saludo
Kizar, queda muy bonito tu Emule. ;D Se ve que hay que hacer la primera version que dijo .Slasher-K. Sino te va a cambiar absolutamente todos los iconos del .exe
Cita de: Gorky en 10 Marzo 2006, 12:50 PM
Kizar, queda muy bonito tu Emule. ;D Se ve que hay que hacer la primera version que dijo .Slasher-K. Sino te va a cambiar absolutamente todos los iconos del .exe
Ya, pero ese codigo solo es un ejemplo, cuando tenga tiempo are algo un poco mas parecido al reshacker, k te permita cambiar solo el icono que quieras, el code es ese, falta cambiar 2 lineas de code.
<salu2