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
相关推荐
即兴随缘11 小时前
【RabbitMQ】主题(Topics)与主题交换机(Topic Exchange)
rabbitmq·.net
mudtools17 小时前
.NET操作Excel:高效数据读写与批量操作
c#·.net·excel·wps
mudtools1 天前
.NET驾驭Word之力:数据驱动文档 - 邮件合并与自定义数据填充完全指南
c#·word·.net
Hello.Reader1 天前
Protocol Buffers .NET 运行时从核心 API 到工程实战
.net
_BigMao1 天前
Linux服务器从零开始-部署.net控制台程序(AlmaLinux)
linux·服务器·.net
咕白m6252 天前
通过 C# 复制 Excel 工作表
c#·.net
一个帅气昵称啊2 天前
在.NET中实现RabbitMQ客户端的优雅生命周期管理及二次封装
分布式·后端·架构·c#·rabbitmq·.net
王维志3 天前
在Unity中使用SQLite(Sqlite-net-pcl)
unity·sqlite·c#·.net