[VBnet Internet] Pure VB: A Basic Winsock TCP/IP Chat Program

	Visual Basic Internet Services Pure VB: A Basic Winsock TCP/IP Chat Program

Posted:	Saturday February 12, 2000
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6
Developed with:	VB6, Windows NT4
OS restrictions:	None
Author:	VBnet - Randy Birch

Related:	NetUserGetInfo: Network User Full Name and Comments

Prerequisites

Network or DUN connection. IE4 or greater.

I recently needed TCP/IP functionality for an office application I am developing (an interface between our lab information system and vendor-provided testing equipment), and in creating the demo I found it first helpful to design a chat program in order to get the basics of using the VB6 Winsock control down. This demo is the result of those tests, and it works! To become a full-featured application will require additional features, but this is more than a skeleton so should provide a good starting base.

In constructing the app form my use I had two specific requirements. First, for configuration and identification, the app needed to pass some initial info between the connections when first established, data that was not part of its ongoing conversation. In this demo I turned that requirement into a mechanism for sending the name of the user between the client and the server.

The second criteria was more elaborate ... I needed a mechanism to automatically reconnect to each other regardless of which session (client or server) was experiencing the network problem, and to do so without user intervention. I accomplished this as well, although that code is not included in this demo.

There are no APIs in this demo. I felt that it would first be prudent to get the workings down pat using the Winsock control, then to learn from the code in order to adapt it to the Winsock API (if even necessary).

While much of the code in both the server and client portions of the chat are similar, there are sufficient differences to warrant the copious commenting that follows in the code. Each portion of the app contains three textboxes (txtSend, txtReceive and txtErr) that handle the user's input, the Winsock received data, and Winsock errors respectively. Some of the error code previously displayed in txtErr was moved to a more logical MsgBox for this demo, so its use here is much more limited than in my original design.

A Winsock connection is made by one application performing the server task of listening for connections, and another acting as a client that initiates that request. Therefore for simplicity the two forms are named frmServer and frmClient. (In the Form Code section is the illustration showing the layout and names of the controls required.) Interestingly (and conveniently for debugging), because the forms carry on their conversation is via system ports, this project can (and was) built by adding both forms into a single project. Moving to separate projects for the final compile as client and server will involve only removing one form, creating a new project and loading it, and removing the frmClient.Show line from the frmServer load event.

In use, the server is moved into its Listening mode awaiting a request to connect. When a client contacts the server via the port required, a numeric ID is exchanged that identifies the session, and the conversations between the two apps can take place. Should the client attempt to connect to a port on which there is no server listening, an error message is generated. Similarly, should either attempt to transmit data to a port where there is no app to receive the data, an error is generated. Once the server and client perform the initial connection and exchange the session ID, I have coded the routine to transmit the username (currently stored in a variable) across to the other app. When this has been received, the captions of the app are adjusted, a "got that name" flag is set, and further conversations are relayed to the txtReceive boxes.

BAS Module Code

None.

Form Layout: frmServer and frmClient

Since both forms use the same controls and control names (except for the Winsock control names), I suggest that you create the from as shown and name it frmServer. This will be the application startup form. Name the Winsock control added to this form "tcpServer", and save the file as "frmServer.frm". Add a second form, copy all controls onto it, change the name of the Winsock control on the new form to "tcpClient", and save as frmClient. You should now have a project with the two forms as below, and no errors or conflicts when loading and running the empty project using Run/Start with Full Compile.

Form Code: frmServer

Paste the following code into the General Declarations section of frmServer:

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim myname As String
Private isConnectedFlag As Boolean
Private sClientChatName As String  'holds the name of connected user
Const msgTitle As String = "VBnet Winsock Chat Server Demo"

Private Sub cmdConnect_Click()

  'This method first assures that the server
  'Winsock control is closed, then assigns a
  'port to control's LocalPort for use as the
  'server (the port specified must be numeric -
  'it can not be a friendly name from the system's
  'services file. Once assigned, invoke the
  'Winsock Listen method.

   tcpServer.Close
   tcpServer.LocalPort = 1544
   tcpServer.Listen
   
  'If the connection was successful, the control's
  'state wil be 'sckListening'
   If tcpServer.State = sckListening Then
   
      Me.Caption = "TCP Server : Listening"
      cmdDisconnect.Caption = "Stop Listening"
      cmdDisconnect.Enabled = tcpServer.State = sckListening
      cmdConnect.Enabled = tcpServer.State = sckClosed
      
   End If
   
  'if there was an error in the connection,
  'display it in the txtErr box
   txtErr.Text = Err.Description
   
End Sub


Private Sub cmdDisconnect_Click()

   If tcpServer.State = sckListening Or _
      tcpServer.State = sckConnected Then
   
      tcpServer.Close
      isConnectedFlag = tcpServer.State = sckConnected
      Me.Caption = "TCP Server Closed"
      
      cmdDisconnect.Enabled = isConnectedFlag = True
      cmdConnect.Enabled = isConnectedFlag = False
            
   End If
   
End Sub


Private Sub cmdSend_Click()

   Call TransmitMessage
   
End Sub


Private Sub Form_Load()
   
   txtErr.Text = ""
   txtSend.Text = ""
   txtReceive.Text = ""
   myname = "server"
   Label2.Caption = myname
   frmClient.Show 'Show the client form.

End Sub


Private Sub Form_Unload(Cancel As Integer)

   tcpServer.Close
   Unload frmClient
   Set frmClient = Nothing
   Set frmServer = Nothing
   
End Sub


Private Sub tcpServer_Close()

  'we need this flag check as showing a
  'msgbox in this event will cause the
  'event to fire again on closing the
  'msgbox, causing an endless loop.
  
   If isConnectedFlag = True Then
      If tcpServer.State = sckClosing Then
      
        'assure we avoid the loop
         isConnectedFlag = False
         
        'update the caption
         Me.Caption = "TCP Server Closing"
         
        'and inform the user
         MsgBox "The connection to ' " & sClientChatName & _
                " ' has been unexpectedly terminated.", _
                vbExclamation Or vbOKOnly, msgTitle
                
        'close to allow reconnection
         tcpServer.Close
         
         cmdDisconnect.Enabled = isConnectedFlag
         cmdConnect.Enabled = Not isConnectedFlag
         
      End If
   End If
   
   Me.Caption = "TCP Server Closed"
   
End Sub


Private Sub tcpServer_ConnectionRequest(ByVal requestID As Long)

 'Check if the control's State is closed. If not,
 'close the connection before accepting the new
 'connection.
   If tcpServer.State <> sckClosed Then
      tcpServer.Close
   End If

  'Accept the request with the requestID parameter.
   tcpServer.Accept requestID

End Sub


Private Sub tcpServer_DataArrival(ByVal bytesTotal As Long)

   Dim strData As String   'holds incoming data
   Dim buff As String
   
  'avoid cycles by placing the most-likely
  'condition first in the If..Then statement
   If isConnectedFlag = True Then
   
     'connection is established, and isConnectedFlag
     'is set, so any incoming data is part of the chat
      tcpServer.GetData strData
      
     'if there is text in txtReceived, (not the
     'first line received) then we need a crlf
     'between lines. This also provides a place to
     'preface the string with the sender's name.
      If Len(txtReceive.Text) Then
         buff = buff & vbCrLf & sClientChatName & " :" & vbTab & strData
      Else
         buff = buff & sClientChatName & " :" & vbTab & strData
      End If
   
     'this assigns the new string to the end of
     'txtReceived, and scrolls it into view.
      With txtReceive
         .SelStart = Len(txtReceive.Text)
         .SelText = buff
         .SelStart = Len(txtReceive.Text)
      End With
   
     'clear the user-input textbox (if desired)
     'txtSend.Text = ""
      
   Else
   
     'set the isConnectedFlat to avoid entering
     'this condition again during this session
      isConnectedFlag = True
        
     'isConnectedFlag was false, so the first data
     'received from the connected client will be
     'the name of the user. Save this for use when
     'posting subsequent data to txtReceived.
      tcpServer.GetData strData
      sClientChatName = strData
      Me.Caption = "TCP Server : Chatting with " & sClientChatName
      
     'be friendly and transmit your name to the client
      tcpServer.SendData myname
      
     'change the caption to the disconnect button
      cmdDisconnect.Caption = "Disconnect"
      
      txtSend.SetFocus
      
   End If
   
End Sub


Private Sub tcpServer_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)

   MsgBox "tcpServer Error: " & Number & vbCrLf & Description, _
           vbExclamation Or vbOKOnly, msgTitle

   CancelDisplay = True
   tcpServer.Close
         
End Sub


Private Sub txtSend_KeyPress(KeyAscii As Integer)

   If KeyAscii = vbKeyReturn Then
      Call TransmitMessage
   End If
   
End Sub


Private Sub TransmitMessage()

   Dim buff As String

  'in this method, we don't want to
  'first test for a valid connection
  '(ie If tcpClient.State = sckConnected)
  'in order to generate the appropriate
  'error message to the user.
   On Local Error GoTo TransmitMessage_error
   
   tcpServer.SendData txtSend.Text

  'if there is text in txtReceived, (not the
  'first line received) then we need a crlf
  'between lines. This also provides a place to
  'preface the string with the your name.
   If Len(txtReceive.Text) Then
      buff = buff & vbCrLf & myname & " :" & vbTab & txtSend.Text
   Else
      buff = buff & myname & " :" & vbTab & txtSend.Text
   End If
   
  'assign the new string to the end of
  'txtReceived, and scroll it into view.
   With txtReceive
      .SelStart = Len(txtReceive.Text)
      .SelText = buff
      .SelStart = Len(txtReceive.Text)
   End With
   
  'clear the input textbox
   txtSend.Text = ""

TransmitMessage_exit:

   Exit Sub

TransmitMessage_error:

   Select Case Err
      Case sckBadState:

         MsgBox Err.Description & "." & vbCrLf & _
                "The server is not connected to a client.", _
                vbExclamation Or vbOKOnly, msgTitle
         
      Case Else
      
         MsgBox Err.Description & ".", _
                vbExclamation Or vbOKOnly, msgTitle
      
   End Select

   Resume TransmitMessage_exit
   
End Sub

Form Code: frmClient

Paste the following code into the General Declarations section of frmClient:

Option Explicit

Dim myname As String
Private isConnectedFlag As Boolean
Private sClientChatName As String  'holds the name of the connected user
Const msgTitle As String = "VBnet Winsock Chat Client Demo"

Private Sub cmdDisconnect_Click()

   If tcpClient.State = sckConnected Then
   
      tcpClient.Close
      isConnectedFlag = tcpClient.State = sckConnected
      Me.Caption = "TCP Client Closed"
           
      cmdDisconnect.Enabled = isConnectedFlag
      cmdConnect.Enabled = Not isConnectedFlag
         
   End If
   
End Sub


Private Sub cmdSend_Click()
   
   Call TransmitMessage
   
End Sub


Private Sub Form_Load()

   txtErr.Text = ""
   txtSend.Text = ""
   txtReceive.Text = ""
   myname = "rgb"
   Label2.Caption = myname

End Sub


Private Sub cmdConnect_Click()

  'The name of the Winsock control is tcpClient.
  'To specify a remote host, you can use
  'either the IP address (ex: "14.15.15.16") or
  'the computer's "friendly" name (LocalHostName)
  'as shown here.
   tcpClient.RemoteHost = tcpClient.LocalHostName
   tcpClient.RemotePort = 1544
   
  'call the Connect method to open a connection.
  'If the call fails, the tcpClient_Error event will fire
   tcpClient.Connect
   
   cmdConnect.Enabled = tcpClient.State = sckClosed
   

connect_exit:
   Exit Sub
   
End Sub


Private Sub Form_Unload(Cancel As Integer)

   tcpClient.Close

End Sub


Private Sub tcpClient_Close()

  'we need this flag check as showing a
  'msgbox in this event will cause the
  'event to fire again on closing the
  'msgbox, causing an endless loop.
  
   If isConnectedFlag = True Then
      If tcpClient.State = sckClosing Then
      
        'assure we avoid the loop
         isConnectedFlag = False
         
        'update the caption
         Me.Caption = "TCP Client Closing"
         
        'and inform the user
         MsgBox "The connection to ' " & sClientChatName & _
                " ' has been unexpectedly terminated.", _
                vbExclamation Or vbOKOnly, msgTitle
                
        'close to allow reconnection
         tcpClient.Close
         
         cmdDisconnect.Enabled = isConnectedFlag
         cmdConnect.Enabled = Not isConnectedFlag
         
      End If
   End If
   
   Me.Caption = "TCP Client Closed"
   
End Sub


Private Sub tcpClient_Connect()

   If isConnectedFlag = False Then

      'this is the first time connecting to the
      'server, so be friendly and transmit your
      'name to the client
      If tcpClient.State = sckConnected Then
         tcpClient.SendData myname
      End If
      
      txtSend.SetFocus

   End If
   
   cmdSend.Enabled = tcpClient.State = sckConnected
   cmdDisconnect.Enabled = tcpClient.State = sckConnected
   
End Sub


Private Sub tcpClient_DataArrival(ByVal bytesTotal As Long)
  
   Dim strData As String  'holds incoming data
   Dim buff As String
   
  'avoid cycles by placing the most-likely
  'condition first in the If..Then statement
   If isConnectedFlag = True Then
   
     'connection is established, and isConnectedFlag
     'is set, so any incoming data is part of the chat
      tcpClient.GetData strData
      
     'if there is text in txtReceived, (not the
     'first line received) then we need a crlf
     'between lines. This also provides a place to
     'preface the string with the sender's name.
      If Len(txtReceive.Text) Then
         buff = buff & vbCrLf & sClientChatName & " :" & vbTab & strData
      Else
         buff = buff & sClientChatName & " :" & vbTab & strData
      End If
   
     'this assigns the new string to the end of
     'txtReceived, and scrolls it into view.
      With txtReceive
         .SelStart = Len(txtReceive.Text)
         .SelText = buff
         .SelStart = Len(txtReceive.Text)
      End With
   
     'clear the user-input textbox (if desired)
     'txtSend.Text = ""
      
   Else
   
     'set the isConnectedFlat to avoid entering
     'this condition again during this session
      isConnectedFlag = True
      
     'isConnectedFlag is false, so the first data
     'received from the connected client will be
     'the name of the user. Save this for use when
     'posting subsequent data to the txtReceived box.
      tcpClient.GetData strData
      sClientChatName = strData
      
      Me.Caption = "TCP Client : Chatting with " & sClientChatName
      
   End If

End Sub


Private Sub tcpClient_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)

   Select Case Number
      Case 10061
      
         MsgBox "Error: " & Number & vbCrLf & Description & _
                vbCrLf & vbCrLf & _
                "The VBnet Winsock Chat Demo server is not running, " & _
                "or has not properly established a connection.", _
                vbExclamation Or vbOKOnly Or vbMsgBoxSetForeground, _
                msgTitle

      Case 2: MsgBox "2"
      Case 3: MsgBox "3"
      
      Case Else
         MsgBox "Error: " & Number & vbCrLf & Description, _
         vbOKOnly Or vbExclamation Or vbMsgBoxSetForeground, _
         msgTitle
         
   End Select
   
   CancelDisplay = True
   tcpClient.Close

  're-enable to connect button
   cmdConnect.Enabled = tcpClient.State = sckClosed
                   
End Sub


Private Sub txtSend_KeyPress(KeyAscii As Integer)

   If KeyAscii = vbKeyReturn Then
      Call TransmitMessage
   End If
   
End Sub


Private Sub TransmitMessage()
   
   Dim buff As String
   
  'in this method, we don't want to
  'first test for a valid connection
  '(ie If tcpClient.State = sckConnected)
  'in order to generate the appropriate
  'error message to the user.
   On Local Error GoTo TransmitMessage_error
   
   tcpClient.SendData txtSend.Text

  'if there is text in txtReceived, (not the
  'first line received) then we need a crlf
  'between lines. This also provides a place to
  'preface the string with the client name.
   If Len(txtReceive.Text) Then
      buff = buff & vbCrLf & myname & " :" & vbTab & txtSend.Text
   Else
      buff = buff & myname & " :" & vbTab & txtSend.Text
   End If
   
  'assign the new string to the end of
  'txtReceived, and scroll it into view.
   With txtReceive
      .SelStart = Len(txtReceive.Text)
      .SelText = buff
      .SelStart = Len(txtReceive.Text)
   End With
   
  'clear the input textbox
   txtSend.Text = ""

TransmitMessage_exit:
   
   Exit Sub

TransmitMessage_error:

   Select Case Err
      Case sckBadState:

         MsgBox Err.Description & "." & vbCrLf & _
                "The client is not connected to the server.", _
                vbExclamation Or vbOKOnly, msgTitle
         
      Case Else
      
         MsgBox Err.Description & ".", _
                vbExclamation Or vbOKOnly, msgTitle
      
   End Select

   Resume TransmitMessage_exit

End Sub

Comments

The RemotePort member in the Connect button event must be the same for both the server and client. In addition, when used across different machines, the RemoteHost property must point to the correct machine name or TCP/IP address. When developing on the same machine, RemoteHost can be coded with the machine name or utilize the Winsock's LocalHost name. Winsock docs also state that 0 can be used to get the next fee port, but I didn't try this. Once running try pressing various buttons both in the correct order as well as to simulate all possible error patterns. Have fun!.

PayPal Link