VB.Net读写NFC Ntag标签源码

已于 2023-11-20 08:28:24 修改
阅读量598 收藏 2
点赞数 1
分类专栏： IC读写器 18002295132 QQ:954486673 文章标签： vb.net NFC Vb.net Ntag vb.net DLL VB.net RFID Ntag读写
于 2022-06-29 09:10:29 首次发布
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/zhangjin7422/article/details/125513424
版权

读写器介绍 ：USB液显ISO14443-A读写器 RFID读写器 M1/S50/S70/F08/ULtralight-淘宝网 (taobao.com)icon-default.png?t=N7T8https://item.taobao.com/item.htm?spm=a1z10.5-c.w4002-17663462238.13.69f6e728nD9A5a&id=18645603742

Module Module1

    '让设备发出声响函数声明
    Public Declare Function pcdbeep Lib "OUR_MIFARE.dll" (ByVal xms As Long) As Byte

    '读取设备编号函数声明
    Public Declare Function pcdgetdevicenumber Lib "OUR_MIFARE.dll" (ByRef devicenumber As Byte) As Byte

    '寻卡选卡激活卡
    Public Declare Function piccrequest_ul Lib "OUR_MIFARE.dll" (ByRef devicenumber As Byte) As Byte

    '读块
    Public Declare Function piccread_ul Lib "OUR_MIFARE.dll" (ByVal blockaddr As Byte, ByRef piccdata As Byte) As Byte

    '写块
    Public Declare Function piccwrite_ul Lib "OUR_MIFARE.dll" (ByVal blockaddr As Byte, ByRef piccdata As Byte) As Byte

    'ntag21x卡的密码认证
    Public Declare Function piccauthkey_ntag Lib "OUR_MIFARE.dll" (ByRef picckey As Byte, ByRef piccntagpack As Byte) As Byte

    '读取卡版本信息
    Public Declare Function piccgetversion_ntag Lib "OUR_MIFARE.dll" (ByRef piccversiondata As Byte) As Byte

    '读取卡的签字信息
    Public Declare Function piccreadsig_ntag Lib "OUR_MIFARE.dll" (ByRef piccsigdata As Byte) As Byte

    '读取卡的单向操作计数器（操作流水号）
    Public Declare Function piccreadcnt_ntag Lib "OUR_MIFARE.dll" (ByRef picccntdata As Byte) As Byte

    '锁定页数据
    Public Declare Function picclock_ntag Lib "OUR_MIFARE.dll" (ByVal locktype As Byte, ByRef mypicclockdata As Byte) As Byte

    '初始化卡
    Public Declare Function piccinit_ntag Lib "OUR_MIFARE.dll" (ByVal ctrlword As Byte, ByRef serial As Byte, ByRef picckey As Byte, ByRef piccdata As Byte) As Byte

    '轻松读卡
    Public Declare Function piccreadex_ntag Lib "OUR_MIFARE.dll" (ByVal ctrlword As Byte, ByRef serial As Byte, ByRef picckey As Byte, ByVal blockaddr As Byte, ByVal blocksize As Byte, ByRef piccdata As Byte) As Byte

    '轻松写卡
    Public Declare Function piccwriteex_ntag Lib "OUR_MIFARE.dll" (ByVal ctrlword As Byte, ByRef serial As Byte, ByRef picckey As Byte, ByVal blockaddr As Byte, ByVal blocksize As Byte, ByRef piccdata As Byte) As Byte


    '控制字定义,控制字指定,控制字的含义请查看本公司网站提供的动态库说明
    Public Const BLOCK0_EN = &H1 '操作第0块
    Public Const BLOCK1_EN = &H2 '操作第1块
    Public Const BLOCK2_EN = &H4 '操作第2块
    Public Const NEEDSERIAL = &H8 '仅对指定序列号的卡号操作
    Public Const EXTERNKEY = &H10 '需要在参数中指定认证密码
    Public Const NEEDHALT = &H20 '操作后休眠该卡，必须拿开卡再放回感应区才能重新感应到卡
End Module

   

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        '轻松读卡
        '技术支持:
        '网站:

        Dim status As Byte '存放返回值
        Dim mypiccserial(7) As Byte '卡序列号
        Dim i As Integer
        Dim cardidhex As String
        Dim mypiccdata(0 To 15) As Byte '读卡的数据缓冲，Ultralight卡及NTAG21x卡的数组长度必须为16个字节，写卡的为4个字节
        Dim myblockaddr As Byte '起始块地址

        status = piccrequest_ul(mypiccserial(0))

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

                myblockaddr = CByte(blockadd.Value)
                status = piccread_ul(myblockaddr, mypiccdata(0))
                If status = 0 Then
                    cardidhex = ""
                    For i = 0 To 15
                        cardidhex = cardidhex + Strings.Right("00" + Hex(mypiccdata(i)), 2)
                    Next
                    TextBox2.Text = cardidhex
                    MsgBox("读卡成功！", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "提示")
                Else
                    MsgBox("操作异常，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
                End If
            Case 8
                MsgBox("请将卡放在感应区！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 23
                MsgBox("请连上USB读写器！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case Else
                MsgBox("操作异常，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
        End Select

    End Sub

    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
        '读取设备编号，可做为软件加密狗用,也可以根据此编号在公司网站上查询保修期限

        '技术支持:
        '网站:
        Dim status As Byte '存放返回值
        Dim devno(3) As Byte '设备编号

        status = pcdgetdevicenumber(devno(0))

        If status = 0 Then
            pcdbeep(50)
            MsgBox(CStr(devno(0)) + "-" + CStr(devno(1)) + "-" + CStr(devno(2)) + "-" + CStr(devno(3)))
        End If
    End Sub

    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
        pcdbeep(50)
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        '轻松写卡
        '技术支持:
        '网站:
        '轻松读卡
        '技术支持:
        '网站:

        Dim status As Byte '存放返回值
        Dim mypiccserial(7) As Byte '卡序列号
        Dim i As Integer
        Dim cardidhex, writstr As String
        Dim mypiccdata(0 To 3) As Byte '写卡的数据缓冲，Ultralight卡及NTAG21x卡的数组长度必须为16个字节，写卡的为4个字节
        Dim myblockaddr As Byte '起始块地址

        If Len(Trim(TextBox3.Text)) < 8 Then
            i = MsgBox("写卡信息不足，是否在后面自动补0？", MsgBoxStyle.Question + MsgBoxStyle.OkCancel, "提示")
            If i <> vbOK Then
                TextBox3.Select()
                Exit Sub
            Else
                TextBox3.Text = Strings.Left(Trim(TextBox3.Text) + "00000000", 8)
                writstr = Strings.Left(Trim(TextBox3.Text) + "00000000", 8)
            End If
        Else
            writstr = Trim(TextBox3.Text)
        End If

        status = piccrequest_ul(mypiccserial(0))

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

                For i = 0 To 3
                    mypiccdata(i) = CByte("&H" & Mid(writstr, i * 2 + 1, 2))
                Next

                myblockaddr = CByte(blockadd.Value)
                status = piccwrite_ul(myblockaddr, mypiccdata(0))
                If status = 0 Then
                    pcdbeep(50)
                    MsgBox("写卡成功！", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "提示")
                ElseIf status = 14 Then
                    MsgBox("写卡失败！可能页已经锁死不可再修改或要认证密码。", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
                Else
                    MsgBox("操作异常，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
                End If
            Case 8
                MsgBox("请将卡放在感应区！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 23
                MsgBox("请连上USB读写器！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case Else
                MsgBox("操作异常，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
        End Select

        '返回解释
        '#define ERR_REQUEST 8'寻卡错误
        '#define ERR_READSERIAL 9'读序列吗错误
        '#define ERR_SELECTCARD 10'选卡错误
        '#define ERR_LOADKEY 11'装载密码错误
        '#define ERR_AUTHKEY 12'密码认证错误
        '#define ERR_READ 13'读卡错误
        '#define ERR_WRITE 14'写卡错误
        '#define ERR_NONEDLL 21'没有动态库
        '#define ERR_DRIVERORDLL 22'动态库或驱动程序异常
        '#define ERR_DRIVERNULL 23'驱动程序错误或尚未安装
        '#define ERR_TIMEOUT 24'操作超时，一般是动态库没有反映
        '#define ERR_TXSIZE 25'发送字数不够
        '#define ERR_TXCRC 26'发送的CRC错
        '#define ERR_RXSIZE 27'接收的字数不够
        '#define ERR_RXCRC 28'接收的CRC错
    End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        Dim status As Byte '存放返回值
        Dim mypiccserial(7) As Byte '卡序列号
        Dim i As Integer
        Dim cardidhex As String

        status = piccrequest_ul(mypiccserial(0))

        Select Case status
            Case 0
                pcdbeep(50)
                cardidhex = ""
                For i = 0 To 6
                    cardidhex = cardidhex + Strings.Right("00" + Hex(mypiccserial(i)), 2)
                Next
                TextBox1.Text = cardidhex
                MsgBox("读卡序列号成功！", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "提示")
            Case 8
                MsgBox("请将卡放在感应区！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 23
                MsgBox("请连上USB读写器！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case Else
                MsgBox("操作异常，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
        End Select

    End Sub

    Private Sub TextBox3_KeyPress(sender As Object, e As KeyPressEventArgs) Handles TextBox3.KeyPress
        If (e.KeyChar >= "0" And e.KeyChar <= "9") Or (e.KeyChar >= "A" And e.KeyChar <= "F") Or (e.KeyChar >= "a" And e.KeyChar <= "f") Then    '控制只能输入16进制数
            e.Handled = False
        Else
            e.Handled = True
        End If
    End Sub


    Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
        '轻松读卡
        '技术支持:
        '网站:
        Dim i 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 47) As Byte '读卡的数据缓冲，Ultralight卡及NTAG21x卡的数组长度必须为16个字节，写卡的为4个字节
        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)

        '-------------------------------------------------------------------------
        '输出串口模块调式码
        comedc = &H1B
        Str = "0F1B"

        '控制字
        Str = Str + Strings.Right("00" + Hex(myctrlword), 2)
        comedc = comedc Xor myctrlword

        '卡号
        For i = 0 To 6
            Str = Str + Strings.Right("00" + Hex(mypiccserial(i)), 2)
            comedc = comedc Xor mypiccserial(i)
        Next i

        '密码
        For i = 0 To 3
            Str = Str + Strings.Right("00" + Hex(mypicckey(i)), 2)
            comedc = comedc Xor mypicckey(i)
        Next i

        '起始页号
        Str = Str + Strings.Right("00" + Hex(myblockaddr), 2)
        comedc = comedc Xor myblockaddr

        '起读写页数
        Str = Str + Strings.Right("00" + Hex(myblocksize), 2)
        comedc = comedc Xor myblocksize

        '校验码
        Str = Str + Strings.Right("00" + Hex(comedc), 2)
        RichTextBox2.Text = Str
        '-------------------------------------------------------------------------


        status = piccreadex_ntag(myctrlword, mypiccserial(0), mypicckey(0), myblockaddr, myblocksize, mypiccdata(0))

        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(mypiccdata(i)), 2)
                Next
                RichTextBox1.Text = cardidhex
                MsgBox("读卡成功！", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "提示")

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

    Private Sub RichTextBox1_KeyPress(sender As Object, e As KeyPressEventArgs) Handles RichTextBox1.KeyPress  '输入栏只能输入16进制数
        If (e.KeyChar >= "0" And e.KeyChar <= "9") Or (e.KeyChar >= "A" And e.KeyChar <= "F") Or (e.KeyChar >= "a" And e.KeyChar <= "f") Then    '控制只能输入16进制数
            e.Handled = False
        Else
            e.Handled = True
        End If
    End Sub

    Private Sub Button7_Click(sender As Object, e As EventArgs) Handles Button7.Click
        '技术支持:
        '网站:
        Dim i 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 47) As Byte '读卡的数据缓冲，Ultralight卡及NTAG21x卡的数组长度必须为16个字节，写卡的为4个字节
        Dim myblockaddr As Byte '起始块地址
        Dim myblocksize As Byte '总块数

        If rwps.Value < 1 Or rwps.Value > 11 Then
            MsgBox("写卡页数必须大于0，小于12！", 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

        If Len(Trim(RichTextBox1.Text)) < myblocksize * 4 * 2 Then
            i = MsgBox("写卡信息不足，是否在后面自动补0？", MsgBoxStyle.Question + MsgBoxStyle.OkCancel, "提示")
            If i <> vbOK Then
                RichTextBox1.Select()
                Exit Sub
            Else
                RichTextBox1.Text = Strings.Left(Trim(RichTextBox1.Text) + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", myblocksize * 4 * 2)
                writstr = Strings.Left(Trim(RichTextBox1.Text) + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", myblocksize * 4 * 2)
            End If
        Else
            writstr = Trim(RichTextBox1.Text)
        End If

        For i = 0 To myblocksize * 4 - 1
            mypiccdata(i) = CByte("&H" & Mid(writstr, i * 2 + 1, 2))
        Next

        '-------------------------------------------------------------------------
        '输出串口模块调式码
        comedc = &H1C
        Str = "3B1C"

        '控制字
        Str = Str + Strings.Right("00" + Hex(myctrlword), 2)
        comedc = comedc Xor myctrlword

        '卡号
        For i = 0 To 6
            Str = Str + Strings.Right("00" + Hex(mypiccserial(i)), 2)
            comedc = comedc Xor mypiccserial(i)
        Next i

        '密码
        For i = 0 To 3
            Str = Str + Strings.Right("00" + Hex(mypicckey(i)), 2)
            comedc = comedc Xor mypicckey(i)
        Next i

        '起始页号
        Str = Str + Strings.Right("00" + Hex(myblockaddr), 2)
        comedc = comedc Xor myblockaddr

        '起读写页数
        Str = Str + Strings.Right("00" + Hex(myblocksize), 2)
        comedc = comedc Xor myblocksize

        For i = 0 To 43
            Str = Str + Strings.Right("00" + Hex(mypiccdata(i)), 2)
            comedc = comedc Xor mypiccdata(i)
        Next

        '校验码
        Str = Str + Strings.Right("00" + Hex(comedc), 2)
        RichTextBox2.Text = Str
        '-------------------------------------------------------------------------


        status = piccwriteex_ntag(myctrlword, mypiccserial(0), mypicckey(0), myblockaddr, myblocksize, mypiccdata(0))

        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

                MsgBox("写卡成功！", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "提示")

            Case 8
                MsgBox("请将卡放在感应区！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 12
                MsgBox("密码错误！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 14
                MsgBox("写卡失败，可能需要验证密码或页已经锁定！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 23
                MsgBox("请连上USB读写器！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case Else
                MsgBox("操作异常，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
        End Select
    End Sub

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        ComboBox1.SelectedIndex = 1
    End Sub

    Private Sub Button8_Click(sender As Object, e As EventArgs) Handles Button8.Click
        Dim status As Byte '存放返回值
        Dim mypiccserial(7) As Byte '卡序列号
        Dim i As Integer
        Dim cardidhex, keystr As String
        Dim mypicckey(0 To 3) As Byte '4字节卡认证密码
        Dim mypiccntagpack(0 To 1) As Byte '2字节确认码

        If Len(Trim(TextBox4.Text)) <> 8 Then
            TextBox4.Select()
            MsgBox("认证密码必须是4个字节8位数字！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Exit Sub
        Else
            keystr = Trim(TextBox4.Text)
        End If

        status = piccrequest_ul(mypiccserial(0))

        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

                For i = 0 To 3
                    mypicckey(i) = CByte("&H" & Mid(keystr, i * 2 + 1, 2))
                Next

                status = piccauthkey_ntag(mypicckey(0), mypiccntagpack(0))
                If status = 0 Then
                    MsgBox("卡密码认证成功！确认码为：" + Strings.Right("00" + Hex(mypiccntagpack(0)), 2) + Strings.Right("00" + Hex(mypiccntagpack(1)), 2), MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "提示")
                ElseIf status = 12 Then
                    MsgBox("卡密码认证错误，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
                Else
                    MsgBox("操作异常，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
                End If
            Case 8
                MsgBox("请将卡放在感应区！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 23
                MsgBox("请连上USB读写器！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case Else
                MsgBox("操作异常，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
        End Select
    End Sub

    Private Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Click
        Dim status As Byte '存放返回值
        Dim mypiccserial(7) As Byte '卡序列号
        Dim piccversiondata(7) As Byte '卡版本信息
        Dim i As Integer
        Dim cardidhex As String

        status = piccrequest_ul(mypiccserial(0))

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

                status = piccgetversion_ntag(piccversiondata(0))
                If status = 0 Then
                    cardidhex = ""
                    For i = 0 To 7
                        cardidhex = cardidhex + Strings.Right("00" + Hex(piccversiondata(i)), 2)
                    Next
                    MsgBox("卡版本信息：" + cardidhex, MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "提示")
                Else
                    MsgBox("操作异常，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
                End If

            Case 8
                MsgBox("请将卡放在感应区！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 23
                MsgBox("请连上USB读写器！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case Else
                MsgBox("操作异常，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
        End Select
    End Sub

    Private Sub Button10_Click(sender As Object, e As EventArgs) Handles Button10.Click
        Dim status As Byte '存放返回值
        Dim mypiccserial(7) As Byte '卡序列号
        Dim piccsigdata(31) As Byte '卡签字信息
        Dim i As Integer
        Dim cardidhex As String

        status = piccrequest_ul(mypiccserial(0))

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

                status = piccreadsig_ntag(piccsigdata(0))
                If status = 0 Then
                    cardidhex = ""
                    For i = 0 To 31
                        cardidhex = cardidhex + Strings.Right("00" + Hex(piccsigdata(i)), 2)
                    Next
                    MsgBox("卡签字信息：" + cardidhex, MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "提示")
                Else
                    MsgBox("操作异常，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
                End If

            Case 8
                MsgBox("请将卡放在感应区！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 23
                MsgBox("请连上USB读写器！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case Else
                MsgBox("操作异常，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
        End Select
    End Sub

    Private Sub Button11_Click(sender As Object, e As EventArgs) Handles Button11.Click
        Dim status As Byte '存放返回值
        Dim mypiccserial(7) As Byte '卡序列号
        Dim mypicccntdata(2) As Byte '卡操作的单向计数器（卡操作流水号）
        Dim i As Integer
        Dim cardidhex As String

        status = piccrequest_ul(mypiccserial(0))

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

                status = piccreadcnt_ntag(mypicccntdata(0))
                If status = 0 Then
                    cardidhex = ""
                    For i = 0 To 2
                        cardidhex = cardidhex + Strings.Right("00" + Hex(mypicccntdata(i)), 2)
                    Next
                    MsgBox("卡操作的单向计数器：" + cardidhex, MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "提示")
                ElseIf status = 13 Then
                    MsgBox("    可能是计数器功能尚未启用或卡本身不支持计数功能，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
                Else
                    MsgBox("操作异常，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
                End If

            Case 8
                MsgBox("请将卡放在感应区！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 23
                MsgBox("请连上USB读写器！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case Else
                MsgBox("操作异常，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
        End Select
    End Sub

    Private Sub Button12_Click(sender As Object, e As EventArgs) Handles Button12.Click
        Dim status As Byte '存放返回值
        Dim mypiccserial(7) As Byte '卡序列号
        Dim mypicclockdata(3) As Byte '写卡的为4个字节
        Dim i, answ As Integer
        Dim cardidhex As String

        status = piccrequest_ul(mypiccserial(0))

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

                answ = MsgBox("    确定要锁死本卡的0~15页吗？锁死后这些页的数据不能再更改。", MsgBoxStyle.Question + MsgBoxStyle.YesNo, "提示")
                If answ = vbOK Then
                    mypicclockdata(0) = 0        '除非您确认了解这几个字节的意思，否则不要随修改
                    mypicclockdata(1) = 0
                    mypicclockdata(2) = &HF9
                    mypicclockdata(3) = 0

                    status = picclock_ntag(0, mypicclockdata(0))   '锁定0~15d页
                    If status = 0 Then
                        pcdbeep(50)
                        MsgBox("0~15页锁定位写入成功！！！", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "提示")
                    ElseIf status = 14 Then
                        MsgBox("写卡失败！", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "提示")
                    Else
                        MsgBox("操作异常，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
                    End If
                End If
            Case 8
                MsgBox("请将卡放在感应区！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 23
                MsgBox("请连上USB读写器！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case Else
                MsgBox("操作异常，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
        End Select
    End Sub

    Private Sub TextBox4_KeyPress(sender As Object, e As KeyPressEventArgs) Handles TextBox4.KeyPress
        If (e.KeyChar >= "0" And e.KeyChar <= "9") Or (e.KeyChar >= "A" And e.KeyChar <= "F") Or (e.KeyChar >= "a" And e.KeyChar <= "f") Then   '控制只能输入16进制数
            e.Handled = False
        Else
            e.Handled = True
        End If
    End Sub


    Private Sub Button13_Click(sender As Object, e As EventArgs) Handles Button13.Click
        Dim status As Byte '存放返回值
        Dim mypiccserial(7) As Byte '卡序列号
        Dim mypicclockdata(3) As Byte '写卡的为4个字节
        Dim i, answ As Integer
        Dim cardidhex As String

        status = piccrequest_ul(mypiccserial(0))

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

                answ = MsgBox("    确定要锁死本卡16页以后的数据吗？锁死后这些页的数据不能再更改。", MsgBoxStyle.Question + MsgBoxStyle.YesNo, "提示")
                If answ = vbOK Then
                    mypicclockdata(0) = &H1      '除非您确认了解这几个字节的意思，否则不要随修改
                    mypicclockdata(1) = &H1
                    mypicclockdata(2) = 0
                    mypicclockdata(3) = 0

                    status = picclock_ntag(1, mypicclockdata(0))   '锁定0~15d页
                    If status = 0 Then
                        pcdbeep(50)
                        MsgBox("16以后的页锁定位写入成功！！！", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "提示")
                    ElseIf status = 14 Then
                        MsgBox("写卡失败！", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "提示")
                    Else
                        MsgBox("操作异常，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
                    End If
                End If
            Case 8
                MsgBox("请将卡放在感应区！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 23
                MsgBox("请连上USB读写器！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case Else
                MsgBox("操作异常，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
        End Select
    End Sub


    Private Sub Button14_Click(sender As Object, e As EventArgs) Handles Button14.Click
        Dim status, myctrlword, comedc As Byte '存放返回值
        Dim mypiccserial(7) As Byte '卡序列号
        Dim i As Integer
        Dim cardidhex, authkey, Str As String
        Dim mypicckey(0 To 3) As Byte '认证密码
        Dim mypiccdata(0 To 15) As Byte '初始化卡参数

        If CheckBox1.Checked Then
            If Len(Trim(TextBox5.Text)) < 8 Then
                i = MsgBox("卡认证密码位数不足！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
                If i <> vbOK Then
                    TextBox5.Select()
                    Exit Sub
                End If
            Else
                authkey = Trim(TextBox5.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

        If ComboBox1.SelectedIndex = 0 Then      '开启卡的密码保护功能
            If Len(Trim(TextBox6.Text)) < 8 Then
                i = MsgBox("卡新密码位数不足！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
                If i <> vbOK Then
                    TextBox6.Select()
                    Exit Sub
                End If
            Else
                authkey = Trim(TextBox6.Text)
                For i = 0 To 3
                    mypiccdata(i + 8) = CByte("&H" & Mid(authkey, i * 2 + 1, 2))
                Next
            End If

            mypiccdata(12) = &H16  'PACK
            mypiccdata(13) = &H16  'PACK
            mypiccdata(14) = 0     'RFUI
            mypiccdata(15) = 0     'RFUI

            myctrlword = myctrlword + 4  '  //'更新控制字

            mypiccdata(0) = 0      'MIRROR
            mypiccdata(1) = 0      'RFUI
            mypiccdata(2) = 0      'MIRROR_PAGE
            mypiccdata(3) = beginp.Value  'AUTH0

            myctrlword = myctrlword + 1 '更新控制字

            mypiccdata(4) = Limitau.Value Mod 8 'AUTH0
            If CheckBox2.Checked Then
                mypiccdata(4) = mypiccdata(4) + &H80
            End If

            '启用计数器
            mypiccdata(5) = 0
            mypiccdata(6) = 0
            mypiccdata(7) = 0

            myctrlword = myctrlword + 2  '更新控制字
        Else
            mypiccdata(0) = &H0 'MIRROR
            mypiccdata(1) = &H0 'RFUI
            mypiccdata(2) = &H0 'MIRROR_PAGE
            mypiccdata(3) = &HFF 'AUTH0

            myctrlword = myctrlword + &H1 '更新控制字

            mypiccdata(4) = &H0

            mypiccdata(5) = &H0
            mypiccdata(6) = &H0
            mypiccdata(7) = &H0

            myctrlword = myctrlword + &H2 '更新控制字
        End If

        '-------------------------------------------------------------------------
        '输出串口模块调式码
        comedc = &H16
        Str = "1D16"

        '控制字
        Str = Str + Strings.Right("00" + Hex(myctrlword), 2)
        comedc = comedc Xor myctrlword

        '卡号
        For i = 0 To 6
            Str = Str + Strings.Right("00" + Hex(mypiccserial(i)), 2)
            comedc = comedc Xor mypiccserial(i)
        Next i

        '密码
        For i = 0 To 3
            Str = Str + Strings.Right("00" + Hex(mypicckey(i)), 2)
            comedc = comedc Xor mypicckey(i)
        Next i

        '数据
        For i = 0 To 15
            Str = Str + Strings.Right("00" + Hex(mypiccdata(i)), 2)
            comedc = comedc Xor mypiccdata(i)
        Next i


        '校验码
        Str = Str + Strings.Right("00" + Hex(comedc), 2)
        RichTextBox2.Text = Str
        '-------------------------------------------------------------------------

        status = piccinit_ntag(myctrlword, mypiccserial(0), mypicckey(0), mypiccdata(0))

        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
                MsgBox("初始化卡成功！", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "提示")
            Case 8
                MsgBox("请将卡放在感应区！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 12
                MsgBox("密码错误！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 14
                MsgBox("设置失败，可能需要验证密码！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case 23
                MsgBox("请连上USB读写器！", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
            Case Else
                MsgBox("操作异常，返回代码：" + Str(status), MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "提示")
        End Select

    End Sub

    Private Sub TextBox4_TextChanged(sender As Object, e As EventArgs) Handles TextBox4.TextChanged

    End Sub

    Private Sub TextBox5_KeyPress(sender As Object, e As KeyPressEventArgs) Handles TextBox5.KeyPress
        If (e.KeyChar >= "0" And e.KeyChar <= "9") Or (e.KeyChar >= "A" And e.KeyChar <= "F") Or (e.KeyChar >= "a" And e.KeyChar <= "f") Then   '控制只能输入16进制数
            e.Handled = False
        Else
            e.Handled = True
        End If
    End Sub

    Private Sub TextBox5_TextChanged(sender As Object, e As EventArgs) Handles TextBox5.TextChanged

    End Sub

    Private Sub TextBox6_KeyPress(sender As Object, e As KeyPressEventArgs) Handles TextBox6.KeyPress
        If (e.KeyChar >= "0" And e.KeyChar <= "9") Or (e.KeyChar >= "A" And e.KeyChar <= "F") Or (e.KeyChar >= "a" And e.KeyChar <= "f") Then   '控制只能输入16进制数
            e.Handled = False
        Else
            e.Handled = True
        End If
    End Sub

    Private Sub TextBox6_TextChanged(sender As Object, e As EventArgs) Handles TextBox6.TextChanged

    End Sub

    Private Sub TextBox7_KeyPress(sender As Object, e As KeyPressEventArgs) Handles TextBox7.KeyPress
        If (e.KeyChar >= "0" And e.KeyChar <= "9") Or (e.KeyChar >= "A" And e.KeyChar <= "F") Or (e.KeyChar >= "a" And e.KeyChar <= "f") Then   '控制只能输入16进制数
            e.Handled = False
        Else
            e.Handled = True
        End If
    End Sub

    Private Sub TextBox7_TextChanged(sender As Object, e As EventArgs) Handles TextBox7.TextChanged

    End Sub

    Private Sub RichTextBox1_TextChanged(sender As Object, e As EventArgs) Handles RichTextBox1.TextChanged

    End Sub
End Class

vx_13822155058
关注
专栏目录
VB.net源码
01-05
picturebox里的图片旋转
vb.net源码分享
04-15
vb.net源码分享 计算机机房管理系统
[VB.NET源码]1-你好程序
VB.NET学习网-VB.NET实例、VB.NET教程、VB.NET源码下载
12-01 1107
从入门到高手，让你21天成为VB.NET高手的源代码哦，我就不必把代码写出来了，你们自己去下载就可以了……不要忘了加我QQ群，收藏我的博客哦！下载地址：1-你好程序<!--google_ad_client = "pub-8333940862668978";/* 728x90, 创建于 08-11-30 */google_ad_slot = "4485230109";goog
VB.NET源代码实例集.
01-14
vb.net 程序设计教程。由清华大学的教师做的测试，例子是非常棒的。 可能性供大家学习，和进步的一些好源码。 一步一步走让你的，编程道路，对初学者帮助由其最大
VB.net 源码（学生信息系统）
12-20
本人小白喜欢收集这些资源作为学习之用，觉得好的才拿来和大家分享，不喜勿喷哦~
NTAG21x芯片读写VB.NET示例源码.rar
08-21
总的来说，"NTAG21x芯片读写VB.NET示例源码"是一个实用的资源，它为VB.NET开发者提供了与NTAG21x芯片进行通信的起点。通过学习和理解示例代码，开发者可以快速构建自己的NFC应用，实现读取、写入以及更复杂的数据...
vb6读写NDEF智能海报源码
07-21
vb6编写的NDEF智能海报读、写源码，支持NDEF纯文本、智能海报、地图坐标、呼叫电话、电子名片、蓝牙连接、WIFI无线连接、启动APP应等不同类型的NDEF标签写入及读取，支持Ntag2x、MifareClass、Iso15693、Forum_Type2...
NTAG21x芯片读写VB6示例源码.rar
08-21
通过这个VB6示例源码，开发者可以学习如何在实际项目中集成NFC功能，实现与NTAG21x芯片的通信，从而创建自己的NFC应用，例如智能标签、物联网设备的配置等。 总的来说，VB6调用DLL读写NTAG21x芯片涉及到Windows编程...
PN532上位机读写winfrom源码
10-21
PN532是一种常用的NFC（近场通信）和RFID读写模块，它支持多种类型的RFID卡，包括M1卡（也称为EM4100或MF1系列），这与提供的标签“PN532 RFID M1”相吻合。 在RFID技术中，PN532模块是一个强大的接口，它允许...
USB-IC读写器M1IC卡Python示例源码.rar
08-10
Python +PyQt5开发的IC卡读写工具源码，支持Windows、Linux系统编译运行，使用UI界面与逻辑代码分离的方式，通过调用DLL动态库函数读M1IC卡号，读、写IC卡扇区内数据，修改卡片密码、控制字，函数说明：...
vb.net源码
06-18
vb.net源码
RFID标签读写程序-c#版.rar
04-05
RFID标签读写程序-c#版程序源码
手机NFC读写卡软件源码
11-21
手持机NFC功能读写卡开发功能源码，各行业安卓手机NFC读写卡开发源码。
android读写nfc卡源代码和苹果ios读写nfc方法说明
04-27
运行环境android studio 完整源代码,可以读取nfc卡序列号，写入卡信息源代码例子，进对例子进行扩展，下载回来后，电脑接上手机，运行在手机上，准备NFC卡（MifareUltralight格式）即可测试 具体操作方式见我博文，https://blog.csdn.net/qq_16005627/article/details/105786523
RFID标签读写程序源码
12-10
此源代码演示了对ISO18000-6B, 6C标准的RFID条码进行操作的所有细节
VB.net项目源码
weixin_30555125的博客
04-18 636
导入函数调用模块 Imports System.Data Imports System.Data.OleDb Imports System.Text Imports System.IO 添加删除更新模块 此模块直接运行，不需要返回表(记录) Public Sub exenonselect(ByVal sql As String) Try Dim con...
.net读写NFC卡（CPU卡FM1208）技术总结
fory77的专栏
03-02 2780
（1）两者底层结构基本一致，都是基于TLV思想（Tag,Length,Value）,而且都可以灵活变通，如根据需要，会变种为TV(Tag + Value)，LV(Length + Value)，甚至，只有一个Value。C#数据单位长度都是字节级，最小单位都是字节，像bool和byte都是占一个字节，这点没办法用bit级去搞小动作了，所以一些状态值字段，请用bool或byte，别用int，因为int是4字节....简单点说，类里边，凡是有汉字存在的字段，我都用的是 byte[] ，而不是string。
Java读写NFC标签Ntag2x芯片源码
zhangjin7422的专栏
03-05 870
Java通过Jna调用DLL动态库函数读写NFC标签，设置Ntag2芯片的访问密码，读、写Ntag2x芯片数据。读标签的UID、将汉字写入标签等操作。
Android Studio安卓读写NFC Ntag标签源码
最新发布
zhangjin7422的专栏
01-08 1076
Android Studio安卓读写NFC Ntag标签源码，读取标签UID、签名信息、计数器、设置静态锁、设置标签密钥保护机制、轻松读取标签内数据、轻松写数据。
VB.NET程序实现txt文件读写操作
"VB.NET读写txt文件源码是一个用于处理文本文件的代码示例，主要涉及在VB.NET环境中读取和写入TXT文件。此代码片段特别关注于读取TXT文件中的特定信息来设置翻页页数，并通过VBA或VSTO扩展到Microsoft Office应用...
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

vx_13822155058

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付：¥1
获取中
扫码支付

您的余额不足，请更换扫码支付或充值

打赏作者

实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值