Cambiar Icono de Aplicación en tiempo de ejecución

[.Slasher-K.]

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.

[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
[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>
[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>
[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

[.Slasher-K.]

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.

Código [Seleccionar] Expandir


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


[Kizar]

Curioso...... Mira como kedo el emule xD



Ya va perfecto Salu2

[LeandroA]

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

[Gorky]

Kizar, queda muy bonito tu Emule.  Se ve que hay que hacer la primera version que dijo .Slasher-K. Sino te va a cambiar absolutamente todos los iconos del .exe

[Kizar]

Kizar, queda muy bonito tu Emule.  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