Inicio / Directorio / Informática y Telecomunicaciones /

Código VB6 para Chat en Red con Winsock: Cliente y Servidor Paso a Paso

Informática y Telecomunicaciones9,66 KB

Código de un Chat Cliente-Servidor en Visual Basic 6 con Winsock

A continuación se presenta el código de un formulario en Visual Basic 6 que implementa un sistema de chat en red mediante el control Winsock. La aplicación permite actuar como servidor (anfitrión) o como cliente, intercambiar mensajes entre usuarios y gestionar la conexión de nuevos participantes.

Declaración de variables

Option Explicit evita escribir incorrectamente el nombre de una variable existente.

  • Private: la variable puede utilizarse en todo el formulario.
  • Anfitrion (Boolean): indica si la instancia actúa como servidor.
  • NombreUsuario (String): variable de tipo cadena que almacena el nombre del equipo local.
  • Mensaje (String): almacena el texto a enviar o recibir.
  • NConecciones (Integer): variable de tipo entero que controla el número de conexiones.
  • Secuencia (Integer): controla la secuencia de imágenes del icono en la bandeja del sistema.
Option Explicit

' Evita escribir incorrectamente el nombre de una variable existente
' Private: la variable se puede usar en todo el formulario
Private Anfitrion     As Boolean    ' Indica si la instancia es servidor
Private NombreUsuario As String     ' Variable tipo cadena
Private Mensaje       As String
Private NConecciones  As Integer    ' Variable tipo entero
Private Secuencia     As Integer

Procedimiento de salida

Private Sub cmdSalir_Click()
    End
End Sub

Inicialización del formulario (Form_Load)

En este evento se obtiene el nombre del equipo local, se pregunta al usuario si desea ser servidor o cliente, y se configura la conexión correspondiente.

  • Trim$ elimina los espacios finales de las cadenas.
  • UCase$ convierte la cadena especificada en mayúsculas.
Private Sub Form_Load()
    Dim Respuesta As Variant    ' Variable de tipo genérico

    ' El nombre de usuario será igual al nombre del equipo local
    ' Trim$ quita los espacios finales; UCase$ convierte a mayúsculas
    NombreUsuario = UCase$(Trim$(Winsock1(0).LocalHostName))

    NConecciones = 1    ' Número de conexiones inicial

    ' Mensaje que pregunta si desea ser servidor o cliente
    Respuesta = MsgBox("¿Desea ser el servidor?", vbQuestion + vbYesNo, Me.Caption)

    If Respuesta = vbYes Then
        ' Modo servidor
        Anfitrion = True
        Winsock1(0).LocalPort = 5000    ' Puerto local definido
        Winsock1(0).Listen              ' Se pone a la escucha de conexiones remotas
    Else
        ' Modo cliente
        Anfitrion = False
        ' Pregunta a qué dirección conectarse (por defecto 127.0.0.1)
        Respuesta = InputBox$("Dirección a conectarse", "Conectar con", "127.0.0.1")
        If Respuesta = "" Then Unload Me: Exit Sub   ' Si no se escribe nada, se cierra el formulario
        Winsock1(0).RemoteHost = Respuesta           ' IP remota a la que se conectará
        Winsock1(0).RemotePort = 5000                ' Puerto remoto: 5000
        Winsock1(0).Connect                          ' Se inicia la conexión

        DoEvents    ' Permite procesar eventos pendientes
        Do While Winsock1(0).State <> sckConnected
            DoEvents    ' Espera mientras el socket no esté conectado
        Loop

        Mensaje = "NEWUSER   " & NombreUsuario & "          "
        Call Winsock1(0).SendData(Mensaje)           ' Envía el mensaje de nuevo usuario
        DoEvents

        txtTexto.BackColor = vbWindowBackground      ' Color de fondo de la caja de texto
        txtMensaje.BackColor = vbWindowBackground
        txtMensaje.Locked = False                    ' Permite modificar el control
        lstUsuarios.BackColor = vbWindowBackground
    End If

    OldTexto = ""    ' txtTexto.Text
End Sub

Redimensionado del formulario (Form_Resize)

Cuando la ventana se minimiza, el formulario se oculta y se muestra un icono en la bandeja del sistema (systray).

Private Sub Form_Resize()    ' Controla el estado de minimizado de la ventana
    If Me.WindowState <> vbMinimized Then
        Set Systray.TrayIcon = Me.Icon
        Systray.InTray = False
        Timer1.Enabled = False
    Else
        Me.Visible = False
        Secuencia = 0
        OldTexto = txtTexto.Text
        Systray.InTray = True
        Timer1.Enabled = True
    End If
End Sub

Restaurar desde la bandeja del sistema

Al hacer doble clic con el botón izquierdo sobre el icono de la bandeja, la ventana vuelve a su estado normal.

Private Sub sysTray_MouseDblClick(Button As Integer, Id As Long)
    If Button = vbLeftButton Then
        Me.WindowState = vbNormal
        Me.Visible = True
        Systray.InTray = False
    End If
End Sub

Temporizador (Timer1)

Este temporizador se utiliza únicamente para la animación de imágenes del icono de la bandeja, a modo de transición tipo reloj, cuando llegan nuevos mensajes.

Private Sub Timer1_Timer()
    If txtTexto.Text <> OldTexto Then
        If Secuencia > 10 Then Secuencia = 0
        Set Systray.TrayIcon = pic(Secuencia).Picture
        Secuencia = Secuencia + 1
        DoEvents
    End If
End Sub

Envío de mensajes (txtMensaje_KeyPress)

El evento KeyPress permite validar los caracteres introducidos. Al pulsar la tecla Enter (código 13), el mensaje se envía al destinatario seleccionado o a todos los usuarios conectados.

Private Sub txtMensaje_KeyPress(KeyAscii As Integer)
    Dim Contador As Integer
    If KeyAscii = 13 Then    ' Si se pulsa Enter
        If Trim$(txtMensaje.Text) <> "" Then    ' Si la caja de mensaje no está vacía
            Mensaje = "MESSAGE   " & IIf(lstUsuarios.ListIndex = -1, "          ", lstUsuarios.List(lstUsuarios.ListIndex)) & "[" & NombreUsuario & "] " & Trim$(txtMensaje.Text)
            txtTexto.Text = txtTexto.Text & vbNewLine & Mid$(Mensaje, 21)
            txtTexto.SelStart = Len(txtTexto.Text)
            txtMensaje.Text = ""
            lstUsuarios.ListIndex = -1
            If Anfitrion Then
                For Contador = 1 To NConecciones - 1
                    Call Winsock1(Contador).SendData(Mensaje)
                    DoEvents
                Next Contador
            Else
                Call Winsock1(0).SendData(Mensaje)
            End If
        End If
    End If
End Sub

Solicitud de conexión entrante (Winsock1_ConnectionRequest)

Cuando un cliente solicita conectarse, el servidor crea un nuevo socket, acepta la conexión, envía su nombre a los demás participantes y les informa de los usuarios ya conectados.

' Respuesta de conexión
Private Sub Winsock1_ConnectionRequest(Index As Integer, ByVal requestID As Long)
    Dim Contador As Integer
    If Index = 0 Then    ' Si el índice es 0 (socket principal)
        Load Winsock1(NConecciones)                  ' Carga un nuevo socket para la conexión
        Winsock1(NConecciones).LocalPort = 0
        Winsock1(NConecciones).Accept requestID      ' Acepta la conexión entrante
        DoEvents

        Do While Winsock1(NConecciones).State <> sckConnected
            DoEvents    ' Espera mientras no esté conectado
        Loop

        Mensaje = "NEWUSER   " & NombreUsuario & "          "
        Call Winsock1(NConecciones).SendData(Mensaje)
        DoEvents

        ' Envía al nuevo usuario la lista de los usuarios ya conectados
        For Contador = 0 To lstUsuarios.ListCount - 1
            Mensaje = "NEWUSER   " & Trim$(lstUsuarios.List(Contador)) & "          "
            Call Winsock1(NConecciones).SendData(Mensaje)
            DoEvents
        Next Contador

        NConecciones = NConecciones + 1    ' Incrementa el número de conexiones

        txtTexto.BackColor = vbWindowBackground
        txtMensaje.BackColor = vbWindowBackground
        txtMensaje.Locked = False
        lstUsuarios.BackColor = vbWindowBackground
    End If
End Sub

Recepción de datos (Winsock1_DataArrival)

Este evento se ejecuta cada vez que llegan datos a través de un socket. Según el tipo de mensaje recibido (NEWUSER o MESSAGE), se actualiza la lista de usuarios o el área de texto. Si la aplicación actúa como servidor, retransmite el mensaje al resto de clientes.

Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    Dim Contador As Integer
    Call Winsock1(Index).GetData(Mensaje)    ' Obtiene el mensaje recibido

    If Trim$(Mensaje) <> "" Then
        If Trim$(Mid$(Mensaje, 1, 10)) = "NEWUSER" Then
            lstUsuarios.AddItem Mid$(Mensaje, 11, 10)
        Else
            If Trim$(Mid$(Mensaje, 11, 10)) = "" Or Trim$(Mid$(Mensaje, 11, 10)) = NombreUsuario Then
                txtTexto.Text = txtTexto.Text & vbNewLine & Mid$(Mensaje, 21)
                txtTexto.SelStart = Len(txtTexto.Text)
            End If
        End If
    End If

    ' Si es servidor, retransmite el mensaje a los demás clientes
    If Anfitrion Then
        For Contador = 1 To NConecciones - 1
            If Contador <> Index Then
                Call Winsock1(Contador).SendData(Mensaje)
                DoEvents
            End If
        Next Contador
    End If
End Sub

Descargar

PDF Word HTML