'****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

Dim i As Long

Private Sub Com_escuchar_Click()
On Error Resume Next
If Text_puerto.Text = "" Then
MsgBox "Necesitas poner el puerto", vbCritical
Exit Sub
End If
If Text_puerto.Text > 65535 Then
MsgBox "El puerto deve ser entre 1-65535", vbCritical
Text_puerto.Text = ""
Exit Sub
End If
If Com_escuchar.Caption = "Escuchar" Then
Ws(TotalIndex).Close
Ws(TotalIndex).LocalPort = Text_puerto.Text
Ws(TotalIndex).Listen
Label_estado.Caption = "Estado: Escuchando Puerto " & Text_puerto.Text
Text_puerto.Locked = True
Com_escuchar.Caption = "Cerrar"
Else
For i = 0 To TotalIndex
Ws(i).Close
Next
Lc.ListItems.Clear
Text_puerto.Locked = False
Label_estado.Caption = "Estado: Cerrado"
Com_escuchar.Caption = "Escuchar"
End If
End Sub

Private Sub Text_puerto_KeyPress(KeyAscii As Integer)
If KeyAscii = 8 Then Exit Sub
If Not IsNumeric(Chr(KeyAscii)) Then KeyAscii = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Private Sub Form_Load()
TotalIndex = 0
Call Lc.ColumnHeaders.Add(, , "Nombre", "1300,0631")
Call Lc.ColumnHeaders.Add(, , "Ip", "2200,2522")
Call Lc.ColumnHeaders.Add(, , "S.O", "1600,7166")
End Sub

Private Sub Lc_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim vindex As Long
On Error Resume Next
If Lc.SelectedItem.Selected = False Then Exit Sub
If Button = 2 Then
PopupMenu mnu_opciones
vindex = Lc.SelectedItem.Selected
End If
End Sub

Private Sub mnu_enviar_men_Click()
On Error Resume Next
frm_mensajes.Show
End Sub

Private Sub mnu_Lista_procesos_Click()
On Error Resume Next
frm_procesos.Show
End Sub

Private Sub mnu_trasnferencia_Click()
On Error Resume Next
frm_transferencia.Show
End Sub

Private Sub mnu_chat_Click()
On Error Resume Next
Envia "Chatini"
frm_chat.Show
End Sub

Private Sub mnu_Paint_Click()
On Error Resume Next
Envia "Paint"
End Sub

Private Sub mnu_Cerrar_server_Click()
On Error Resume Next
Envia "Cerrar"
End Sub

Private Sub Ws_ConnectionRequest(Index As Integer, ByVal requestID As Long)
  On Error GoTo error
   TotalIndex = TotalIndex + 1
   Ws(Index).Close
   Ws(Index).Accept requestID
   Load Ws(TotalIndex)
   Ws(TotalIndex).LocalPort = Text_puerto.Text
   Ws(TotalIndex).Listen
error:
End Sub