VB.net复制Ntag213卡写入UID

本示例使用的发卡器:https://item.taobao.com/item.htm?ft=t&id=615391857885

一、读取旧Ntag卡的UID和数据

vbnet 复制代码
    Private Sub Button15_Click(sender As Object, e As EventArgs) Handles Button15.Click
        '轻松读卡
        '技术支持:
        '网站:
        Dim i, j As Integer
        Dim cardidhex, authkey, Str As String
        Dim status, myctrlword, comedc As Byte '存放返回值
        Dim mypiccserial(7) As Byte '卡序列号
        Dim mypicckey(0 To 3) As Byte '认证密码
        Dim mypiccdata(0 To 3) As Byte '读卡的数据缓冲,Ultralight卡及NTAG21x卡的数组长度必须为16个字节,写卡的为4个字节
        Dim piccdata(0 To 8191) As Byte
        Dim myblockaddr As Byte '起始块地址
        Dim myblocksize As Byte '总块数

        If CheckBox3.Checked Then
            If Len(Trim(TextBox7.Text)) < 8 Then
                i = MsgBox("卡认证密码位数不足!", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
                If i <> vbOK Then
                    TextBox7.Select()
                    Exit Sub
                End If
            Else
                authkey = Trim(TextBox7.Text)
                For i = 0 To 3
                    mypicckey(i) = CByte("&H" & Mid(authkey, i * 2 + 1, 2))
                Next
            End If
            myctrlword = &H10  '需要认证卡密码后再继续
        Else
            myctrlword = 0
        End If

        myblockaddr = CByte(rwbeginp.Value)
        myblocksize = CByte(rwps.Value)

        j = 0
        For i = myblockaddr To myblockaddr + myblocksize - 1
            status = piccreadex_ntag(myctrlword, mypiccserial(0), mypicckey(0), i, 1, mypiccdata(0))
            If status = 0 Then
                piccdata(j * 4 + 0) = mypiccdata(0)
                piccdata(j * 4 + 1) = mypiccdata(1)
                piccdata(j * 4 + 2) = mypiccdata(2)
                piccdata(j * 4 + 3) = mypiccdata(3)
                j = j + 1
            Else
                Exit For
            End If
        Next

        Select Case status
            Case 0
                pcdbeep(50)
                cardidhex = ""
                For i = 0 To 6
                    cardidhex = cardidhex + Strings.Right("00" + Hex(mypiccserial(i)), 2)
                Next
                TextBox8.Text = cardidhex


                cardidhex = ""
                For i = 0 To myblocksize * 4 - 1
                    cardidhex = cardidhex + Strings.Right("00" + Hex(piccdata(i)), 2)
                Next
                RichTextBox1.Text = cardidhex
                lcddispfull("读卡成功!                        ")
                MsgBox("读卡成功!", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "提示")

            Case 8
                lcddispfull("请将卡放在感应区!                        ")
                MsgBox("请将卡放在感应区!", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 12
                lcddispfull("读块" + Convert.ToString(i) + "失败,密码错误!                       ")
                MsgBox("读块" + Convert.ToString(i) + "失败,密码错误!", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 13
                lcddispfull("读块" + Convert.ToString(i) + "失败,可能需要验证密码!                       ")
                MsgBox("读块" + Convert.ToString(i) + "失败,可能需要验证密码!", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 23
                MsgBox("请连上USB读写器!", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case Else
                lcddispfull("读块" + Convert.ToString(i) + "时操作异常,返回代码:" + Convert.ToString(status) + "                        ")
                MsgBox("读块" + Convert.ToString(i) + "时操作异常,返回代码:" + Convert.ToString(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
        End Select
    End Sub

二、将读取的UID和数据写入新标签

vbnet 复制代码
    Private Sub Button16_Click(sender As Object, e As EventArgs) Handles Button16.Click
        '技术支持:
        '网站:
        Dim i, j As Integer
        Dim cardidhex, authkey, Str, writstr As String
        Dim status, myctrlword, comedc As Byte '存放返回值
        Dim mypiccserial(7) As Byte '卡序列号
        Dim mypicckey(0 To 3) As Byte '认证密码
        Dim mypiccdata(0 To 3) As Byte '写卡的为4个字节
        Dim myblockaddr As Byte '起始块地址
        Dim myblocksize As Byte '总块数
        Dim piccdata(0 To 8100) As Byte
        Dim rwlen As Integer

        If rwps.Value < 1 Then
            MsgBox("写卡页数必须大于0!", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Exit Sub
        End If

        myblockaddr = CByte(rwbeginp.Value)
        myblocksize = CByte(rwps.Value)

        If CheckBox3.Checked Then
            If Len(Trim(TextBox7.Text)) < 8 Then
                i = MsgBox("卡认证密码位数不足!", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
                If i <> vbOK Then
                    TextBox7.Select()
                    Exit Sub
                End If
            Else
                authkey = Trim(TextBox7.Text)
                For i = 0 To 3
                    mypicckey(i) = CByte("&H" & Mid(authkey, i * 2 + 1, 2))
                Next
            End If
            myctrlword = &H10  '需要认证卡密码后再继续
        Else
            myctrlword = 0
        End If

        rwlen = myblocksize * 4
        If Not checkhexstr(RichTextBox1.Text.Trim(), rwlen, piccdata) Then
            MessageBox.Show("写卡信息不足,建议先读取对应块内数据后再改写!", "警告", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Return
        End If

        j = 0
        For i = myblockaddr To myblockaddr + myblocksize - 1
            mypiccdata(0) = piccdata(j * 4 + 0)
            mypiccdata(1) = piccdata(j * 4 + 1)
            mypiccdata(2) = piccdata(j * 4 + 2)
            mypiccdata(3) = piccdata(j * 4 + 3)
            If i = 2 Then
                mypiccdata(2) = 0
                mypiccdata(3) = 0
                status = picclock_ntag(0, mypiccdata(0))   '2块的后两个字节是静态锁
            Else
                status = piccwriteex_ntag(myctrlword, mypiccserial(0), mypicckey(0), i, 1, mypiccdata(0))
            End If
            If status = 0 Then
                j = j + 1
            Else
                Exit For
            End If
        Next

        Select Case status
            Case 0
                pcdbeep(50)
                cardidhex = ""
                For i = 0 To 6
                    cardidhex = cardidhex + Strings.Right("00" + Hex(mypiccserial(i)), 2)
                Next
                TextBox8.Text = cardidhex
                lcddispfull("写卡成功!                        ")
                MsgBox("写卡成功!", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "提示")

            Case 8
                lcddispfull("请将卡放在感应区!                        ")
                MsgBox("请将卡放在感应区!", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 12
                lcddispfull("写块" + Convert.ToString(i) + "时失败,卡密码错误!                        ")
                MsgBox("写块" + Convert.ToString(i) + "时失败,卡密码错误!", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 14
                lcddispfull("写块" + Convert.ToString(i) + "时失败,可能需要验证密码或页已经锁定!                        ")
                MsgBox("写块" + Convert.ToString(i) + "时失败,可能需要验证密码或页已经锁定!", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 23
                MsgBox("请连上USB读写器!", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case Else
                lcddispfull("写块" + Convert.ToString(i) + "时操作异常,代码:" + Convert.ToString(status) + "                        ")
                MsgBox("写块" + Convert.ToString(i) + "时操作异常,返回代码:" + Convert.ToString(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
        End Select
    End Sub
相关推荐
步步为营DotNet11 小时前
深入.NET 11:C# 14 在边缘计算数据处理的优化与实践
c#·.net·边缘计算
步步为营DotNet1 天前
洞悉.NET 11:Blazor 与 Microsoft.Extensions.AI 的融合创新实践
人工智能·microsoft·.net
回忆2012初秋1 天前
.NET 8.0 实战:基于 MQTTnet 封装高可用的 MQTT 发布/订阅工具类
开发语言·mqtt·.net
回忆2012初秋1 天前
.NET 8.0 工业物联网实战:基于 S7netplus 封装高可用西门子 PLC 通信类
物联网·.net
学以智用2 天前
.NET Core 仓储模式(Repository Pattern)完整教程
后端·.net
.NET修仙日记2 天前
.NET EFCore批量插入性能优化实战:30秒 → 0.5秒
性能优化·c#·.net·.netcore·微软技术·efcore·踩坑实录
步步为营DotNet2 天前
深挖.NET 11:.NET Aspire 在云原生应用状态管理的创新与实践
云原生·.net·wpf
我是唐青枫2 天前
C#.NET YARP 跨域配置详解:网关统一处理 CORS
开发语言·c#·.net
唐青枫3 天前
C#.NET YARP 跨域配置详解:网关统一处理 CORS
c#·.net
rockey6274 天前
AScript如何实现LINQ语法
sql·c#·.net·linq·script·eval·expression