本示例使用的发卡器：https://item.taobao.com/item.htm?spm=a21dvs.23580594.0.0.47b32c1bLvwg0d&ft=t&id=615391857885
一、寻找发卡器上的FM11RF005M卡
Dim i As Integer Dim sendnum As Integer Dim uidstr As String sendnum = 0 Do While sendnum < 2 BitFramingVal = 7 ChannelRedundancyVal = 3 sendbuf(0) = &H26 sendlen = 1 TimerFlagval = 4 If ShowPicccmd Then If revbuflen > 1 Then sendnum = 2 sendbuf(0) = &H93 sendbuf(1) = &H20 sendlen = 2 If ShowPicccmd Then If revbuflen = 1 And revbuf(0) = &HA Then BitFramingVal = 0 ChannelRedundancyVal = 15 sendbuf(0) = &H30 sendbuf(1) = &H1 sendlen = 2 If ShowPicccmd Then uidstr = "" For i = 0 To 3 uidbuf(i) = revbuf(i) uidstr = uidstr + Right("00" + Hex(revbuf(i)), 2) Next List1.Clear Text1.Text = uidstr List1.AddItem ("寻找到感应区内的卡，可以读取卡内00-07块的数据，UID：" + uidstr) List1.ListIndex = List1.ListCount - 1 End If End If End If End If Else sendnum = sendnum + 1 If sendnum = 2 Then List1.AddItem ("寻找到感应区内的卡片失败！") List1.ListIndex = List1.ListCount - 1 End If End If Loop二、认证卡片密钥
Dim infostr As String Dim keybuf(0 To 5) As Byte Dim status As Byte infostr = Trim(Text2.Text) If IsHexStr(infostr, 4, keybuf) Then keybuf(4) = &H0 keybuf(5) = &H0 infostr = Trim(Text1.Text) If IsHexStr(infostr, 4, uidbuf) Then status = piccauthkey1(uidbuf(0), 0, 1, keybuf(0)) If status = 0 Then List1.AddItem ("卡密钥认证成功，可以读所有块数据，可以写02-0F块数据！") List1.ListIndex = List1.ListCount - 1 Else DispErrinfo status End If End If End If三、读取指定块数据
Dim i As Integer Dim uidstr As String BitFramingVal = 0 ChannelRedundancyVal = 15 sendbuf(0) = &H30 sendbuf(1) = Combo1.ListIndex sendlen = 2 TimerFlagval = 4 If ShowPicccmd And revbuflen = 4 Then uidstr = "" For i = 0 To 3 uidbuf(i) = revbuf(i) uidstr = uidstr + Right("00" + Hex(revbuf(i)), 2) Next Text3.Text = uidstr List1.AddItem ("读取卡内数据成功，DATA：" + uidstr) List1.ListIndex = List1.ListCount - 1 Else List1.AddItem ("发送读卡指令后未接收到回应数据，请重新寻卡 或 先认证卡片密钥！") List1.ListIndex = List1.ListCount - 1 End If四、写数据到指定块
Dim i As Integer Dim infostr As String Dim databuf(0 To 3) As Byte infostr = Trim(Text3.Text) If IsHexStr(infostr, 4, databuf) Then BitFramingVal = 0 ChannelRedundancyVal = &H7 sendbuf(0) = &HA0 sendbuf(1) = Combo1.ListIndex sendlen = 2 TimerFlagval = 5 If ShowPicccmd And revbuf(0) = &HA Then For i = 0 To 3 sendbuf(i) = databuf(i) Next sendlen = 4 If ShowPicccmd And revbuf(0) = &HA Then List1.AddItem ("数据写入块内成功！") List1.ListIndex = List1.ListCount - 1 Else List1.AddItem ("发送写卡数据后返回错误代码：" + Format(revbuf(0), "0")) List1.ListIndex = List1.ListCount - 1 End If Else List1.AddItem ("发送写入指令后返回错误代码：" + Format(revbuf(0), "0")) List1.ListIndex = List1.ListCount - 1 End If Else List1.AddItem ("写卡数据输入错误，请输入8位16进制写卡数据！") List1.ListIndex = List1.ListCount - 1 End If五、发送指令
Function ShowPicccmd() As Boolean Dim status As Byte Dim shlval(0 To 7) As Byte status = picccmd(BitFramingVal, ChannelRedundancyVal, sendbuf(0), sendlen, revbuf(0), revbuflen, TimerFlagval) If status < 8 Then If (status > 0) And (revbuflen > 0) Then '最后一个字节仅有status位有效 shlval(7) = &H7F shlval(6) = &H3F shlval(5) = &H1F shlval(4) = &HF shlval(3) = &H7 shlval(2) = &H3 shlval(1) = &H1 revbuf(revbuflen - 1) = revbuf(revbuflen - 1) And shlval(status) End If ShowPicccmd = True Else ShowPicccmd = False End If End Function
