本示例使用的发卡器https://item.taobao.com/item.htm?spma21dvs.23580594.0.0.47b32c1bLvwg0dfttid615391857885一、寻找发卡器上的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