Imports System.Net.Sockets
Imports System.Text
Public Class Form1
Dim thrListen As New Threading.Thread(AddressOf DoListen)
Dim MyDataStream As System.Net.Sockets.NetworkStream
Dim Client As Net.Sockets.TcpClient
Dim tstServer As Net.Sockets.TcpListener
Dim ClientStatus As Integer
' This delegate enables asynchronous calls for setting
' the text property on a TextBox control.
Delegate Sub SetTextCallback(ByVal [text] As String)
Private Sub Form1_Leave(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Leave
MyDataStream.Close()
tstServer.Stop()
thrListen.Abort()
End Sub
Private Sub BtnListen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnListen.Click
tstServer = New Net.Sockets.TcpListener(Net.IPAddress.Any, Int(Val(TxtPort.Text)))
'start the listening
tstServer.Start()
'Make sure the Thread closes if the application does
thrListen.IsBackground = True
'start the Listen Thread (DoListen Sub)
thrListen.Start()
End Sub
Private Sub DoListen()
Dim TempString As String
TempString = ""
Do
Try
If ClientStatus = 0 Then
'Accept the pending client connection and return
'a TcpClient initialized for communication.
Client = tstServer.AcceptTcpClient
ClientStatus = 1
End If
If ClientStatus = 1 Then
' Get the stream
MyDataStream = Client.GetStream
ClientStatus = 2
End If
If ClientStatus = 2 Then
' Read the stream into a byte array
Dim bytes(Client.ReceiveBufferSize) As Byte
MyDataStream.Read(bytes, 0, CInt(Client.ReceiveBufferSize))
' Return the data received from the client to the txtchat textbox.
TempString = Encoding.ASCII.GetString(bytes)
Me.SetText(TempString)
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
Loop
End Sub
' This method demonstrates a pattern for making thread-safe
' calls on a Windows Forms control.
'
' If the calling thread is different from the thread that
' created the TextBox control, this method creates a
' SetTextCallback and calls itself asynchronously using the
' Invoke method.
'
' If the calling thread is the same as the thread that created
' the TextBox control, the Text property is set directly.
Private Sub SetText(ByVal [text] As String)
' InvokeRequired required compares the thread ID of the
' calling thread to the thread ID of the creating thread.
' If these threads are different, it returns true.
If Me.TxtChat.InvokeRequired Then
Dim d As New SetTextCallback(AddressOf SetText)
Me.Invoke(d, New Object() {[text]})
Else
'Me.TxtChat.Text = Me.TxtChat.Text & [text]
CheckMessege([text])
End If
End Sub
Private Sub BtnSend_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnSend.Click
If Client.Connected = True Then
If MyDataStream.CanWrite Then
Try
' Do a simple write.
Dim sendBytes As [Byte]() = Encoding.ASCII.GetBytes(TxtMessege.Text)
MyDataStream.Write(sendBytes, 0, sendBytes.Length)
'add the text to the local text box window
TxtChat.Text = TxtChat.Text & TxtMessege.Text
'clear the user messege that was typed
TxtMessege.Text = ""
Catch
MsgBox(Err.Description)
End Try
End If
Else
TxtChat.Text = TxtChat.Text & "No Client is connected." & vbNewLine
End If
End Sub
Private Sub CheckMessege(ByVal [text] As String)
Dim TempMessege() As String
TempMessege = Split([text], "|-|")
If UBound(TempMessege) < 2 Then
'this means the information provided with the messege did not contain everything needed.
SendNotice("<-REPEAT->") 'Call to Send Notice sub
Exit Sub
Else
'the only way I could figure out how to find the end of the messege.
'this simply removes anything after the special character sequest |=|
TempMessege(2) = Mid(TempMessege(2), 1, (InStr(TempMessege(2), "|=|") - 1))
End If
Select Case TempMessege(0)
Case "Messege:"
'this displays the username: Messege as such.
TxtChat.Text = TxtChat.Text & TempMessege(2) & ": " & TempMessege(1) & vbNewLine
SendNotice("<-RCVD->") 'Call to Send Notice sub
Case "NewUser:"
'this adds the username to the list of connected users.
TxtUserList.Text = TxtUserList.Text & TempMessege(2) & vbNewLine
'this displays User: Username -Connected-
TxtChat.Text = TxtChat.Text & "User: " & TempMessege(2) & " -Connected-" & vbNewLine
SendNotice("<-RCVD->") 'Call to Send Notice sub
Case "Disconnect:"
'this next line removes the user and the chr(13) or VBNEWLINE
TxtUserList.Text = Replace(TxtUserList.Text, TempMessege(2) & vbNewLine, "")
'This Notifies anyone in chat of the user who disconnect.
TxtChat.Text = TxtChat.Text & "User: " & TempMessege(2) & " D-isconnected-" & vbNewLine
SendNotice("<-RCVD->") 'Call to Send Notice sub
'close the networkstream with this user.
MyDataStream.Close()
'close the connection with this user.
Client.Close()
'reset the variable that allows my program to work.
ClientStatus = 0
Case "Connect:"
MsgBox("Connected")
Case Else
MsgBox("***!!!" & vbNewLine & "---" & [text] & "---")
SendNotice("<-ERR->") 'Call to Send Notice sub
End Select
End Sub
'SendNotice(STRING)
'
'Value being sent is String
'
'Takes a string, converts it to a byte array
'Then sends the data on the DataStream.
Private Sub SendNotice(ByVal MyNotice As String)
Dim sendBytes As [Byte]() = Encoding.ASCII.GetBytes(MyNotice)
MyDataStream.Write(sendBytes, 0, sendBytes.Length)
End Sub
End Class