VB.net TCP服务端监听端口接收客户端RFID网络读卡器上传的读卡数据

本 示例使用设备介绍：WIFI/TCP/UDP/HTTP协议RFID液显网络读卡器可二次开发语音播报POE-淘宝网 (taobao.com)

Imports System.Threading
Imports System.Net
Imports System.Net.Sockets
Public Class Form1
    Dim ListenSocket As Socket
 
    Dim Dict As New Dictionary(Of String, Socket) '用于保存连接的客户的套接字的键值对集合
    Dim DictThre As New Dictionary(Of String, Thread) '用于保存通信线程的键值对集合
    Dim LocalIp As String
 
    Dim SendBuff() As Byte
 
    Public Sub getIp()     '获取本机所有网卡的IP
        Dim Address() As System.Net.IPAddress
        Dim i As Integer
        Address = Dns.GetHostByName(Dns.GetHostName()).AddressList
        If UBound(Address) < 0 Then
            MsgBox("未能查找到本台电脑安装的网卡，暂不能启动本软件。", MsgBoxStyle.Critical + vbOKOnly, "注意")
            End
        Else
            For i = 0 To UBound(Address)
                comboBox4.Items.Add(Address(i).ToString())
            Next
            comboBox4.SelectedIndex = 0
            LocalIp = comboBox4.Text.Trim()
        End If
    End Sub
 
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        getIp()
        comboBox4.SelectedIndex = 0
    End Sub
 
    Private Sub btn_conn_Click(sender As Object, e As EventArgs) Handles btn_conn.Click
        If btn_conn.Text = "开启TCP服务，允许新客户端接入" Then
            TextBox.CheckForIllegalCrossThreadCalls = False             '取消文本框的跨线程检查
            Dim localAddress As IPAddress = IPAddress.Parse(comboBox4.Text.Trim())
            Dim EndPoint As New IPEndPoint(localAddress, txb_port.Text) '创建一个网络节点对象
            ListenSocket = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
            ListenSocket.Bind(EndPoint)                                 '给负责监听的套接字绑定一个网络节点
            ListenSocket.Listen(100)                                    '侦听，最多接受100个连接
            Dim thre = New Thread(AddressOf Connect)                    '创建一个新的线程用于处理客户端发来的连接请求
            thre.IsBackground = True                                    '设为后台线程
            thre.Start()                                                '开启线程           
            btn_conn.Text = "停止新客户端连接"
            listBox2.Items.Add("TCP端口监听服务已开启，新客户端设备可以连接并上传数据......")
            listBox2.Items.Add("")
            listBox2.SelectedIndex = listBox2.Items.Count - 1
 
        Else            
            ListenSocket.Close()
            ListenSocket = Nothing
            btn_conn.Text = "开启TCP服务，允许新客户端接入"
            listBox2.Items.Add("TCP服务端已禁止新客户端连接，已连接的客户端设备可继续上传数据......")
            listBox2.Items.Add("")
            listBox2.SelectedIndex = listBox2.Items.Count - 1
        End If
    End Sub
 
    Sub Connect() '处理客户端的连接请求的过程
        While True
            Try
                Dim SockConect As Socket = listenSocket.Accept
                Dict.Add(SockConect.RemoteEndPoint.ToString, SockConect)    '将连接成功的套接字添加到键值对集合
                listBox1.Items.Add(SockConect.RemoteEndPoint.ToString)      '添加到列表
                Dim Thre As New Thread(AddressOf RecClient)                 '创建一个新的线程用于和链接成功的套接字通信
                Thre.IsBackground = True                                    '设为后台线程
                Thre.Start(SockConect)
                DictThre.Add(SockConect.RemoteEndPoint.ToString, Thre)      '将创建的通信线程添加到键值对集合
            Catch
 
            End Try
 
        End While
    End Sub
 
    Sub RecClient(ByVal SockTelNet As Socket) '处理客户端发来的数据
        While True
            Try
                Dim getdata(1024) As Byte
                Dim RecLen As Int32
                Dim HexStr As String
 
                Try '捕获异常
                    RecLen = SockTelNet.Receive(getdata) '接受客户端发来得信息
                Catch ss As SocketException
                    listBox2.Items.Add(ss.NativeErrorCode & vbCrLf & ss.Message) '显示错误信息
                    Dict.Remove(SockTelNet.RemoteEndPoint.ToString) '移除断开连接的套接字                    
                    Return
                Catch s As Exception
                    listBox2.Items.Add(s.Message)
                    Return
                End Try
 
                If RecLen > 0 Then
                    Dim StrMsg As String
                    StrMsg = DateTime.Now.ToLongTimeString() + "  Get From " + SockTelNet.RemoteEndPoint.ToString + " : "
                    For i = 0 To RecLen - 1
                        StrMsg = StrMsg + getdata(i).ToString("X2") + " "
                    Next
                    If listBox2.Items.Count() > 100 Then listBox2.Items.Clear()
                    listBox2.Items.Add(StrMsg)
 
                    Select Case getdata(0)
                        Case &HC1, &HCF
                            If getdata(0) = &HC1 Then
                                StrMsg = "数据解析：IC读卡器上传卡号，"
                            Else
                                StrMsg = "数据解析：IC卡离开读卡器，"
                            End If
                            StrMsg = StrMsg + "IP[" + getdata(1).ToString("D") + "." + getdata(2).ToString("D") + "." + getdata(3).ToString("D") + "." + getdata(4).ToString("D") + "]，"
                            StrMsg = StrMsg + "机号[" + (getdata(5) + getdata(6) * 256).ToString("D") + "]，"
                            StrMsg = StrMsg + "数据包号[" + (getdata(7) + getdata(8) * 256).ToString("D") + "]，"
                            StrMsg = StrMsg + "卡号长度[" + getdata(9).ToString("D") + "]，"
                            HexStr = ""
                            For i = 10 To 10 + getdata(9) - 1
                                HexStr = HexStr + getdata(i).ToString("X2")
                            Next
                            StrMsg = StrMsg + "16进制卡号[" + HexStr + "]，"
                            HexStr = ""
                            For i = 10 + getdata(9) To RecLen - 1
                                HexStr = HexStr + getdata(i).ToString("X2")
                            Next
                            StrMsg = StrMsg + "唯一硬件序号[" + HexStr + "]"
                            listBox2.Items.Add(StrMsg)
                            listBox2.Items.Add("")
                            listBox2.SelectedIndex = listBox2.Items.Count - 1
 
                            If CheckBox1.Checked Then
                                GetRespData()
                                SockTelNet.Send(SendBuff)
 
                                StrMsg = DateTime.Now.ToLongTimeString() + "  Send To  " + SockTelNet.RemoteEndPoint.ToString + " : "
                                For i = 0 To SendBuff.Length - 1
                                    StrMsg = StrMsg + SendBuff(i).ToString("X2") + " "
                                Next
                                listBox2.Items.Add(StrMsg)
                                listBox2.Items.Add("")
                                listBox2.SelectedIndex = listBox2.Items.Count - 1
                            End If
 
                        Case &HD1, &HDF
                            If getdata(0) = &HD1 Then
                                StrMsg = "数据解析：ID读卡器上传卡号，"
                            Else
                                StrMsg = "数据解析：ID卡离开读卡器，"
                            End If
                            StrMsg = StrMsg + "IP[" + getdata(1).ToString("D") + "." + getdata(2).ToString("D") + "." + getdata(3).ToString("D") + "." + getdata(4).ToString("D") + "]，"
                            StrMsg = StrMsg + "机号[" + (getdata(5) + getdata(6) * 256).ToString("D") + "]，"
                            StrMsg = StrMsg + "数据包号[" + (getdata(7) + getdata(8) * 256).ToString("D") + "]，"
                            StrMsg = StrMsg + "16进制卡号[" + getdata(9).ToString("X2") + getdata(10).ToString("X2") + getdata(11).ToString("X2") + getdata(12).ToString("X2") + getdata(13).ToString("X2") + "]，"
                            HexStr = ""
                            For i = 14 To RecLen - 1
                                HexStr = HexStr + getdata(i).ToString("X2")
                            Next
                            StrMsg = StrMsg + "唯一硬件序号[" + HexStr + "]"
                            listBox2.Items.Add(StrMsg)
                            listBox2.Items.Add("")
                            listBox2.SelectedIndex = listBox2.Items.Count - 1
 
                        Case &HF3
                            StrMsg = "数据解析：读卡器心跳数据包，"
                            StrMsg = StrMsg + "IP[" + getdata(1).ToString("D") + "." + getdata(2).ToString("D") + "." + getdata(3).ToString("D") + "." + getdata(4).ToString("D") + "]，"
                            StrMsg = StrMsg + "机号[" + (getdata(5) + getdata(6) * 256).ToString("D") + "]，"
                            StrMsg = StrMsg + "数据包号[" + (getdata(7) + getdata(8) * 256).ToString("D") + "]，"
                            StrMsg = StrMsg + "心跳类型[" + getdata(9).ToString("X2") + "]，"
                            StrMsg = StrMsg + "长度[" + getdata(10).ToString("D") + "]，"
                            StrMsg = StrMsg + "继电器状态[" + getdata(11).ToString("X2") + "]，"
                            StrMsg = StrMsg + "外部输入状态[" + getdata(12).ToString("X2") + "]，"
                            StrMsg = StrMsg + "随机动态码[" + getdata(13).ToString("X2") + getdata(14).ToString("X2") + getdata(15).ToString("X2") + getdata(17).ToString("X2") + "]，"
                            HexStr = ""
                            For i = 17 To RecLen - 1
                                HexStr = HexStr + getdata(i).ToString("X2")
                            Next
                            StrMsg = StrMsg + "唯一硬件序号[" + HexStr + "]"
                            listBox2.Items.Add(StrMsg)
                            listBox2.Items.Add("")
                            listBox2.SelectedIndex = listBox2.Items.Count - 1
                    End Select
 
                End If
            Catch
            End Try
        End While
    End Sub
    '选择在线设备向其发送指令
    Sub ButtoSend(ByVal sendcode As Integer)
        Dim seleid As String
        Dim dispstr As String
        Dim i As Integer
 
        If listBox1.SelectedIndex >= 0 Then
            seleid = listBox1.Text
            GetSenddata(sendcode)
            Dict.Item(seleid).Send(SendBuff)
 
            dispstr = DateTime.Now.ToLongTimeString() + "  Send To  " + seleid + " : "
            For i = 0 To SendBuff.Length - 1
                dispstr = dispstr + SendBuff(i).ToString("X2") + " "
            Next
            listBox2.Items.Add(dispstr)
            listBox2.Items.Add("")
            listBox2.SelectedIndex = listBox2.Items.Count - 1
        Else
            MsgBox("请先在客户端列表中选择要发送指令的在线客户端！", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "提示")
        End If
    End Sub
 
    '按回应需要生成发送缓冲数据
    Sub GetRespData()
        If RadioButton3.Checked Then
            GetSenddata(0)
        ElseIf RadioButton4.Checked Then
            GetSenddata(1)
        ElseIf RadioButton5.Checked Then
            GetSenddata(2)
        Else
            GetSenddata(3)
        End If
    End Sub
 
    '按发送需要生成发送缓冲数据
    Sub GetSenddata(ByVal sendcode As Integer)
        Dim i As Long
        Dim strs As String
        Dim textbyte() As Byte
 
        Select Case sendcode
            Case 0
                ReDim SendBuff(38)
                SendBuff(0) = &H5A      '驱动显示文字+蜂鸣响声的功能码
                SendBuff(1) = 0         '机号低位
                SendBuff(2) = 0         '机号高位，高低位为0表示任意机号
                If checkBox2.Checked Then   '蜂鸣响声
                    SendBuff(3) = comboBox3.SelectedIndex   '蜂鸣响声代码
                    If radioButton2.Checked Then        '背光灯状态不变
                        SendBuff(3) = SendBuff(3) Or 128
                    End If
                Else
                    SendBuff(3) = &HFF              '不响蜂鸣声
                    If radioButton2.Checked Then    '背光灯状态不变
                        SendBuff(3) = SendBuff(3) And 127
                    End If
                End If
                SendBuff(4) = dispdelay.Value
 
                strs = textBox12.Text + "                                   "
                textbyte = System.Text.Encoding.GetEncoding(936).GetBytes(strs)
                For i = 0 To 33
                    SendBuff(5 + i) = textbyte(i)
                Next
 
            Case 1
                strs = "[v" + SYDX.Value.ToString() + "]"    '设置语音大小，在需要发送的语音字符串中任何位置加入[v10],表示将音量调到10级(范围0~16，0表示静音，16最大，每次重开机后，音量重置为10级)！
                strs = strs + textBox1.Text.Trim()
                textbyte = System.Text.Encoding.GetEncoding(936).GetBytes(strs)
                Dim displen As Integer
                Dim voiclen As Integer
                Dim commlen As Integer
 
                displen = 34
                voiclen = textbyte.Length
                commlen = 10 + displen + voiclen + 4
 
                ReDim SendBuff(commlen)
                SendBuff(0) = &H5C      '驱动显示文字+蜂鸣响声的功能码+开继电器+播报TTS语音
                SendBuff(1) = 0         '机号低位
                SendBuff(2) = 0         '机号高位，高低位为0表示任意机号
                If checkBox2.Checked Then   '蜂鸣响声
                    SendBuff(3) = comboBox3.SelectedIndex   '蜂鸣响声代码
                    If radioButton2.Checked Then        '背光灯状态不变
                        SendBuff(3) = SendBuff(3) Or 128
                    End If
                Else
                    SendBuff(3) = &HFF              '不响蜂鸣声
                    If radioButton2.Checked Then    '背光灯状态不变
                        SendBuff(3) = SendBuff(3) And 127
                    End If
                End If
 
                Select Case comboBox2.SelectedIndex '根据选择开启对应的继电器
                    Case 1
                        SendBuff(4) = &HF1
                    Case 2
                        SendBuff(4) = &HF2
                    Case 3
                        SendBuff(4) = &HF3
                    Case 4
                        SendBuff(4) = &HF4
                    Case 5
                        SendBuff(4) = &HF5
                    Case 6
                        SendBuff(4) = &HF6
                    Case 7
                        SendBuff(4) = &HF7
                    Case 8
                        SendBuff(4) = &HF8
                    Case Else
                        SendBuff(4) = &HF0
                End Select
                i = CLng(textBox11.Text)    '继电器开启时长
                SendBuff(5) = i Mod 256
                SendBuff(6) = Int(i / 256) Mod 256
 
                SendBuff(7) = dispdelay.Value  '显示时长
                SendBuff(8) = 0                '显示起始位
                SendBuff(9) = displen          '显示长度
                SendBuff(10) = voiclen         'TTS语音长度
 
                strs = textBox12.Text + "                                   "
                Dim dispbyte() As Byte
                dispbyte = System.Text.Encoding.GetEncoding(936).GetBytes(strs)
                For i = 0 To displen - 1        '显示文字
                    SendBuff(11 + i) = dispbyte(i)
                Next
 
                For i = 0 To voiclen - 1        'TTS语音
                    SendBuff(11 + displen + i) = textbyte(i)
                Next
 
                SendBuff(11 + displen + voiclen + 0) = &H55     '防干扰后缀
                SendBuff(11 + displen + voiclen + 1) = &HAA
                SendBuff(11 + displen + voiclen + 2) = &H66
                SendBuff(11 + displen + voiclen + 3) = &H99
 
            Case 2
                ReDim SendBuff(3)
                SendBuff(0) = &H96      '驱动蜂鸣响声的功能码
                SendBuff(1) = 0         '机号低位
                SendBuff(2) = 0         '机号高位，高低位为0表示任意机号
                SendBuff(3) = comboBox3.SelectedIndex
 
            Case 3
                ReDim SendBuff(5)
                SendBuff(0) = &H78      '驱动开关继电器的功能码
                SendBuff(1) = 0         '机号低位
                SendBuff(2) = 0         '机号高位，高低位为0表示任意机号
                Select Case comboBox2.SelectedIndex '根据选择开启对应的继电器
                    Case 1
                        SendBuff(3) = &HF1
                    Case 2
                        SendBuff(3) = &HF2
                    Case 3
                        SendBuff(3) = &HF3
                    Case 4
                        SendBuff(3) = &HF4
                    Case 5
                        SendBuff(3) = &HF5
                    Case 6
                        SendBuff(3) = &HF6
                    Case 7
                        SendBuff(3) = &HF7
                    Case 8
                        SendBuff(3) = &HF8
                    Case Else
                        SendBuff(3) = &HF0
                End Select
                i = CLng(textBox11.Text)    '开启时长
                SendBuff(4) = i Mod 256
                SendBuff(5) = Int(i / 256) Mod 256
 
            Case 4
                ReDim SendBuff(5)
                SendBuff(0) = &H78      '驱动开关继电器的功能码
                SendBuff(1) = 0         '机号低位
                SendBuff(2) = 0         '机号高位，高低位为0表示任意机号
                Select Case comboBox2.SelectedIndex '根据选择关闭对应的继电器
                    Case 1
                        SendBuff(3) = &HE1
                    Case 2
                        SendBuff(3) = &HE2
                    Case 3
                        SendBuff(3) = &HE3
                    Case 4
                        SendBuff(3) = &HE4
                    Case 5
                        SendBuff(3) = &HE5
                    Case 6
                        SendBuff(3) = &HE6
                    Case 7
                        SendBuff(3) = &HE7
                    Case 8
                        SendBuff(3) = &HE8
                    Case Else
                        SendBuff(3) = &HE0
                End Select
                i = CLng(textBox11.Text)    '开启时长
                SendBuff(4) = i Mod 256
                SendBuff(5) = Int(i / 256) Mod 256
        End Select
    End Sub
    Private Sub button6_Click(sender As Object, e As EventArgs) Handles button6.Click
        ButtoSend(2)
    End Sub
 
    Private Sub button7_Click(sender As Object, e As EventArgs) Handles button7.Click
        ButtoSend(3)
    End Sub
 
    Private Sub button8_Click(sender As Object, e As EventArgs) Handles button8.Click
        ButtoSend(4)
    End Sub
 
    Private Sub button10_Click(sender As Object, e As EventArgs) Handles button10.Click
        ButtoSend(0)
    End Sub
 
    Private Sub button9_Click(sender As Object, e As EventArgs) Handles button9.Click
        ButtoSend(1)
    End Sub
 
    Private Sub button3_Click(sender As Object, e As EventArgs) Handles button3.Click
        Dim copstr As String
        Dim I As Long
        Clipboard.Clear()
        copstr = ""
        For I = 0 To listBox2.Items.Count - 1
            copstr = copstr & listBox2.Items(I)
            copstr = copstr & vbCrLf
        Next
        Clipboard.SetText(copstr)
        MsgBox("TCP通讯日志报文已拷贝！", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "提示")
    End Sub
 
    Private Sub button2_Click(sender As Object, e As EventArgs) Handles button2.Click
        listBox2.Items.Clear()
    End Sub
End Class