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个缺陷。代码注释有说明,有大神路过请指正。