基于Socket的简易聊天室（vb.net代码详细讲解，源代码下载）

大Mod_abfun

已于 2023-07-17 20:06:11 修改

阅读量1k

点赞数 1

分类专栏： vb.net 文章标签： .net Socket vb.net 网络简易聊天室

于 2023-07-17 11:17:10 首次发布

本文链接：https://blog.csdn.net/weixin_56050945/article/details/131761389

版权

vb.net 专栏收录该内容

34 篇文章 5 订阅

订阅专栏

本教程配套的视频：Socket网络通信教程，简易聊天室_哔哩哔哩_bilibili

在网上有很多这样的资料，不过基本都解释不清楚，而且有的需要付费和关注

本教程主要的目的是：使用vb.net详细讲解Socket网络编程的基本要素，如果需要C#源代码，可以使用这个网站进行翻译Code Converter C# to VB and VB to C# – Telerik

那么，就开始吧

一、建立新的解决方案，加入2个项目，分别重命名为Server和Client，可以依据自己的需求

二、设计窗体：

好，到这一步就要开始编写代码了

三、编写代码

在服务端一共需要2个Socket，它们分别是SockeListen和SocketSend

首先是监听部分。监听服务器的哪一个端口，获取服务器的ip地址，建立新的Socket，这一个Socket负责监听

等待客户端连接服务端，就是SocketListen

由于SocketListen会在等待客户端时占用主线程，因此使用多线程，无限次地等待客户端添加

注意，客户端和服务端需要取消跨线程检查

线程之间需要取消跨线程检查，在窗体构造函数或窗体加载事件中加入

Private Sub Server_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    CheckForIllegalCrossThreadCalls = False
End Sub

其次是SocketSend，负责收、发数据，最主要的通信Socket

引入命名空间

Imports System.Net
Imports System.Net.Sockets
Imports System.Text
Imports System.Threading

初始化

Sockets负责存储客户端Socket

Socket Listen负责等待连接客户端Socket

SocketSend负责收发数据

Dim socketListen As New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
Dim SocketSend As Socket
Dim Sockets As New Dictionary(Of String, Socket)
Dim threadListen As New Thread(AddressOf Accept)

点击监听时触发事件（服务端的IP地址要更改！）

Private Sub ButListen_Click(sender As Object, e As EventArgs) Handles ButListen.Click

    Dim ip As IPAddress = IPAddress.Parse(TextIP.Text)
    Dim ipPort As IPEndPoint = New IPEndPoint(ip, TextPort.Text)
    socketListen.Bind(ipPort)
    socketListen.Listen(50)
    ShowMsg("服务端监听成功")

    threadListen.IsBackground = True
    threadListen.Start()

End Sub
Sub Accept()
    While True
        SocketSend = socketListen.Accept

        Dim ip As String = SocketSend.RemoteEndPoint.ToString
        Sockets.Add(ip, SocketSend)
        ListClient.Items.Add(ip)

        ShowMsg(ip & "连接成功，已经添加至客户端列表")

        Dim threadReceive As New Thread(AddressOf Receive)
        threadReceive.IsBackground = True
        threadReceive.Start(SocketSend)

    End While
End Sub
Function ShowMsg(s As String)
    Try
        ListLog.AppendText(s)
        ListLog.AppendText(vbCrLf)
        ListLog.SelectionStart = ListLog.Text.Length
        ListLog.ScrollToCaret()
    Catch ex As Exception
    End Try
End Function

服务端Receive（While里面的退出提示是针对Telnet客户端退出的，而错误处理部分是针对.net Socket的）

Sub Receive(SocketSend)
    Dim S As Socket = SocketSend
    Dim ip As String = S.RemoteEndPoint.ToString
    Try
        While True
            Dim buffer(1024 * 1024 * 2) As Byte
            Dim length As Integer = S.Receive(buffer)
            If length = 0 Then
                ShowMsg("服务端检测：" & ip & ":退出了客户端...")
                Sockets.Remove(ip)
                ListClient.Items.Clear()
                For Each ips In Sockets
                    ListClient.Items.Add(ips.Key)
                Next
                Exit While
            End If

            Dim str As String = Encoding.UTF8.GetString(buffer)
            ShowMsg(S.RemoteEndPoint.ToString & " 发送消息:" & str)

            Dim str1 = "[客户端]" & ip & ":" & str
            Dim buffer1(1024 * 1024 * 2) As Byte
            buffer1 = Encoding.UTF8.GetBytes(str1)
            For Each i In Sockets
                If i.Key <> ip Then
                    i.Value.Send(buffer1)
                End If
            Next
        End While


    Catch ex As Exception
        ShowMsg("服务端检测：" & ip & ":客户端出现异常，具体异常：" & ex.Message)
    If MsgBox("是否关闭此连接？" & ex.Message, vbYesNo, "Server Message") = MsgBoxResult.Yes Then
        Sockets.Remove(ip)
        ListClient.Items.Clear()
        For Each ips In Sockets
            ListClient.Items.Add(ips.Key)
        Next
    End If

    End Try

End Sub

服务端单独发送消息和全体发送消息

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    Dim buffer(1024 * 1024 * 2) As Byte
    If TextBox3.Text.Trim.Count = 0 Then
        MsgBox("输入发送的文本")
    Else
        buffer = Encoding.UTF8.GetBytes("服务端给你发送：" & TextBox3.Text)
        Sockets(ListClient.SelectedItem).Send(buffer)
        ShowMsg("服务端给" & ListClient.SelectedItem & "发送了：" & TextBox3.Text)
    End If
End Sub

Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
    Dim buffer(1024 * 1024 * 2) As Byte
    If TextBox3.Text.Trim.Count = 0 Then
        MsgBox("输入发送的文本")
    Else
        buffer = Encoding.UTF8.GetBytes("服务端全体通知：" & TextBox3.Text)
        For Each i In Sockets
            i.Value.Send(buffer)
        Next
        ShowMsg("服务端给所有客户端发送了：" & TextBox3.Text)
    End If

End Sub

单个客户端的消息也要被其他客户端接收请看Receive方法中有“【客户端】”的一部分，服务端负责转发来自客户端的消息，除当前客户端外，这样就巧妙地实现了转发功能

这个和全体通知比较类似

客户端：客户端部分只需要负责收发数据，一切内容交给服务端处理，目前转发功能就靠服务端而不是客户端

Client也要加上

Function ShowMsg(s As String)
    Try
        ListLog.AppendText(s)
        ListLog.AppendText(vbCrLf)
        ListLog.SelectionStart = ListLog.Text.Length
        ListLog.ScrollToCaret()
    Catch ex As Exception
    End Try
End Function

Private Sub Client_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    CheckForIllegalCrossThreadCalls = False
End Sub

初始化

Dim SocketSend As New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
Dim ip As IPAddress
Dim ipPort As IPEndPoint

连接服务端：直接开启线程来接收数据

Private Sub ButConnect_Click(sender As Object, e As EventArgs) Handles ButConnect.Click
    ip = IPAddress.Parse(TextIP.Text)
    ipPort = New IPEndPoint(ip, TextPort.Text)
    SocketSend.Connect(ipPort)
    ShowMsg("成功连接到服务端")
    Dim th As New Thread(AddressOf Receive)
    th.IsBackground = True
    th.Start(SocketSend)
End Sub

Receive部分就简单了：

Sub Receive(SocketSend)
    Dim S As Socket = SocketSend
    Dim ip As String = S.RemoteEndPoint.ToString
    Try
        While True
            Dim buffer(1024 * 1024 * 2) As Byte
            Dim length As Integer = S.Receive(buffer)
            Dim str As String = Encoding.UTF8.GetString(buffer)
            ShowMsg(str)
        End While
    Catch ex As Exception
    End Try
End Sub

发送消息：

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    Dim buffer(1024 * 1024 * 2) As Byte
    If TextBox3.Text.Trim.Count = 0 Then
        MsgBox("输入发送的文本")
    Else
        buffer = Encoding.UTF8.GetBytes(TextBox3.Text)

        SocketSend.Send(buffer)
        ShowMsg("我：" & TextBox3.Text)
    End If

End Sub

这样，一个简易多人聊天室就完成了

源代码下载：链接：https://pan.baidu.com/s/1uvYPrGVuV3KeeLDtC4n7Zg?pwd=2333
提取码：2333

链接永久有效