Your Ad Here

Wednesday, December 30, 2009

Winsock TCP/IP Chat Program

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-2009 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

No comments:

Post a Comment