读写FM11RF005M标签Vb6源码

本示例使用的发卡器：https://item.taobao.com/item.htm?spm=a21dvs.23580594.0.0.47b32c1bLvwg0d&ft=t&id=615391857885

一、寻找发卡器上的FM11RF005M卡

vbnet 复制代码

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

二、认证卡片密钥

vbnet 复制代码

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

三、读取指定块数据

vbnet 复制代码

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

四、写数据到指定块

vbnet 复制代码

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

五、发送指令

vbnet 复制代码

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