frmmain.vb

VB.NET - Advanced .NET Framework (Networking) - Use Sockets

        Me.Label1.Location = CType(resources.GetObject("Label1.Location"), System.Drawing.Point)
        Me.Label1.Name = "Label1"
        Me.Label1.RightToLeft = CType(resources.GetObject("Label1.RightToLeft"), System.Windows.Forms.RightToLeft)
        Me.Label1.Size = CType(resources.GetObject("Label1.Size"), System.Drawing.Size)
        Me.Label1.TabIndex = CType(resources.GetObject("Label1.TabIndex"), Integer)
        Me.Label1.Text = resources.GetString("Label1.Text")
        Me.Label1.TextAlign = CType(resources.GetObject("Label1.TextAlign"), System.Drawing.ContentAlignment)
        Me.Label1.Visible = CType(resources.GetObject("Label1.Visible"), Boolean)
        '
        'frmMain
        '
        Me.AccessibleDescription = resources.GetString("$this.AccessibleDescription")
        Me.AccessibleName = resources.GetString("$this.AccessibleName")
        Me.Anchor = CType(resources.GetObject("$this.Anchor"), System.Windows.Forms.AnchorStyles)
        Me.AutoScaleBaseSize = CType(resources.GetObject("$this.AutoScaleBaseSize"), System.Drawing.Size)
        Me.AutoScroll = CType(resources.GetObject("$this.AutoScroll"), Boolean)
        Me.AutoScrollMargin = CType(resources.GetObject("$this.AutoScrollMargin"), System.Drawing.Size)
        Me.AutoScrollMinSize = CType(resources.GetObject("$this.AutoScrollMinSize"), System.Drawing.Size)
        Me.BackgroundImage = CType(resources.GetObject("$this.BackgroundImage"), System.Drawing.Image)
        Me.ClientSize = CType(resources.GetObject("$this.ClientSize"), System.Drawing.Size)
        Me.Controls.AddRange(New System.Windows.Forms.Control() {Me.Label1, Me.lblInstructions, Me.btnBroadcast, Me.txtBroadcast, Me.lstStatus})
        Me.Dock = CType(resources.GetObject("$this.Dock"), System.Windows.Forms.DockStyle)
        Me.Enabled = CType(resources.GetObject("$this.Enabled"), Boolean)
        Me.Font = CType(resources.GetObject("$this.Font"), System.Drawing.Font)
        Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
        Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
        Me.ImeMode = CType(resources.GetObject("$this.ImeMode"), System.Windows.Forms.ImeMode)
        Me.Location = CType(resources.GetObject("$this.Location"), System.Drawing.Point)
        Me.MaximizeBox = False
        Me.MaximumSize = CType(resources.GetObject("$this.MaximumSize"), System.Drawing.Size)
        Me.Menu = Me.mnuMain
        Me.MinimumSize = CType(resources.GetObject("$this.MinimumSize"), System.Drawing.Size)
        Me.Name = "frmMain"
        Me.RightToLeft = CType(resources.GetObject("$this.RightToLeft"), System.Windows.Forms.RightToLeft)
        Me.StartPosition = CType(resources.GetObject("$this.StartPosition"), System.Windows.Forms.FormStartPosition)
        Me.Text = resources.GetString("$this.Text")
        Me.Visible = CType(resources.GetObject("$this.Visible"), Boolean)
        Me.ResumeLayout(False)

    End Sub

#End Region

#Region " Standard Menu Code "
    ' <System.Diagnostics.DebuggerStepThrough()> has been added to some procedures since they are
    ' not the focus of the demo. Remove them if you wish to debug the procedures.
    ' This code simply shows the About form.
    <System.Diagnostics.DebuggerStepThrough()> Private Sub mnuAbout_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuAbout.Click
        ' Open the About form in Dialog Mode
        Dim frm As New frmAbout()
        frm.ShowDialog(Me)
        frm.Dispose()
    End Sub

    ' This code will close the form.
    <System.Diagnostics.DebuggerStepThrough()> Private Sub mnuExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuExit.Click
        ' Close the current form
        Me.Close()
    End Sub
#End Region

    Const PORT_NUM As Integer = 10000

    Private clients As New Hashtable()
    Private listener As TcpListener
    Private listenerThread As Threading.Thread

    ' This subroutine sends a message to all attached clients
    Private Sub Broadcast(ByVal strMessage As String)
        Dim client As UserConnection
        Dim entry As DictionaryEntry

        ' All entries in the clients Hashtable are UserConnection so it is possible
        ' to assign it safely.
        For Each entry In clients
            client = CType(entry.Value, UserConnection)
            client.SendData(strMessage)
        Next
    End Sub

    ' This subroutine sends the contents of the Broadcast textbox to all clients, if
    ' it is not empty, and clears the textbox
    Private Sub btnBroadcast_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnBroadcast.Click
        If txtBroadcast.Text <> "" Then
            UpdateStatus("Broadcasting: " & txtBroadcast.Text)
            Broadcast("BROAD|" & txtBroadcast.Text)

            txtBroadcast.Text = ""
        End If
    End Sub

    ' This subroutine checks to see if username already exists in the clients 
    ' Hashtable.  If it does, send a REFUSE message, otherwise confirm with a JOIN.
    Private Sub ConnectUser(ByVal userName As String, ByVal sender As UserConnection)
        If clients.Contains(userName) Then
            ReplyToSender("REFUSE", sender)
        Else
            sender.Name = userName
            UpdateStatus(userName & " has joined the chat.")
            clients.Add(userName, sender)

            ' Send a JOIN to sender, and notify all other clients that sender joined
            ReplyToSender("JOIN", sender)
            SendToClients("CHAT|" & sender.Name & " has joined the chat.", sender)
        End If
    End Sub

    ' This subroutine notifies other clients that sender left the chat, and removes
    ' the name from the clients Hashtable
    Private Sub DisconnectUser(ByVal sender As UserConnection)
        UpdateStatus(sender.Name & " has left the chat.")
        SendToClients("CHAT|" & sender.Name & " has left the chat.", sender)
        clients.Remove(sender.Name)
    End Sub

    ' This subroutine is used as a background listener thread to allow reading incoming
    ' messages without lagging the user interface.
    Private Sub DoListen()
        Try
            ' Listen for new connections.
            Dim localAddr As System.Net.IPAddress = System.Net.IPAddress.Parse("127.0.0.1")
            listener = New TcpListener(localAddr, PORT_NUM)
            listener.Start()
            Do
                ' Create a new user connection using TcpClient returned by
                ' TcpListener.AcceptTcpClient()
                Dim client As New UserConnection(listener.AcceptTcpClient)

                ' Create an event handler to allow the UserConnection to communicate
                ' with the window.
                AddHandler client.LineReceived, AddressOf OnLineReceived
                UpdateStatus("New connection found: waiting for log-in")
            Loop Until False
        Catch
        End Try
    End Sub

    ' When the window closes, stop the listener.
    Private Sub frmMain_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
        listener.Stop()
    End Sub

    ' Start the background listener thread.
    Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        listenerThread = New Threading.Thread(AddressOf DoListen)
        listenerThread.Start()
        UpdateStatus("Listener started")
    End Sub

    ' Concatenate all the client names and send them to the user who requested user list
    Private Sub ListUsers(ByVal sender As UserConnection)
        Dim client As UserConnection
        Dim entry As DictionaryEntry
        Dim strUserList As String

        UpdateStatus("Sending " & sender.Name & " a list of users online.")

        strUserList = "LISTUSERS"

        ' All entries in the clients Hashtable are UserConnection so it is possible
        ' to assign it safely.
        For Each entry In clients
            client = CType(entry.Value, UserConnection)
            strUserList = strUserList & "|" & client.Name
        Next

        ' Send the list to the sender.
        ReplyToSender(strUserList, sender)
    End Sub

    ' This is the event handler for the UserConnection when it receives a full line.
    ' Parse the cammand and parameters and take appropriate action.
    Private Sub OnLineReceived(ByVal sender As UserConnection, ByVal data As String)
        Dim dataArray() As String

        ' Message parts are divided by "|"  Break the string into an array accordingly.
        dataArray = data.Split(Chr(124))

        ' dataArray(0) is the command.
        Select Case dataArray(0)
            Case "CONNECT"
                 ConnectUser(dataArray(1), sender)
            Case "CHAT"
                SendChat(dataArray(1), sender)
            Case "DISCONNECT"
                DisconnectUser(sender)
            Case "REQUESTUSERS"
                ListUsers(sender)
            Case Else
                UpdateStatus("Unknown message:" & data)
        End Select
    End Sub

    ' This subroutine sends a response to the sender.
    Private Sub ReplyToSender(ByVal strMessage As String, ByVal sender As UserConnection)
        sender.SendData(strMessage)
    End Sub

    ' Send a chat message to all clients except sender.
    Private Sub SendChat(ByVal message As String, ByVal sender As UserConnection)
        UpdateStatus(sender.Name & ": " & message)
        SendToClients("CHAT|" & sender.Name & ": " & message, sender)
    End Sub

    ' This subroutine sends a message to all attached clients except the sender.
    Private Sub SendToClients(ByVal strMessage As String, ByVal sender As UserConnection)
        Dim client As UserConnection
        Dim entry As DictionaryEntry

        ' All entries in the clients Hashtable are UserConnection so it is possible
        ' to assign it safely.
        For Each entry In clients
            client = CType(entry.Value, UserConnection)

            ' Exclude the sender.
            If client.Name <> sender.Name Then
                client.SendData(strMessage)
            End If
        Next
    End Sub

    ' This subroutine adds line to the Status listbox
    Private Sub UpdateStatus(ByVal statusMessage As String)
        lstStatus.Items.Add(statusMessage)
    End Sub
End Class