Chat client/server

[Yonatan]

I'm trying to build a server/client chat program. Everything works fine when using a server and a single client, but when using a server and many clients, a few clients are ignored by the server... I have no idea why.
Please help me soon!

Client code:

Option Explicit

' The client has a connect button (cmdConnect), a disconnect button (cmdDisconnect),
' a chat textbox (txtChat), a speak textbox where you type what you want to say (txtSpeak),
' a winsock (wskChat) and an exit button (cmdExit).
' Users listbox not yet implemented on client.

Public MyName As String ' The nickname that the user selects for this client

Private Sub cmdConnect_Click()
    Call frmSelectClient.Show(vbModal)

    ' frmSelectClient is a form that lets the user select a nickname for the client.
    ' If the user clicks OK, that form is unloaded and the nickname goes to MyName.
    ' If the user clicks Cancel, that form is unloaded and "Clicked Cancel." goes to MyName.
    ' The problem definitely isn't there - there's no winsock involved...

    If MyName = "Clicked Cancel." Then Exit Sub
    cmdConnect.Enabled = False
    cmdDisconnect.Enabled = True
    wskChat.RemoteHost = "127.0.0.1" ' Currently only being tested on one computer
    wskChat.RemotePort = 151 ' Port 151 for a personal reason
    Call wskChat.Connect
End Sub

Private Sub cmdDisconnect_Click()
    cmdConnect.Enabled = True
    cmdDisconnect.Enabled = False
    Call wskChat.Close
End Sub

Private Sub cmdExit_Click()
    cmdDisconnect.Value = cmdDisconnect.Enabled ' If the disconnect button is enabled, use it!
    Call Unload(Me)
End Sub

Private Sub Form_Resize()
	' Code that resizes the controls is here.
	' Obviously, this isn't the code that causes the problem.
End Sub

Private Sub txtSpeak_KeyPress(KeyAscii As Integer)
    ' This sends "speak MyName MyText<CRLF>" to the server,
    ' and clears txtSpeak.
    If KeyAscii = vbKeyReturn Then
        Call wskChat.SendData("speak " & MyName & " " & txtSpeak.Text & vbCrLf)
        txtSpeak.Text = vbNullString
    End If
End Sub

Private Sub wskChat_Close()
    Call wskChat.Close
End Sub

Private Sub wskChat_Connect()
    ' This sends the nickname of the client to the server when a connection is available,
    ' in this form: "name MyName<CRLF>"
    Call wskChat.SendData("name " & MyName & vbCrLf)
End Sub

Private Sub wskChat_DataArrival(ByVal bytesTotal As Long)
    ' This receives various strings from the server.
    Dim sData As String, sName As String, sString As String
    Call wskChat.GetData(sData)
    If Left(sData, 5) = "speak" Then
        sName = Mid(sData, 7, InStr(7, sData, " ") - 7) ' The name of the person speaking
        sString = Right(sData, Len(sData) - InStr(7, sData, " ")) ' The things the person is saying
        txtChat.Text = txtChat.Text & sName & ": " & sString
    End If
    If Left(sData, 4) = "name" Then
        sName = Mid(sData, 6, Len(sData) - 7) ' The name of the person entering the chat
        txtChat.Text = txtChat.Text & sName & " has entered the chat." & vbNewLine
    End If
    If sData = "badname" & vbCrLf Then
        Call MsgBox("You need to choose a different name," & vbNewLine & _
            "because " & MyName & " already exists.", vbCritical, "Choose a Different Name")
        cmdDisconnect.Value = True ' Disconnects
        cmdConnect.Value = True ' Connects
    End If
End Sub

Private Sub wskChat_Error(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)
    Call MsgBox("Connection error " & Number & "." & vbNewLine & _
        "The connection will be closed.", vbCritical, "Error")
    Call wskChat.Close
End Sub

Server code:

Option Explicit

' The server has a "Wait for Connections" button (cmdConnect), a disconnect button (cmdDisconnect),
' a chat textbox (txtChat), a speak textbox (txtSpeak), a winsock ARRAY with one member - wskChat(0),
' a users listbox (lstChat) and an exit button (cmdExit).

Public MyName As String

Sub SendToAll(ByVal sStringToSend As String)
    ' This sub sends the sStringToSend string to any winsock in the array
    ' which is connected and isn't wskChat(0).
    Dim I As Integer
    For I = 1 To wskChat.UBound
        If wskChat(I).State = sckConnected Then Call wskChat(I).SendData(sStringToSend)
    Next
End Sub

Function NameExists(ByVal sName As String) As Boolean
    ' This function returns True if the sName is on the listbox.
    ' The problem isn't here, of course.
End Function

Private Sub cmdConnect_Click()
    Call frmSelectServer.Show(vbModal) ' Server version of frmSelectClient
    If MyName = "Clicked Cancel." Then Exit Sub
    Call lstChat.Clear
    Call lstChat.AddItem(MyName)
    cmdConnect.Enabled = False
    cmdDisconnect.Enabled = True
    wskChat(0).LocalPort = 151
    Call wskChat(0).Listen
End Sub

Private Sub cmdDisconnect_Click()
    ' This button disconnects ALL winsocks in the array.
    Dim I As Integer
    cmdConnect.Enabled = True
    cmdDisconnect.Enabled = False
    For I = 0 To wskChat.UBound
        Call wskChat(I).Close
    Next
End Sub

Private Sub cmdExit_Click()
    cmdDisconnect.Value = cmdDisconnect.Enabled ' If the disconnect button is enabled, use it!
    Call Unload(Me)
End Sub

Private Sub Form_Resize()
    ' Ditto.
End Sub

Private Sub txtSpeak_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        ' The server said something:
        ' 1) Add it to the chat textbox.
        txtChat.Text = txtChat.Text & MyName & ": " & txtSpeak.Text & vbCrLf
        ' 2) Tell all the clients to add it to the chat textbox.
        Call SendToAll("speak " & MyName & " " & txtSpeak.Text & vbCrLf)
        ' 3) Remove it from the speak textbox.
        txtSpeak.Text = vbNullString
    End If
End Sub

Private Sub wskChat_Close(Index As Integer)
    Call wskChat(Index).Close
End Sub

Private Sub wskChat_ConnectionRequest(Index As Integer, ByVal requestID As Long)
    Dim I As Integer
    ' A new client is requesting its very own winsock in the server.
    For I = 1 To wskChat.UBound
        ' Look for a winsock that has been used previously, but is now free:
        If wskChat(I).State = sckClosed Then Exit For
    Next
    ' If such a winsock couldn't be found, create a new one:
    If I > wskChat.UBound Then Call Load(wskChat(I))
    ' Whether new or old, use it to accept the request.
    wskChat(I).LocalPort = 0
    Call wskChat(I).Accept(requestID)
End Sub

Private Sub wskChat_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    Dim sData As String, sName As String, sString
    Call wskChat(Index).GetData(sData)
    ' Data (sData) has arrived from a client - wskChat(Index).
    If Left(sData, 5) = "speak" Then
        sName = Mid(sData, 7, InStr(7, sData, " ") - 7) ' Name of person speaking
        sString = Right(sData, Len(sData) - InStr(7, sData, " ")) ' Things the person is saying
        txtChat.Text = txtChat.Text & sName & ": " & sString
    End If
    If Left(sData, 4) = "name" Then
        sName = Mid(sData, 6, Len(sData) - 7)
        If NameExists(sName) Then ' Is the name already being used?
            Call wskChat(Index).SendData("badname" & vbCrLf) ' Yep. Tell the client to choose a better one.
            Exit Sub ' To avoid telling all the clients that this client is in!
        Else ' Nope. Welcome the client to the chat room, and tell all the clients that this client is in.
            txtChat.Text = txtChat.Text & sName & " has entered the chat." & vbCrLf
            wskChat(Index).Tag = sName ' Put the name in the tag...
            Call lstChat.AddItem(sName) ' Add the name to the listbox.
        End If
    End If
    Call SendToAll(sData) ' Tell all the clients that a new user is in,
                          ' or tell all the clients that a client is speaking.
End Sub

Private Sub wskChat_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)
    Call MsgBox("Error " & Number & " on connection " & Index & "." & vbCrLf & "This connection will be closed.", vbCritical, "Error")
    Call wskChat(Index).Close
End Sub

Please?

P.S. I would use the Split function in several places, but I have VB5.
Also, I've looked at the sample programs at the site whose URL is in the 14151st post http://forums.vb-world.net/showthrea...threadid=14151 - but it did not help me.

[Paul282]

I use this which I got from a tips pages ages ago and works great!

To try this code, start a new project and place a listbox (LIST1) and a
Winsock control (Winsock1) on Form1. Set the Index property of Winsock1
to 0 in order to create a control array. Then paste the following code:

Option Explicit
' Need a place to buffer incoming data
Private Const MAX_CONNECTIONS = 10
Private msBuffer(1 To MAX_CONNECTIONS) As String

Private Sub Form_Load()
' Set up Winsock control to wait for connections
Winsock1(0).LocalPort = 23 ' this is the default TELNET port
Winsock1(0).Protocol = sckTCPProtocol
Winsock1(0).Listen
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim x As Long
' close all connections and unload controls
Winsock1(0).Close
For x = 1 To Winsock1.UBound
  Winsock1(x).Close
  Unload Winsock1(x)
Next x
' always release the form object variable
Set Form1 = Nothing
End Sub

Private Sub Winsock1_Close(Index As Integer)
' One of the clients went away
If Len(msBuffer(Index)) > 0 Then
  ' we have a partial buffer left over....
  DataReceived Index, msBuffer(Index)
  msBuffer(Index) = ""
End If
Winsock1(Index).Close
End Sub

Private Sub Winsock1_ConnectionRequest(Index As Integer, _
  ByVal requestID As Long)
Dim x As Long
' new connection request from a client
' first check all existing elements of the control array
For x = 1 To Winsock1.UBound
  If Winsock1(x).State = sckClosed Then
    ' we have a slot that is currently available
    msBuffer(x) = "" ' initialize buffer
    Winsock1(x).Accept requestID
    ' send "hello" info to the client (if desired)
    SendInfo x, "Connected as ID " & CStr(x)
    Exit Sub
  End If
Next x
' all current elements are in use -- need new one
If Winsock1.UBound < MAX_CONNECTIONS Then
  ' we have room to add one so load new instance
  x = Winsock1.UBound + 1
  Load Winsock1(x)
  ' and do the same initialize & welcome...
  msBuffer(x) = ""
  Winsock1(x).Accept requestID
  SendInfo x, "Connected as ID " & CStr(x)
End If
' if no instances were available no Accept was done
' and the request will be rejected automatically
End Sub

Private Sub Winsock1_DataArrival(Index As Integer, _
  ByVal bytesTotal As Long)
Dim sTemp As String
Dim x As Long
' something came in... if we are ready for it
If Winsock1(Index).State = sckConnected Then
  Winsock1(Index).GetData sTemp ' get the data
  msBuffer(Index) = msBuffer(Index) & sTemp ' add to buffer
  ' check for any/all CRLF in the data stream
  ' need to loop because there could be several
  Do
    x = InStr(msBuffer(Index), vbCrLf)
    If x < 1 Then Exit Do ' no more found
    ' got a line - strip it from the buffer and process
    sTemp = Left$(msBuffer(Index), x - 1)
    msBuffer(Index) = Mid$(msBuffer(Index), x + 2)
    DataReceived Index, sTemp
  Loop
End If
End Sub

Private Sub Winsock1_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)
' error occurred on one of the connections
If Len(msBuffer(Index)) > 0 Then
  ' we have a partial buffer left over....
  DataReceived Index, msBuffer(Index)
  msBuffer(Index) = ""
End If
' reset this connection
Winsock1(Index).Close
End Sub

Private Sub DataReceived(ByVal Index As Integer, _
  ByVal DataBuffer As String)
Dim x As Long
' report last 100 items to listbox on form
If List1.ListCount > 99 Then List1.RemoveItem 0
List1.AddItem CStr(Index) & ": " & DataBuffer
List1.ListIndex = List1.NewIndex
' now copy the data to all other connections...
' (just for something to do)
For x = 1 To Winsock1.UBound
  If x <> Index Then
    SendInfo x, CStr(Index) & ": " & DataBuffer
  End If
Next x
DoEvents
End Sub

Private Sub SendInfo(ByVal Index As Integer, _
  ByVal DataBuffer As String)
' need to send info to client
' first be sure the port is fully open or closed
Do Until Winsock1(Index).State = sckConnected _
  Or Winsock1(Index).State = sckClosed
  DoEvents ' nasty, but needed with Winsock controls
Loop
' then send if it is open...
If Winsock1(Index).State = sckConnected Then
  Winsock1(Index).SendData DataBuffer & vbCrLf
  DoEvents
End If
End Sub

[Yonatan]

Thank you very much! I feel better already.