Creo que esta es la solucion, si tenes algun problema o alguna parte del codigo esta mala, comunicamelo
igual si queres que te explique el codigo, ahora me da pereza xD
'En un formulario con:
'Un componente Microsoft Winsock Control 6.0
'Nombre = WK
'Index = 0
'Dos botones de comando:
'Nombre = Escuchandocmd
'Enabled = True
'Nombre = Desconectarcmd
'Enabled = False
'Un label:
'Nombre = Usr
'Dos cajas de Texto
'Nombre = Chattxt
'Locked = True
'Nombre = Mensajetxt
'Enabled = False
'
'Codigo:
Dim ContadorUsuarios&, ContadorSockets&, i&
Private Sub Chattxt_Change()
Chattxt.SelStart = Len(Chattxt.Text)
End Sub
Private Sub Desconectarcmd_Click()
On Error Resume Next
For i = 1 To ContadorSockets
WK(i).Close
Unload WK(i)
Next i
WK(0).Close
Escuchandocmd.Enabled = True
Desconectarcmd.Enabled = False
Mensajetxt.Enabled = False
ContadorSockets = 1
Usr.Caption = "Usuarios conectados: 0"
End Sub
Private Sub Escuchandocmd_Click()
On Error GoTo Error
If WK(0).State <> sckListening Then
WK(0).LocalPort = 1990
WK(0).Protocol = sckTCPProtocol
WK(0).Listen
End If
Do
Chattxt.Text = Chattxt.Text & vbCrLf & "Escuchando en el puerto " & WK(0).LocalPort
Escuchandocmd.Enabled = False
Desconectarcmd.Enabled = True
Mensajetxt.Enabled = True
DoEvents
Loop Until WK(0).State = sckListening
Error:
If Err.Description <> "" Then
Chattxt.Text = "Ha ocurrido un error: " & Err.Description
Err.Description = ""
End If
End Sub
Private Sub Form_Load()
ContadorSockets = 1
End Sub
Private Sub Mensajetxt_KeyPress(KeyAscii As Integer)
If KeyAscii = Asc(vbCrLf) Then
If Val(ContadorSockets) > 1 Then
For i = 1 To ContadorSockets - 1
If WK(i).State = sckConnected Then
WK(i).SendData Replace(Mensajetxt.Text, vbCrLf, "") & vbCrLf
DoEvents
End If
Next i
Chattxt.Text = Chattxt.Text & vbCrLf & Mensajetxt.Text
Mensajetxt.Text = ""
End If
End If
End Sub
Private Sub WK_Close(Index As Integer)
ContadorUsuarios = ContadorUsuarios - 1
Usr.Caption = "Usuarios conectados: " & ContadorUsuarios
Chattxt.Text = Chattxt.Text & vbCrLf & "- La ip " & WK(Index).RemoteHostIP & " ha dejado el chat -"
End Sub
Private Sub WK_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Load WK(ContadorSockets)
WK(ContadorSockets).Accept requestID
Chattxt.Text = Chattxt.Text & vbCrLf & "- Se ha unido la ip " & WK(ContadorSockets).RemoteHostIP & " al chat -"
Usr.Caption = "Usuarios conectados: " & ContadorUsuarios
ContadorSockets = ContadorSockets + 1
ContadorUsuarios = ContadorUsuarios + 1
End Sub
Private Sub WK_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim Datos
WK(Index).GetData Datos, vbString
Chattxt.Text = Chattxt.Text & vbCrLf & WK(Index).RemoteHostIP & " Dice: " & Replace(Replace(Replace(Datos, vbCrLf, ""), vbCr, ""), vbLf, "")
End Sub
Private Sub WK_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Chattxt.Text = "Ha ocurrido un error: " & Description
End Sub