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
相关推荐
学以智用16 小时前
WinForms / WPF / Blazor 项目模板详解
.net
1-1=017 小时前
.NET Core 内存管理
.net·.netcore
无风听海1 天前
.NET 10之Span技术总结
.net
1-1=01 天前
.NET Core 配置与选项
.net·.netcore·1024程序员节
mudtools1 天前
在飞书 SDK 上用 Microsoft Agent Framework 搭一个能干活的工作搭子
人工智能·ai·.net·飞书·agent
ChaITSimpleLove1 天前
Layout.WatchDog.NET 1.5.0-beta.3 发布:统一全后端雪花 ID 策略,数据库能力矩阵一览
.net·watchdog·日志记录器·节点资源监控看板·.net专属轻量级日志中心
IT规划师1 天前
MQTT 实战 - 放下炫技,8 年踩坑的真心话与方法论(收官)
物联网·.net
CSharp精选营1 天前
.NET 接口从 800ms 干到 60ms:生产环境这几个优化点最关键
性能优化·c#·.net·efcore
CSharp精选营2 天前
制造业 ERP 物料建模:主料、辅料和 BOM 到底怎么拆才稳
.net·erp·bom·制造业·物料建模