TCP服务端vb.net支持多客户端连接

Imports System.Threading
Imports System.IO
Imports System.Net
Imports System.Net.Sockets

Public Class Form1
    Private thThreadRead As Thread
    Private tlTcpListen As TcpListener
    Private lstClient As List(Of TcpClient)
    Private blistener As Boolean = True

    Private Sub CheckBox1_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CheckBox1.CheckedChanged
        If CheckBox1.Checked = True Then
            blistener = True
            thThreadRead = New Thread(New ThreadStart(AddressOf dowork))
            thThreadRead.IsBackground = True
            thThreadRead.Start()
        Else
            StatusBar1.Text = "正在停止监听..."
            blistener = False
            thThreadRead.Abort()
            For Each tclient In lstClient
                tclient.Client.Close()
            Next
            tlTcpListen.Stop()
            lstClient.Clear()
            StatusBar1.Text = "监听已经停止"
        End If
    End Sub

    Private Sub dowork()
        Dim iPort As Integer = 8000
        Dim localAddr As IPAddress = IPAddress.Any
        iPort = CInt(numPort.Value)
        tlTcpListen = New TcpListener(localAddr, iPort)
        tlTcpListen.Start()
        StatusBar1.Text = "正在监听..."
        lstClient = New List(Of TcpClient)
        lstClient.Clear()
        Do While True
            Dim tcClient As TcpClient = tlTcpListen.AcceptTcpClient
            lstClient.Add(tcClient)
            Dim thd As New Thread(New ParameterizedThreadStart(AddressOf Listen))
            thd.IsBackground = True
            thd.Start(tcClient)
        Loop
    End Sub

    '错误1：每连接一个主机就会创建一个线程，但是主机断开连接时线程仍然没有关闭
    Private Sub Listen(ByVal tcClient As TcpClient)
        Try
            Dim nsStream As NetworkStream = tcClient.GetStream()
            StatusBar1.Text = "已经建立TCP连接！" + tcClient.Client.RemoteEndPoint.ToString()
            While blistener
                Dim sMessage As String = ""
                If nsStream.DataAvailable Then '是否有可用数据
                    Dim buf(8 * 1024) As Byte
                    Dim slen = nsStream.Read(buf, 0, buf.Length)
                    sMessage = System.Text.Encoding.UTF8.GetString(buf)
                    sMessage = sMessage.Substring(0, slen)
                End If
                If sMessage <> "" Then
                    Dim sTime As String = DateTime.Now.ToShortTimeString()
                    sMessage = sTime + " " + tcClient.Client.RemoteEndPoint.ToString() + " [" + sMessage + "]" + vbCrLf
                    Me.Invoke(New EventHandler(Sub() TextBox1.AppendText(sMessage)))
                End If
                'Threading.Thread.Sleep(1)
            End While
        Catch ex As System.Exception
            MessageBox.Show(ex.Message, "错误")
        End Try
    End Sub

    '错误2：每连接一个主机lstClient就添加一个对象。但是连接后在断开这个对象并没有删除
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        '向每一个主机发送信息
        For Each tclient In lstClient
            Dim sw As StreamWriter = New StreamWriter(tclient.GetStream())
            sw.Write(TextBox2.Text)
            sw.Flush()
        Next

    End Sub
End Class

上面是TCP服务端代码。窗体界面很简单就不贴了。供大家分享。

目前还有2个缺陷。代码注释有说明，有大神路过请指正。