Foro de elhacker.net

Option Explicit
Type DIB_HEADER
   Size        As Long
   Width       As Long
   Height      As Long
   Planes      As Integer
   Bitcount    As Integer
   Reserved    As Long
   ImageSize   As Long
End Type

Type ICON_DIR_ENTRY
   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

Type ICON_DIR
   Reserved          As Integer
   Type              As Integer
   Count             As Integer
End Type

Type DIB_BITS
   Bits()            As Byte
End Type

Public Enum Errors
   FILE_CREATE_FAILED = 1000
   FILE_READ_FAILED

   INVALID_PE_SIGNATURE
   INVALID_ICO
   NO_RESOURCE_TREE
   NO_ICON_BRANCH
   CANT_HACK_HEADERS
End Enum
Public Function ReplaceIcons(Source As String, Dest As String, Error As String) As Long
   
   Dim IcoDir As ICON_DIR
   Dim IcoDirEntry As ICON_DIR_ENTRY
   Dim tBits As DIB_BITS
   Dim Icons() As IconDescriptor
   Dim lngRet As Long
   Dim BytesRead As Long
   Dim hSource As Long
   Dim hDest As Long
   Dim ResTree As Long
   
   hSource = CreateFile(Source, ByVal &H80000000, 0, ByVal 0&, 3, 0, ByVal 0)
   If hSource >= 0 Then
      If Valid_ICO(hSource) Then
         SetFilePointer hSource, 0, 0, 0
         ReadFile hSource, IcoDir, 6, BytesRead, ByVal 0&
         ReadFile hSource, IcoDirEntry, 16, BytesRead, ByVal 0&
         SetFilePointer hSource, IcoDirEntry.dwImageOffset, 0, 0
         ReDim tBits.Bits(IcoDirEntry.dwBytesInRes) As Byte
         ReadFile hSource, tBits.Bits(0), IcoDirEntry.dwBytesInRes, BytesRead, ByVal 0&
         CloseHandle hSource
         hDest = CreateFile(Dest, ByVal (&H80000000 Or &H40000000), 0, ByVal 0&, 3, 0, ByVal 0)
         If hDest >= 0 Then
            If Valid_PE(hDest) Then
               ResTree = GetResTreeOffset(hDest)
               If ResTree > 308 Then 'precaucion chequeo
                  lngRet = GetIconOffsets(hDest, ResTree, Icons)
                  SetFilePointer hDest, Icons(1).Offset, 0, 0
                  WriteFile hDest, tBits.Bits(0), UBound(tBits.Bits), BytesRead, ByVal 0&
                  If Not HackDirectories(hDest, ResTree, Icons(1).Offset, IcoDirEntry) Then
                     Err.Raise CANT_HACK_HEADERS, App.EXEName, "Imposible modificar directorios.  El archivo no contiene ningún recurso." ' que tenga al menos un contenedor de iconos
                  End If
               Else
                  Err.Raise NO_RESOURCE_TREE, App.EXEName, Dest & " No contiene un arbol de recursos válido. El archivo puede estar dañado." 'que no este dañado el archivo
                  CloseHandle hDest
               End If
            Else
               Err.Raise INVALID_PE_SIGNATURE, App.EXEName, Dest & " No es un ejecutable Win32 válido." 'comprobacion de que sea un ejecutable válido
               CloseHandle hDest
            End If
         CloseHandle hDest
         Else
            Err.Raise FILE_CREATE_FAILED, App.EXEName, "Fallo al abrir " & Dest & ". Asegurese que el archivo no esta en uso por otro programa." ' comprobación de que no este en uso
         End If
      Else
         Err.Raise INVALID_ICO, App.EXEName, Source & " no es un recurso de icono válido."
         CloseHandle hSource
      End If
   Else
      Err.Raise FILE_CREATE_FAILED, App.EXEName, "Fallo  al abrir " & Source & ". Asegurese que el archivo no esta en uso por otro programa."
   End If
   ReplaceIcons = 0
   Exit Function
ErrHandler:
   ReplaceIcons = Err.Number
   Error = Err.Description ' muestra la descripcion del numero de error que se produce

End Function
Public Function Valid_ICO(hFile As Long) As Boolean
   Dim tDir          As ICON_DIR
   Dim BytesRead     As Long
   If (hFile > 0) Then
      ReadFile hFile, tDir, Len(tDir), BytesRead, ByVal 0&
      If (tDir.Reserved = 0) And (tDir.Type = 1) And (tDir.Count > 0) Then
         Valid_ICO = True ' comprueba y si es un icono válido...
      Else
         Valid_ICO = False
      End If
   Else
      Valid_ICO = False
   End If
End Function
'Comentarios by P4|3L0

dale tio ;D