VB.net Socket Udp收、发数据包示例源码

 示例中使用的设备：https://item.taobao.com/item.htm?spm=a1z10.1-c.w4004-21914722028.2.2b826baaneOluT&id=17021194999https://item.taobao.com/item.htm?spm=a1z10.1-c.w4004-21914722028.2.2b826baaneOluT&id=17021194999

Imports System.Net.Sockets
Imports System.Net
Imports System.Text
Imports System.Threading
Public Class Form1
    Dim PortNumber As Integer = 39192 ''侦听端口号
    Dim ListenerSock As Socket ''侦听socket
    Dim ListenerThre As Thread ''侦听线程
    Dim LocalIp As String      ''本地ip64
    Dim ready As Boolean = False ''线程运行标识
    Dim machinnos As String

    Delegate Sub Gxdjs(ByVal data As String)  '线程内更新UI传送一个显示参数
    Delegate Sub EditUi(ByVal data0 As String, ByVal data1 As String)  '线程内更新UI传送两个参数

    Private Sub Form1_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
        ListenerSock.Close()
        ready = False
        ListenerThre.Abort()
    End Sub

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        getIp()
        StartListener() ''开始侦听
    End Sub

    Private Sub StartListener()
        Dim LocalPoint As IPEndPoint
        While Not ready ''向用户询问侦听端口号。用户可以直接回车，表示选择默认的。
            Try
                LocalPoint = New IPEndPoint(IPAddress.Parse(LocalIp), PortNumber)
                ListenerSock = New Socket(AddressFamily.InterNetwork, SocketType.Dgram, ProtocolType.Udp)
                ListenerSock.Bind(LocalPoint)

                ListenerThre = New Thread(AddressOf ThrListener)
                ListenerThre.Start()
                ready = True

            Catch ex As Exception
                ListenerSock.Close()
                ready = False
                ListBox1.Items.Add("ERROR：" & vbCrLf & ex.Message & vbCrLf)
            End Try
        End While
    End Sub

    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)
                ComboBox1.Items.Add(Address(i).ToString())
            Next
            ComboBox1.SelectedIndex = 0
            LocalIp = ComboBox1.Text.Trim()
        End If
    End Sub

    Private Sub ComboBox1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ComboBox1.SelectedIndexChanged
        Try
            ListenerSock.Close()
            ready = False
            ListenerThre.Abort()
            LocalIp = ComboBox1.Text.Trim()
            StartListener()   '开始侦听已选网卡的UDP端口
        Catch

        End Try
    End Sub
    Private Sub ThrListener() ''侦听线程      
        While ready
            Try
                Dim bytes(1024) As Byte
                Dim dataArray() As String
                Dim RemotePoint As System.Net.EndPoint = New System.Net.IPEndPoint(System.Net.IPAddress.Any, 0)
                Dim NumGet As Integer
                Dim Msg As String
                Dim Sendinf As String
                Dim SendBuf As Byte()

                Dim DevBufferIpAddrStr As String
                Dim DevBufferRemoteAddrStr As String
                Dim DevBufferUseTimeStr As String
                Dim DevRecFramesStr As String
                Dim DevBufferMachinStr As String
                Dim DevBufferCardidStr As String
                Dim DevBufferUseMoneryStr As String
                Dim DevBufferSerialNumStr As String

                Dim ipep As IPEndPoint

                NumGet = ListenerSock.ReceiveFrom(bytes, RemotePoint)
                Msg = Encoding.UTF8.GetString(bytes, 0, NumGet)                
                Me.Invoke(New editUi(AddressOf EditUiNow), Now() & (" FromIP：" & Convert.ToString(RemotePoint) + "          ").Substring(0, 30) & "Data：", Msg) '用Invoke跨线程更新UI      

                dataArray = Split(Convert.ToString(Msg), ",")
                Select Case dataArray(0)
                    Case "101"             '接收到 1、终端开机时向电脑发送的开机信息,         2、电脑发送002查询设备时间所返回的信息

                    Case "102"                                    '刷卡后设备向电脑发送此信息
                        DevRecFramesStr = dataArray(1)            '包序列号
                        DevBufferIpAddrStr = dataArray(2)         '终端IP
                        DevBufferRemoteAddrStr = dataArray(3)     '远程电脑指机IP
                        DevBufferMachinStr = dataArray(4)         '机号
                        DevBufferCardidStr = dataArray(5)         '十位物理卡号
                        If dataArray.Length > 6 Then
                            DevBufferSerialNumStr = dataArray(6)  '2018年以后的设备有唯一硬件序号
                        End If

                        Sendinf = "001," + DevRecFramesStr        '向设备发此数据表示已收到信息，否则设备会连续发三次
                        SendBuf = Encoding.GetEncoding(936).GetBytes(Sendinf)
                        ListenerSock.SendTo(SendBuf, SendBuf.Length, SocketFlags.None, RemotePoint)
                        Me.Invoke(New Gxdjs(AddressOf Cdjs), Now() & (" SendTo：" & Convert.ToString(RemotePoint) + "          ").Substring(0, 30) & "Data：" & Sendinf)

                        '此处加入业务对数据库的查、增、删、减操作

                        Sendinf = "009," & DevBufferMachinStr & ",{卡号:}" & DevBufferCardidStr & "\\n姓名：张三丰\\n余额：1688.88\\n职务：武当掌门\\n,20,1,8"
                        SendBuf = Encoding.GetEncoding(936).GetBytes(Sendinf)
                        ListenerSock.SendTo(SendBuf, SendBuf.Length, SocketFlags.None, RemotePoint)
                        Me.Invoke(New Gxdjs(AddressOf Cdjs), Now() & (" SendTo：" & Convert.ToString(RemotePoint) + "          ").Substring(0, 30) & "Data：" & Sendinf)

                    Case "103"                                     '按消费金额后刷卡 向电脑发送此信息
                        DevRecFramesStr = dataArray(1)             '包序列号
                        DevBufferIpAddrStr = dataArray(2)          '终端IP
                        DevBufferRemoteAddrStr = dataArray(3)      '远程电脑指机IP
                        DevBufferMachinStr = dataArray(4)          '机号
                        DevBufferCardidStr = dataArray(5)          '卡号
                        DevBufferUseMoneryStr = dataArray(6)       '消费额
                        DevBufferUseTimeStr = dataArray(7)         '消费时间
                        If dataArray.Length > 8 Then
                            DevBufferSerialNumStr = dataArray(8)  '2018年以后的设备有唯一硬件序号
                        End If

                        Sendinf = "001," + DevRecFramesStr        '向设备发此数据表示已收到信息，否则设备会连续发三次
                        SendBuf = Encoding.GetEncoding(936).GetBytes(Sendinf)
                        ListenerSock.SendTo(SendBuf, SendBuf.Length, SocketFlags.None, RemotePoint)
                        Me.Invoke(New Gxdjs(AddressOf Cdjs), Now() & (" SendTo：" & Convert.ToString(RemotePoint) + "          ").Substring(0, 30) & "Data：" & Sendinf)

                        '此处加入业务对数据库的查、增、删、减操作

                        '008指令返回本次消费成功，006指令返回本次消费失败，正式系统开发时要有重发机制*
                        Sendinf = "008," & DevBufferMachinStr & "," & DevBufferCardidStr & "," & DevBufferUseMoneryStr & ",姓名:张三丰{ 168.98\\n},20,1,1"
                        SendBuf = Encoding.GetEncoding(936).GetBytes(Sendinf)
                        ListenerSock.SendTo(SendBuf, SendBuf.Length, SocketFlags.None, RemotePoint)
                        Me.Invoke(New Gxdjs(AddressOf Cdjs), Now() & (" SendTo：" & Convert.ToString(RemotePoint) + "          ").Substring(0, 30) & "Data：" & Sendinf)
                End Select

            Catch ex As Exception
                Me.Invoke(New Gxdjs(AddressOf Cdjs), "ERROR：" & vbCrLf & ex.Message & vbCrLf)
            End Try
        End While
    End Sub

    Private Sub Cdjs(ByVal data As String) '这里要和委托定义时的参数保持一致
        ListBox1.Items.Add(data)
        ListBox1.SelectedIndex = ListBox1.Items.Count - 1
    End Sub

    Private Sub EditUiNow(ByVal data0 As String, ByVal data1 As String) '这里要和委托定义时的参数保持一致
        ListBox1.Items.Add(data0 & data1)
        ListBox1.SelectedIndex = ListBox1.Items.Count - 1

        Dim dataArray() As String
        Dim DevBufferIpAddrStr As String
        Dim DevBufferMaskStr As String
        Dim DevBufferGatewayStr As String
        Dim DevBufferRemoteAddrStr As String
        Dim DevBufferPort As String
        Dim DevBufferNumberDecStr As String
        Dim DevBufferGatewayStrMAC As String
        Dim DevBufferRemoteAddrMACStr As String
        Dim DevBufferMACSearchStr As String
        Dim DevBufferSerialNumStr As String
        Dim plist As ListViewItem
        Dim i As Integer
        Dim poi As Integer
        Dim macstr As String

        dataArray = Split(data1, ",")
        If dataArray(0) = "100" Then       '发送搜索指令后，在线设备的返回信息
            If UBound(dataArray) = 6 Then  '旧设备不能跨网段通讯的设备返回信息
                For i = 1 To UBound(dataArray) / 6
                    DevBufferIpAddrStr = dataArray((i - 1) * 6 + 1)
                    DevBufferMaskStr = dataArray((i - 1) * 6 + 2)
                    DevBufferGatewayStr = dataArray((i - 1) * 6 + 3)
                    DevBufferRemoteAddrStr = dataArray((i - 1) * 6 + 4)
                    DevBufferPort = dataArray((i - 1) * 6 + 5)
                    DevBufferNumberDecStr = dataArray((i - 1) * 6 + 6)

                    poi = InStr(1, machinnos, DevBufferNumberDecStr)
                    If poi = 0 Then
                        macstr = DevBufferNumberDecStr
                        machinnos = machinnos + DevBufferNumberDecStr
                        plist = ListView1.Items.Add(DevBufferIpAddrStr)
                        plist.SubItems.Add(DevBufferMaskStr)
                        plist.SubItems.Add(DevBufferGatewayStr)
                        plist.SubItems.Add("")
                        plist.SubItems.Add(DevBufferRemoteAddrStr)
                        plist.SubItems.Add("")
                        plist.SubItems.Add("")
                        plist.SubItems.Add(DevBufferPort)
                        plist.SubItems.Add(DevBufferNumberDecStr)
                        plist.SubItems.Add("否")
                        plist.SubItems.Add(macstr)
                    End If
                Next
            End If

            If UBound(dataArray) >= 9 Then  '可跨网段通讯设备的返回信息
                For i = 1 To UBound(dataArray) / 9
                    DevBufferIpAddrStr = dataArray((i - 1) * 9 + 1)
                    DevBufferMaskStr = dataArray((i - 1) * 9 + 2)
                    DevBufferGatewayStr = dataArray((i - 1) * 9 + 3)
                    DevBufferGatewayStrMAC = dataArray((i - 1) * 9 + 4)
                    DevBufferRemoteAddrStr = dataArray((i - 1) * 9 + 5)
                    DevBufferRemoteAddrMACStr = dataArray((i - 1) * 9 + 6)
                    DevBufferMACSearchStr = dataArray((i - 1) * 9 + 7)
                    DevBufferPort = dataArray((i - 1) * 9 + 8)
                    DevBufferNumberDecStr = dataArray((i - 1) * 9 + 9)

                    macstr = DevBufferNumberDecStr

                    If UBound(dataArray) >= 9 Then DevBufferSerialNumStr = dataArray(10) Else DevBufferSerialNumStr = ""

                    poi = InStr(1, machinnos, DevBufferNumberDecStr)
                    If poi = 0 Then
                        machinnos = machinnos + DevBufferNumberDecStr
                        plist = ListView1.Items.Add(DevBufferIpAddrStr)
                        plist.SubItems.Add(DevBufferMaskStr)
                        plist.SubItems.Add(DevBufferGatewayStr)
                        plist.SubItems.Add(DevBufferGatewayStrMAC)
                        plist.SubItems.Add(DevBufferRemoteAddrStr)
                        plist.SubItems.Add(DevBufferRemoteAddrMACStr)
                        plist.SubItems.Add(DevBufferMACSearchStr)
                        plist.SubItems.Add(DevBufferPort)
                        plist.SubItems.Add(DevBufferNumberDecStr)
                        plist.SubItems.Add("是")
                        plist.SubItems.Add(macstr)
                        plist.SubItems.Add(DevBufferSerialNumStr)
                    End If
                Next
            End If
        End If
    End Sub

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        ListView1.Items.Clear()
        machinnos = ""

        Dim Remote As IPEndPoint = New IPEndPoint(IPAddress.Broadcast, PortNumber)
        ListenerSock.SetSocketOption(SocketOptionLevel.Socket, SocketOptionName.Broadcast, 1) '设为广播式发送
        Dim ByArr As Byte() = Encoding.GetEncoding(936).GetBytes("000")
        ListenerSock.SendTo(ByArr, ByArr.Length, SocketFlags.None, Remote)

        Dim SendInf As String = Now() & " SendTo：255.255.255.255:39192 Data：000"
        ListBox1.Items.Add(SendInf)
        ListBox1.SelectedIndex = ListBox1.Items.Count - 1
    End Sub

示例源码下载::VB.net网络SocketUDP通讯实时在线消费考勤门禁源代码-VB文档类资源-CSDN下载VB.net开发的SocketUDP通讯源代码，做为实时在线型消费考勤门禁的UDP服务器端，开启线更多下载资源、学习资料请访问CSDN下载频道.https://download.csdn.net/download/zhangjin7422/85373472

在线短网址网站