本示例使用的发卡器：https://item.taobao.com/item.htm?ft=t&id=615391857885
Public Class Form1
Dim oldpicckey(0 To 5) As Byte '卡片旧密码
Dim newpicckey(0 To 5) As Byte '卡片新密码
Function GetTagUID() As String
Dim status As Byte
Dim myctrlword As Byte
Dim mypiccserial(0 To 7) As Byte
Dim mypickey(0 To 5) As Byte
Dim mypicdata(0 To 47) As Byte
Dim mypiccseriallen(0 To 1) As Byte
GetTagUID = ""
myctrlword = 0
status = piccreadex_ntag(myctrlword, mypiccserial(0), mypickey(0), 4, 1, mypicdata(0))
If status = 0 Then 'Ntag21x卡
For i = 0 To 6
GetTagUID = GetTagUID + mypiccserial(i).ToString("X02")
Next
Else
status = iso15693readex(myctrlword, 0, 0, 1, mypiccserial(0), mypicdata(0))
If status = 0 Then '15693卡
For i = 0 To 7
GetTagUID = GetTagUID + mypiccserial(i).ToString("X02")
Next
Else
myctrlword = 23
mypickey(0) = "&HFF" : mypickey(1) = "&HFF" : mypickey(2) = "&HFF" : mypickey(3) = "&HFF" : mypickey(4) = "&HFF" : mypickey(5) = "&HFF"
status = piccreadex(myctrlword, mypiccserial(0), 0, 1, mypickey(0), mypicdata(0))
If status = 0 Then 'MifareClass卡
For i = 0 To 3
GetTagUID = GetTagUID + mypiccserial(i).ToString("X02")
Next
Else
myctrlword = 23
mypickey(0) = "&HA0" : mypickey(1) = "&HA1" : mypickey(2) = "&HA2" : mypickey(3) = "&HA3" : mypickey(4) = "&HA4" : mypickey(5) = "&HA5"
status = piccreadex(myctrlword, mypiccserial(0), 0, 1, mypickey(0), mypicdata(0))
If status = 0 Then
For i = 0 To 3
GetTagUID = GetTagUID + mypiccserial(i).ToString("X02")
Next
Else
myctrlword = 0
If (forumtype4request(myctrlword, mypiccserial(0), mypiccseriallen(0)) = 0) Or (forumtype4request(myctrlword, mypiccserial(0), mypiccseriallen(0)) = 52) Then
For i = 0 To mypiccseriallen(0) - 1 'forumtype4卡
GetTagUID = GetTagUID + mypiccserial(i).ToString("X02")
Next
End If
End If
End If
End If
End If
End Function
Function checkcardtype() As Integer
Dim status As Byte
Dim myctrlword As Byte
Dim mypiccserial(0 To 7) As Byte
Dim mypickey(0 To 5) As Byte
Dim mypicdata(0 To 47) As Byte
Dim mypiccseriallen(0 To 1) As Byte
checkcardtype = 0
myctrlword = 0
status = piccreadex_ntag(myctrlword, mypiccserial(0), mypickey(0), 4, 1, mypicdata(0))
If status = 0 Then
checkcardtype = 1 'Ntag21x卡
Else
status = iso15693readex(myctrlword, 0, 0, 1, mypiccserial(0), mypicdata(0))
If status = 0 Then
checkcardtype = 2 '15693卡
Else
myctrlword = 23
mypickey(0) = "&HFF" : mypickey(1) = "&HFF" : mypickey(2) = "&HFF" : mypickey(3) = "&HFF" : mypickey(4) = "&HFF" : mypickey(5) = "&HFF"
status = piccreadex(myctrlword, mypiccserial(0), 0, 1, mypickey(0), mypicdata(0))
If status = 0 Then
checkcardtype = 3 'MifareClass卡
Else
myctrlword = 23
mypickey(0) = "&HA0" : mypickey(1) = "&HA1" : mypickey(2) = "&HA2" : mypickey(3) = "&HA3" : mypickey(4) = "&HA4" : mypickey(5) = "&HA5"
status = piccreadex(myctrlword, mypiccserial(0), 0, 1, mypickey(0), mypicdata(0))
If status = 0 Then
checkcardtype = 3
Else
myctrlword = 0
If (forumtype4request(myctrlword, mypiccserial(0), mypiccseriallen(0)) = 0) Or (forumtype4request(myctrlword, mypiccserial(0), mypiccseriallen(0)) = 52) Then
checkcardtype = 4 'forumtype4卡
Else
checkcardtype = 0
End If
End If
End If
End If
End If
End Function
Private Sub NtagPageLock() '锁定ntag2数据页，锁定后标签不可以再次修改，请谨慎使用锁定功能
Dim status As Byte
Dim mypicclockdata(0 To 3) As Byte
mypicclockdata(0) = "&H00" : mypicclockdata(1) = "&H00" : mypicclockdata(2) = "&HFF" : mypicclockdata(3) = "&HFF"
status = picclock_ntag(0, mypicclockdata(0)) '静态锁
mypicclockdata(0) = "&HFF" : mypicclockdata(1) = "&HFF" : mypicclockdata(2) = "&HFF" : mypicclockdata(3) = "&H00"
status = picclock_ntag(1, mypicclockdata(0)) '动态锁
End Sub
Private Sub NtagKeyEn(ByRef mypiccserial As Byte, ByVal havekey As Boolean, ByVal addkey As Boolean) '开启或关ntag2x卡密码保护功能
Dim myctrlword As Byte
Dim status As Byte
Dim mypiccdata(0 To 15) As Byte
If havekey Then '卡片已经有密码保护
myctrlword = "&H10"
Else
myctrlword = 0
End If
If addkey Then '开启卡密码保护功能
mypiccdata(0) = 0 : mypiccdata(1) = 0 : mypiccdata(2) = 0 : mypiccdata(3) = 4 '密码保护起始页
myctrlword = myctrlword + 1
mypiccdata(4) = 0 / 8 '认证次数
mypiccdata(5) = 0 : mypiccdata(6) = 0 : mypiccdata(7) = 0 '启用计数器
myctrlword = myctrlword + 2
For i = 0 To 3
mypiccdata(8 + i) = newpicckey(i)
Next
mypiccdata(12) = "&H16" : mypiccdata(13) = "&H16" : mypiccdata(14) = 0 : mypiccdata(15) = 0
myctrlword = myctrlword + 4
Else
mypiccdata(0) = 0 : mypiccdata(1) = 0 : mypiccdata(2) = 0 : mypiccdata(3) = "&HFF"
myctrlword = myctrlword + 1
mypiccdata(4) = 0 : mypiccdata(5) = 0 : mypiccdata(6) = 0 : mypiccdata(7) = 0
myctrlword = myctrlword + 2
End If
status = piccinit_ntag(myctrlword, mypiccserial, oldpicckey(0), mypiccdata(0))
End Sub
Private Sub button4_Click(sender As Object, e As EventArgs) Handles button4.Click
Dim xms As Integer
xms = 50
Dim status As Byte = pcdbeep(xms)
If status <> 0 Then
disperrinf(status)
End If
End Sub
Private Sub button8_Click(sender As Object, e As EventArgs) Handles button8.Click
Dim status As Byte '存放返回值
Dim devno(3) As Byte '设备编号
status = pcdgetdevicenumber(devno(0))
If status = 0 Then
MsgBox("设备编号：" + devno(0).ToString("D3") + "-" + devno(1).ToString("D3") + "-" + devno(2).ToString("D3") + "-" + devno(3).ToString("D3"), vbInformation + vbOKOnly, "提示")
Else
disperrinf(status)
End If
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
oldpicckey(0) = "&H19" : oldpicckey(1) = "&H74" : oldpicckey(2) = "&H02" : oldpicckey(3) = "&H02" : oldpicckey(4) = "&H01" : oldpicckey(5) = "&H11"
newpicckey(0) = "&H19" : newpicckey(1) = "&H74" : newpicckey(2) = "&H02" : newpicckey(3) = "&H02" : newpicckey(4) = "&H01" : newpicckey(5) = "&H11" '为防止测试中忘记以设定的密码，标签统一用此组密码加密，客户可自行设置其他的标签保护密码
comboBox1.SelectedIndex = 2
comboBox2.SelectedIndex = 7
comboBox3.SelectedIndex = 4
comboBox4.SelectedIndex = 3
End Sub
Private Sub WriteDataBufToTag(ByVal NDEFinfo As String, ByVal havelock As Boolean, ByVal keyEn As Boolean)
Dim status As Byte
Dim afi As Byte
Dim i As Integer
Dim myctrlword As Byte '控制字
Dim mypiccserial(0 To 7) As Byte '卡序列号
Dim mypiccseriallen(0 To 1) As Byte
Dim carduid As String
Dim cardtype As Byte = checkcardtype()
Select Case cardtype
Case 1 'Ntag2x标签
If havelock Then myctrlword = "&H10" Else myctrlword = 0
status = forumtype2_write_ndeftag(myctrlword, mypiccserial(0), oldpicckey(0))
If status = 0 Then
If CheckBox5.Checked = False Then NtagKeyEn(mypiccserial(0), havelock, keyEn) '开启或关闭Ntag2x标签密码保护功能
'If (keyEn) Then NtagPageLock() '锁定Ntag2标签数据块，锁定后不可再改修改，请谨慎使用
pcdbeep(38)
carduid = "Ntag2UID："
For i = 0 To 6
carduid = carduid + mypiccserial(i).ToString("X02")
Next
MessageBox.Show(carduid + "，" + NDEFinfo + "写入成功！", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
Else
disperrinf(status)
End If
Case 2 '15693标签
myctrlword = 0
afi = 0
status = forumtype5_write_ndeftag(myctrlword, afi, mypiccserial(0))
If status = 0 Then
'If (keyEn) Then iso15693lockblock(34, 1, mypiccserial(0)) '15693卡锁定块数据后只能读取不可再修改，为防止卡片锁死，仅在确定需要才开启此段代码。
pcdbeep(38)
carduid = "15693UID："
For i = 0 To 7
carduid = carduid + mypiccserial(i).ToString("X02")
Next
MessageBox.Show(carduid + "，" + NDEFinfo + "写入成功！", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
Else
disperrinf(status)
End If
Case 3 'MifareClass标签
If havelock Then myctrlword = 208 Else myctrlword = 144
If keyEn Then myctrlword = myctrlword + 4
status = piccwrite_ndeftag(myctrlword, mypiccserial(0), oldpicckey(0), newpicckey(0))
If status = 0 Then
pcdbeep(38)
carduid = "MifareClassUID："
For i = 0 To 3
carduid = carduid + mypiccserial(i).ToString("X02")
Next
MessageBox.Show(carduid + "，" + NDEFinfo + "写入成功！", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
Else
disperrinf(status)
End If
Case 4 'ForumType4标签
myctrlword = 0 '0表示标签无密码，如设置密码取值 &H40 ，mypicckey 存放密码
status = forumtype4_write_ndeftag(myctrlword, mypiccserial(0), mypiccseriallen(0), newpicckey(0))
If status = 0 Then
pcdbeep(38)
carduid = "ForumType4UID："
For i = 0 To mypiccseriallen(0) - 1
carduid = carduid + mypiccserial(i).ToString("X02")
Next
MessageBox.Show(carduid + "，" + NDEFinfo + "写入成功！", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
Else
disperrinf(status)
End If
Case Else
MessageBox.Show("请刷有效的NFC标签！", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Select
End Sub
Private Sub button1_Click(sender As Object, e As EventArgs) Handles button1.Click
Dim status As Byte
Dim havelock As Boolean = checkBox1.Checked '卡片是否已加密保护
Dim keyEn As Boolean = checkBox2.Checked '是否启用密码保护写入的NDEF信息
tagbuf_forumtype4_clear() '清空现有标签数据缓冲
tagbuf_clear() '清空现有标签数据缓冲
Dim languagecodestr As String = "en" '语言编码，英文为en,中文为zh
Dim languagecodestrlen As Integer = languagecodestr.Length
Dim textstr As String = textBox1.Text.Trim
Dim textstrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(textstr).Length
status = tagbuf_addtext(languagecodestr, languagecodestrlen, textstr, textstrlen) '可以用此方法写入多条记录到数据缓冲
If status <> 0 Then
MessageBox.Show("生成NDEF纯文本标签数据缓冲时返回码错误代码:" + status, "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
WriteDataBufToTag("NDEF纯文本标签", havelock, keyEn)
End If
End Sub
Private Sub button3_Click(sender As Object, e As EventArgs) Handles button3.Click
Dim status As Byte
Dim havelock As Boolean = checkBox1.Checked '卡片是否已加密保护
Dim keyEn As Boolean = checkBox2.Checked '是否启用密码保护写入的NDEF信息
Dim taguidstr As String = ""
tagbuf_forumtype4_clear() '清空现有标签数据缓冲
tagbuf_clear() '清空现有标签数据缓冲
If CheckBox5.Checked Then
taguidstr = "?uid=" & GetTagUID()
End If
Dim languagecodestr As String = "en" '语言编码，英文为en,中文为zh
Dim languagecodestrlen As Integer = languagecodestr.Length
Dim titlestr As String = textBox4.Text.Trim '标题
Dim titlestrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(titlestr).Length '标题长度
Dim uriheaderindex As Integer = comboBox1.SelectedIndex '前缀
Dim uristr As String = textBox5.Text.Trim & taguidstr 'uri
Dim uristrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(uristr).Length 'uri长度
Dim ntag21xmirrorbuf(0 To 6) As Byte 'Ntag21x UID或计数器镜像功能配置值缓冲
Dim i As Integer
ntag21xmirrorbuf(0) = 0
If CheckBox3.Checked Then '启用UID镜像
ntag21xmirrorbuf(0) = ntag21xmirrorbuf(0) + "&H40"
End If
If CheckBox4.Checked Then
ntag21xmirrorbuf(0) = ntag21xmirrorbuf(0) + "&H80"
End If
For i = 1 To 6
ntag21xmirrorbuf(i) = Asc("0")
Next
If ntag21xmirrorbuf(0) > 0 Then
status = tagbuf_adduri1(languagecodestr, languagecodestrlen, titlestr, titlestrlen, uriheaderindex, uristr, uristrlen, ntag21xmirrorbuf(0)) '可以用此方法写入多条记录到数据缓冲
Else
status = tagbuf_adduri(languagecodestr, languagecodestrlen, titlestr, titlestrlen, uriheaderindex, uristr, uristrlen) '可以用此方法写入多条记录到数据缓冲
End If
If status <> 0 Then
MessageBox.Show("生成NDEF智能海报数据缓冲时返回码错误代码:" + status, "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
WriteDataBufToTag("NDEF智能海报标签", havelock, keyEn)
End If
End Sub
Private Sub button5_Click(sender As Object, e As EventArgs) Handles button5.Click
Dim status As Byte
Dim havelock As Boolean = checkBox1.Checked '卡片是否已加密保护
Dim keyEn As Boolean = checkBox2.Checked '是否启用密码保护写入的NDEF信息
tagbuf_forumtype4_clear() '清空现有标签数据缓冲
tagbuf_clear() '清空现有标签数据缓冲
Dim languagecodestr As String = "en" '语言编码，英文为en,中文为zh
Dim languagecodestrlen As Integer = languagecodestr.Length
Dim titlestr As String = textBox7.Text.Trim '标题
Dim titlestrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(titlestr).Length '标题长度
Dim uriheaderindex As Integer = 0 '地理位置没有链接前缀
Dim uristr As String = "geo:" + textBox6.Text.Trim + "," + textBox8.Text.Trim 'uri
Dim uristrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(uristr).Length 'uri长度
status = tagbuf_adduri(languagecodestr, languagecodestrlen, titlestr, titlestrlen, uriheaderindex, uristr, uristrlen) '可以用此方法写入多条记录到数据缓冲
If status <> 0 Then
MessageBox.Show("生成NDEF地图坐标数据缓冲时返回码错误代码:" + status, "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
WriteDataBufToTag("NDEF地图坐标标签", havelock, keyEn)
End If
End Sub
Private Sub button6_Click(sender As Object, e As EventArgs) Handles button6.Click
Dim status As Byte
Dim havelock As Boolean = checkBox1.Checked '卡片是否已加密保护
Dim keyEn As Boolean = checkBox2.Checked '是否启用密码保护写入的NDEF信息
tagbuf_forumtype4_clear() '清空现有标签数据缓冲
tagbuf_clear() '清空现有标签数据缓冲
Dim languagecodestr As String = "en" '语言编码，英文为en,中文为zh
Dim languagecodestrlen As Integer = languagecodestr.Length
Dim titlestr As String = "" '标题
Dim titlestrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(titlestr).Length '标题长度
Dim uriheaderindex As Integer = 5 '呼叫电话的链接前缀为5
Dim uristr As String = textBox9.Text.Trim 'uri呼叫电话
Dim uristrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(uristr).Length 'uri长度
status = tagbuf_adduri(languagecodestr, languagecodestrlen, titlestr, titlestrlen, uriheaderindex, uristr, uristrlen) '可以用此方法写入多条记录到数据缓冲
If status <> 0 Then
MessageBox.Show("生成NDEF呼叫电话数据缓冲时返回码错误代码:" + status, "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
WriteDataBufToTag("NDEF呼叫电话标签", havelock, keyEn)
End If
End Sub
Private Sub button7_Click(sender As Object, e As EventArgs) Handles button7.Click
Dim status As Byte
Dim havelock As Boolean = checkBox1.Checked '卡片是否已加密保护
Dim keyEn As Boolean = checkBox2.Checked '是否启用密码保护写入的NDEF信息
tagbuf_forumtype4_clear() '清空现有标签数据缓冲
tagbuf_clear() '清空现有标签数据缓冲
Dim infostr As String = "BEGIN:VCARD" & Chr(10) '
infostr = infostr + "VERSION:3.0" & Chr(10)
infostr = infostr + "FN:" + textBox12.Text.Trim() & Chr(10) '姓名
infostr = infostr + "TEL:" + textBox11.Text.Trim() & Chr(10) '电话
infostr = infostr + "ORG:" + textBox10.Text.Trim() & Chr(10) '单位名称
infostr = infostr + "ADR:" + textBox15.Text.Trim() & Chr(10) '地址
infostr = infostr + "EMAIL:" + textBox13.Text.Trim() & Chr(10) '邮箱
infostr = infostr + "URL:" + textBox14.Text.Trim() & Chr(10) '官网
infostr = infostr + "END:VCARD" & Chr(10)
Dim infostrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(infostr).Length '名片长度
status = tagbuf_addbusinesscard(infostr, infostrlen) '可以用此方法写入多条记录到数据缓冲
If status <> 0 Then
MessageBox.Show("生成NDEF电子名片数据缓冲时返回码错误代码:" + status, "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
WriteDataBufToTag("NDEF电子名片标签", havelock, keyEn)
End If
End Sub
Private Sub button9_Click(sender As Object, e As EventArgs) Handles button9.Click
Dim status As Byte
Dim havelock As Boolean = checkBox1.Checked '卡片是否已加密保护
Dim keyEn As Boolean = checkBox2.Checked '是否启用密码保护写入的NDEF信息
tagbuf_forumtype4_clear() '清空现有标签数据缓冲
tagbuf_clear() '清空现有标签数据缓冲
Dim ssidstr As String = textBox16.Text.Trim '热点名称
Dim ssidstrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(ssidstr).Length '热点名称长度
Dim authtype As Integer = comboBox2.SelectedIndex '认证方式
Dim crypttype As Integer = comboBox3.SelectedIndex '加密算法
Dim keystr As String = textBox17.Text.Trim '密码
Dim keystrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(keystr).Length '密码长度
status = tagbuf_addwifi(ssidstr, ssidstrlen, authtype, crypttype, keystr, keystrlen) '可以用此方法写入多条记录到数据缓冲
If status <> 0 Then
MessageBox.Show("生成NDEF无线连接数据缓冲时返回码错误代码:" + status, "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
WriteDataBufToTag("NDEF无线连接标签", havelock, keyEn)
End If
End Sub
Private Sub button10_Click(sender As Object, e As EventArgs) Handles button10.Click
Dim status As Byte
Dim havelock As Boolean = checkBox1.Checked '卡片是否已加密保护
Dim keyEn As Boolean = checkBox2.Checked '是否启用密码保护写入的NDEF信息
tagbuf_forumtype4_clear() '清空现有标签数据缓冲
tagbuf_clear() '清空现有标签数据缓冲
Dim blenamestr As String = textBox19.Text.Trim '设备名称
Dim blenamestrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(blenamestr).Length '设备名称长度
Dim macstr() As String = Split(textBox18.Text.Trim, ":")
Dim macbuf(0 To 5) As Byte
Try
macbuf(0) = "&H" & macstr(0)
macbuf(1) = "&H" & macstr(1)
macbuf(2) = "&H" & macstr(2)
macbuf(3) = "&H" & macstr(3)
macbuf(4) = "&H" & macstr(4)
macbuf(5) = "&H" & macstr(5)
Catch ex As Exception
MessageBox.Show("蓝牙设备的MAC地址输入错误，请输入正确的MAC地址！", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
textBox18.Select()
End Try
status = tagbuf_addbluetooth(blenamestr, blenamestrlen, macbuf(0)) '可以用此方法写入多条记录到数据缓冲
If status <> 0 Then
MessageBox.Show("生成NDEF蓝牙连接数据缓冲时返回码错误代码:" + status, "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
WriteDataBufToTag("NDEF蓝牙连接标签", havelock, keyEn)
End If
End Sub
Private Sub comboBox4_SelectedIndexChanged(sender As Object, e As EventArgs) Handles comboBox4.SelectedIndexChanged
Dim appstr() As String = Split(comboBox4.Text.Trim, "：")
textBox20.Text = appstr(1)
End Sub
Private Sub button11_Click(sender As Object, e As EventArgs) Handles button11.Click
Dim status As Byte
Dim havelock As Boolean = checkBox1.Checked '卡片是否已加密保护
Dim keyEn As Boolean = checkBox2.Checked '是否启用密码保护写入的NDEF信息
tagbuf_forumtype4_clear() '清空现有标签数据缓冲
tagbuf_clear() '清空现有标签数据缓冲
Dim packagestr As String = textBox20.Text.Trim 'APP名称
Dim packagestrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(packagestr).Length 'APP名称长度
status = tagbuf_addapp(packagestr, packagestrlen) '可以用此方法写入多条记录到数据缓冲
If status <> 0 Then
MessageBox.Show("生成NDEF启动应用数据缓冲时返回码错误代码:" + status, "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
WriteDataBufToTag("NDEF启动应用标签", havelock, keyEn)
End If
End Sub
Private Sub button2_Click(sender As Object, e As EventArgs) Handles button2.Click
Dim status As Byte
Dim havelock As Boolean = checkBox1.Checked '卡片是否已加密保护
Dim keyEn As Boolean = checkBox2.Checked '是否启用密码保护写入的NDEF信息
tagbuf_forumtype4_clear() '清空现有标签数据缓冲
tagbuf_clear() '清空现有标签数据缓冲
Dim typestr As String = textBox2.Text.Trim '数据类型
Dim typestrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(typestr).Length '数据类型长度
Dim datastr As String = textBox3.Text.Trim '数据
Dim datastrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(datastr).Length '数据长度
status = tagbuf_adddata(typestr, typestrlen, datastr, datastrlen) '可以用此方法写入多条记录到数据缓冲
If status <> 0 Then
MessageBox.Show("生成NDEF数据标签缓冲时返回码错误代码:" + status, "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
WriteDataBufToTag("NDEF数据标签", havelock, keyEn)
End If
End Sub
Private Sub button12_Click(sender As Object, e As EventArgs) Handles button12.Click
Dim status As Byte
Dim afi As Byte
Dim myctrlword As Byte
Dim mypiccserial(0 To 7) As Byte
Dim mypiccseriallen(0 To 1) As Byte
Dim revstrlen(0 To 1) As Byte
Dim recordnumber(0 To 1) As Byte
Dim mypiccdata(0 To 2047) As Byte
Dim carduid As String = ""
Dim havelock As Boolean = checkBox1.Checked '卡片是否已加密保护
textBox21.Text = ""
status = 255
Dim cardtype As Byte = checkcardtype()
Select Case cardtype
Case 1 'Ntag2x标签
If havelock Then myctrlword = "&H10" Else myctrlword = 0
status = forumtype2_read_ndeftag(myctrlword, mypiccserial(0), oldpicckey(0))
carduid = "Ntag2UID："
For i = 0 To 6
carduid = carduid + mypiccserial(i).ToString("X02")
Next
Case 2 '15693标签
myctrlword = 0
afi = 0
status = forumtype5_read_ndeftag(myctrlword, afi, mypiccserial(0))
carduid = "15693UID："
For i = 0 To 7
carduid = carduid + mypiccserial(i).ToString("X02")
Next
Case 3 'MifareClass标签
myctrlword = 144
status = piccread_ndeftag(myctrlword, mypiccserial(0), oldpicckey(0))
carduid = "MifareClassUID："
For i = 0 To 3
carduid = carduid + mypiccserial(i).ToString("X02")
Next
Case 4 'ForumType4标签
myctrlword = 0 '0表示标签无密码，如设置密码取值 &H40 ，mypicckey 存放密码
status = forumtype4_read_ndeftag(myctrlword, mypiccserial(0), mypiccseriallen(0), oldpicckey(0))
carduid = "ForumType4UID："
For i = 0 To mypiccseriallen(0) - 1
carduid = carduid + mypiccserial(i).ToString("X02")
Next
Case Else
MessageBox.Show("请刷有效的NFC标签！", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Select
If status = 0 Then
pcdbeep(38)
tagbuf_read(mypiccdata(0), revstrlen(0), recordnumber(0))
Dim ndefstr As String = System.Text.Encoding.Default.GetString(mypiccdata)
textBox21.Text = carduid & Chr(13) & Chr(10) & ndefstr
End If
End Sub
Private Sub button13_Click(sender As Object, e As EventArgs) Handles button13.Click
Dim status As Byte
Dim afi As Byte
Dim i As Integer
Dim myctrlword As Byte '控制字
Dim mypiccserial(0 To 7) As Byte '卡序列号
Dim mypiccseriallen(0 To 1) As Byte
Dim carduid As String
Dim havelock As Boolean = checkBox1.Checked '卡片是否已加密保护
Dim keyEn As Boolean = False '清空标签，强制清空密钥
checkBox2.Checked = False '清空标签，强制清空密钥
tagbuf_forumtype4_clear() '清空现有标签数据缓冲
tagbuf_clear() '清空现有标签数据缓冲
Dim cardtype As Byte = checkcardtype()
Select Case cardtype
Case 1 'Ntag2x标签
If havelock Then myctrlword = "&H10" Else myctrlword = 0
status = forumtype2_write_ndeftag(myctrlword, mypiccserial(0), oldpicckey(0))
If status = 0 Then
NtagKeyEn(mypiccserial(0), havelock, keyEn) '开启或关闭Ntag2x标签密码保护功能
pcdbeep(38)
carduid = "Ntag2UID："
For i = 0 To 6
carduid = carduid + mypiccserial(i).ToString("X02")
Next
MessageBox.Show(carduid + "，NDEF标签信息已清空！", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
Else
disperrinf(status)
End If
Case 2 '15693标签
myctrlword = 0
afi = 0
status = forumtype5_write_ndeftag(myctrlword, afi, mypiccserial(0))
If status = 0 Then
pcdbeep(38)
carduid = "15693UID："
For i = 0 To 7
carduid = carduid + mypiccserial(i).ToString("X02")
Next
MessageBox.Show(carduid + "，NDEF标签信息已清空！", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
Else
disperrinf(status)
End If
Case 3 'MifareClass标签
If havelock Then myctrlword = 210 Else myctrlword = 146
status = piccclear_ndeftag(myctrlword, mypiccserial(0), oldpicckey(0))
If status = 0 Then
pcdbeep(38)
carduid = "MifareClassUID："
For i = 0 To 3
carduid = carduid + mypiccserial(i).ToString("X02")
Next
MessageBox.Show(carduid + "，NDEF标签信息已清空！", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
Else
disperrinf(status)
End If
Case 4 'ForumType4标签
myctrlword = 0 '0表示标签无密码，如设置密码取值 &H40 ，mypicckey 存放密码
status = forumtype4_write_ndeftag(myctrlword, mypiccserial(0), mypiccseriallen(0), oldpicckey(0))
If status = 0 Then
pcdbeep(38)
carduid = "ForumType4UID："
For i = 0 To mypiccseriallen(0) - 1
carduid = carduid + mypiccserial(i).ToString("X02")
Next
MessageBox.Show(carduid + "，NDEF标签信息已清空！", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
Else
disperrinf(status)
End If
Case Else
MessageBox.Show("请刷有效的NFC标签！", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Select
End Sub
Private Sub Button23_Click(sender As Object, e As EventArgs) Handles Button23.Click
tagbuf_forumtype4_clear() '清空现有标签数据缓冲
tagbuf_clear() '清空现有标签数据缓冲
MessageBox.Show("NDEF数据缓冲已经清除！", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
End Sub
Private Sub Button24_Click(sender As Object, e As EventArgs) Handles Button24.Click
Dim havelock As Boolean = checkBox1.Checked '卡片是否已加密保护
Dim keyEn As Boolean = checkBox2.Checked '是否启用密码保护写入的NDEF信息
WriteDataBufToTag("NDEF组合标签", havelock, keyEn)
End Sub
Private Sub Button14_Click(sender As Object, e As EventArgs) Handles Button14.Click
Dim status As Byte
Dim languagecodestr As String = "en" '语言编码，英文为en,中文为zh
Dim languagecodestrlen As Integer = languagecodestr.Length
Dim textstr As String = textBox1.Text.Trim
Dim textstrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(textstr).Length
status = tagbuf_addtext(languagecodestr, languagecodestrlen, textstr, textstrlen) '可以用此方法写入多条记录到数据缓冲
If status <> 0 Then
MessageBox.Show("生成NDEF纯文本标签数据缓冲时返回码错误代码:" + status, "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
MessageBox.Show(" 生成NDEF纯文本标签数据缓冲成功，可以向缓冲区继续添加记录，也可以将缓冲区内数据写标签。", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
End Sub
Private Sub Button15_Click(sender As Object, e As EventArgs) Handles Button15.Click
Dim status As Byte
Dim languagecodestr As String = "en" '语言编码，英文为en,中文为zh
Dim languagecodestrlen As Integer = languagecodestr.Length
Dim titlestr As String = textBox4.Text.Trim '标题
Dim titlestrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(titlestr).Length '标题长度
Dim uriheaderindex As Integer = comboBox1.SelectedIndex '前缀
Dim uristr As String = textBox5.Text.Trim 'uri
Dim uristrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(uristr).Length 'uri长度
status = tagbuf_adduri(languagecodestr, languagecodestrlen, titlestr, titlestrlen, uriheaderindex, uristr, uristrlen) '可以用此方法写入多条记录到数据缓冲
If status <> 0 Then
MessageBox.Show("生成NDEF智能海报数据缓冲时返回码错误代码:" + status, "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
MessageBox.Show(" 生成NDEF智能海报数据缓冲成功，可以向缓冲区继续添加记录，也可以将缓冲区内数据写标签。", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
End Sub
Private Sub Button16_Click(sender As Object, e As EventArgs) Handles Button16.Click
Dim status As Byte
Dim languagecodestr As String = "en" '语言编码，英文为en,中文为zh
Dim languagecodestrlen As Integer = languagecodestr.Length
Dim titlestr As String = textBox7.Text.Trim '标题
Dim titlestrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(titlestr).Length '标题长度
Dim uriheaderindex As Integer = 0 '地理位置没有链接前缀
Dim uristr As String = "geo:" + textBox6.Text.Trim + "," + textBox8.Text.Trim 'uri
Dim uristrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(uristr).Length 'uri长度
status = tagbuf_adduri(languagecodestr, languagecodestrlen, titlestr, titlestrlen, uriheaderindex, uristr, uristrlen) '可以用此方法写入多条记录到数据缓冲
If status <> 0 Then
MessageBox.Show("生成NDEF地图坐标数据缓冲时返回码错误代码:" + status, "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
MessageBox.Show(" 生成NDEF地图坐标数据缓冲成功，可以向缓冲区继续添加记录，也可以将缓冲区内数据写标签。", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
End Sub
Private Sub Button17_Click(sender As Object, e As EventArgs) Handles Button17.Click
Dim status As Byte
Dim languagecodestr As String = "en" '语言编码，英文为en,中文为zh
Dim languagecodestrlen As Integer = languagecodestr.Length
Dim titlestr As String = "" '标题
Dim titlestrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(titlestr).Length '标题长度
Dim uriheaderindex As Integer = 5 '呼叫电话的链接前缀为5
Dim uristr As String = textBox9.Text.Trim 'uri呼叫电话
Dim uristrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(uristr).Length 'uri长度
status = tagbuf_adduri(languagecodestr, languagecodestrlen, titlestr, titlestrlen, uriheaderindex, uristr, uristrlen) '可以用此方法写入多条记录到数据缓冲
If status <> 0 Then
MessageBox.Show("生成NDEF呼叫电话数据缓冲时返回码错误代码:" + status, "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
MessageBox.Show(" 生成NDEF呼叫电话数据缓冲成功，可以向缓冲区继续添加记录，也可以将缓冲区内数据写标签。", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
End Sub
Private Sub Button18_Click(sender As Object, e As EventArgs) Handles Button18.Click
Dim status As Byte
Dim infostr As String = "BEGIN:VCARD" & Chr(10) '
infostr = infostr + "VERSION:3.0" & Chr(10)
infostr = infostr + "FN:" + textBox12.Text.Trim() & Chr(10) '姓名
infostr = infostr + "TEL:" + textBox11.Text.Trim() & Chr(10) '电话
infostr = infostr + "ORG:" + textBox10.Text.Trim() & Chr(10) '单位名称
infostr = infostr + "ADR:" + textBox15.Text.Trim() & Chr(10) '地址
infostr = infostr + "EMAIL:" + textBox13.Text.Trim() & Chr(10) '邮箱
infostr = infostr + "URL:" + textBox14.Text.Trim() & Chr(10) '官网
infostr = infostr + "END:VCARD" & Chr(10)
Dim infostrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(infostr).Length '名片长度
status = tagbuf_addbusinesscard(infostr, infostrlen) '可以用此方法写入多条记录到数据缓冲
If status <> 0 Then
MessageBox.Show("生成NDEF电子名片数据缓冲时返回码错误代码:" + status, "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
MessageBox.Show(" 生成NDEF电子名片数据缓冲成功，可以向缓冲区继续添加记录，也可以将缓冲区内数据写标签。", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
End Sub
Private Sub Button19_Click(sender As Object, e As EventArgs) Handles Button19.Click
Dim status As Byte
Dim ssidstr As String = textBox16.Text.Trim '热点名称
Dim ssidstrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(ssidstr).Length '热点名称长度
Dim authtype As Integer = comboBox2.SelectedIndex '认证方式
Dim crypttype As Integer = comboBox3.SelectedIndex '加密算法
Dim keystr As String = textBox17.Text.Trim '密码
Dim keystrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(keystr).Length '密码长度
status = tagbuf_addwifi(ssidstr, ssidstrlen, authtype, crypttype, keystr, keystrlen) '可以用此方法写入多条记录到数据缓冲
If status <> 0 Then
MessageBox.Show("生成WIFI无线连接数据缓冲时返回码错误代码:" + status, "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
MessageBox.Show(" 生成WIFI无线连接数据缓冲成功，可以向缓冲区继续添加记录，也可以将缓冲区内数据写标签。", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
End Sub
Private Sub Button20_Click(sender As Object, e As EventArgs) Handles Button20.Click
Dim status As Byte
Dim blenamestr As String = textBox19.Text.Trim '设备名称
Dim blenamestrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(blenamestr).Length '设备名称长度
Dim macstr() As String = Split(textBox18.Text.Trim, ":")
Dim macbuf(0 To 5) As Byte
Try
macbuf(0) = "&H" & macstr(0)
macbuf(1) = "&H" & macstr(1)
macbuf(2) = "&H" & macstr(2)
macbuf(3) = "&H" & macstr(3)
macbuf(4) = "&H" & macstr(4)
macbuf(5) = "&H" & macstr(5)
Catch ex As Exception
MessageBox.Show("蓝牙设备的MAC地址输入错误，请输入正确的MAC地址！", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
textBox18.Select()
End Try
status = tagbuf_addbluetooth(blenamestr, blenamestrlen, macbuf(0)) '可以用此方法写入多条记录到数据缓冲
If status <> 0 Then
MessageBox.Show("生成NDEF蓝牙连接数据缓冲时返回码错误代码:" + status, "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
MessageBox.Show(" 生成NDEF蓝牙连接数据缓冲成功，可以向缓冲区继续添加记录，也可以将缓冲区内数据写标签。", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
End Sub
Private Sub Button21_Click(sender As Object, e As EventArgs) Handles Button21.Click
Dim status As Byte
Dim packagestr As String = textBox20.Text.Trim 'APP名称
Dim packagestrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(packagestr).Length 'APP名称长度
status = tagbuf_addapp(packagestr, packagestrlen) '可以用此方法写入多条记录到数据缓冲
If status <> 0 Then
MessageBox.Show("生成NDEF启动应用数据缓冲时返回码错误代码:" + status, "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
MessageBox.Show(" 生成NDEF启动应用数据缓冲成功，可以向缓冲区继续添加记录，也可以将缓冲区内数据写标签。", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
End Sub
Private Sub Button22_Click(sender As Object, e As EventArgs) Handles Button22.Click
Dim status As Byte
Dim typestr As String = textBox2.Text.Trim '数据类型
Dim typestrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(typestr).Length '数据类型长度
Dim datastr As String = textBox3.Text.Trim '数据
Dim datastrlen As Integer = System.Text.Encoding.GetEncoding(936).GetBytes(datastr).Length '数据长度
status = tagbuf_adddata(typestr, typestrlen, datastr, datastrlen) '可以用此方法写入多条记录到数据缓冲
If status <> 0 Then
MessageBox.Show("生成NDEF数据标签缓冲时返回码错误代码:" + status, "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
MessageBox.Show(" 生成NDEF数据标签缓冲成功，可以向缓冲区继续添加记录，也可以将缓冲区内数据写标签。", "示例提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
End Sub
Private Sub disperrinf(ByVal errcode As Byte)
Select Case errcode
Case 1
MessageBox.Show("错误代码：" + errcode.ToString() + "，0~2块都没读出来，可能刷卡太块。但卡序列号已被读出来！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case 2
MessageBox.Show("错误代码：" + errcode.ToString() + "，第0块已被读出，但1~2块读取失败。卡序列号已被读出来！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case 3
MessageBox.Show("错误代码：" + errcode.ToString() + "，第0、1块已被读出，但2块读取失败。卡序列号已被读出来！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case 8
MessageBox.Show("错误代码：" + errcode.ToString() + "，未寻到卡,请重新拿开卡后再放到感应区！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case 9
MessageBox.Show("错误代码：" + errcode.ToString() + "，寻卡过程中防冲突失败，读序列吗错误！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case 10
MessageBox.Show("错误代码：" + errcode.ToString() + "，该卡可能已被休眠，无法选中卡片！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case 11
MessageBox.Show("错误代码：" + errcode.ToString() + "，密码装载失败！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case 12
MessageBox.Show("错误代码：" + errcode.ToString() + "，标签密码认证错误！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case 13
MessageBox.Show("错误代码：" + errcode.ToString() + "，读标签失败，原因是刷卡太快或本块所对应的区还没通过密码认证！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case 14
MessageBox.Show("错误代码：" + errcode.ToString() + "，写标签失败，可能需要验证密码！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case 21
MessageBox.Show("错误代码：" + errcode.ToString() + "，没有动态库！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case 22
MessageBox.Show("错误代码：" + errcode.ToString() + "，动态库或驱动程序异常！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case 23
MessageBox.Show("错误代码：" + errcode.ToString() + "，未检测到发卡器！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case 24
MessageBox.Show("错误代码：" + errcode.ToString() + "，操作超时，一般是动态库没有反映！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case 25
MessageBox.Show("错误代码：" + errcode.ToString() + "，发送字数不够！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case 26
MessageBox.Show("错误代码：" + errcode.ToString() + "，发送的CRC错！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case 27
MessageBox.Show("错误代码：" + errcode.ToString() + "，接收的字数不够！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case 28
MessageBox.Show("错误代码：" + errcode.ToString() + "，接收的CRC错！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case 45
MessageBox.Show("错误代码：" + errcode.ToString() + "，此卡不支持更改UID号或UID块已被锁定！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case 46
MessageBox.Show("错误代码：" + errcode.ToString() + "，标签存储空间不足！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case 254
MessageBox.Show("错误代码：" + errcode.ToString() + "，标签存储空间不足！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
Case Else
MessageBox.Show("错误代码：" + errcode.ToString() + "，未知错误！", "Note:", MessageBoxButtons.OK, MessageBoxIcon.Stop)
End Select
End Sub
End Class
