rfidctrl.ctl

这个是我们为烟草行业出厂管理编写的RFID读写软件

            Call PDTRACELOG(1, "000-RFIDCtrl", "------In ReadIDs" & "|读取控制信息时发生错误：" & ErrorDesc)
            GoTo ErrDeal
        End If
        Call PDTRACELOG(3, "000-RFIDCtrl", "------In ReadIDs" & "|读取控制信息成功")
    Else
        Call PDTRACELOG(3, "000-RFIDCtrl", "------In ReadIDs" & "|不需要读取标签中的控制信息")
    End If
    
    '根据读取到的数据设置相应的返回值。将返回值设置为TRUE。
    ReadIDs = True
    Call PDTRACELOG(2, "000-RFIDCtrl", "------Out ReadIDs")
Exit Function
ErrDeal:
    '将返回值设置为FALSE
    ErrorDesc = ErrorDesc & Err.Description
    IDs = ""
    ReadIDs = False
    Call PDTRACELOG(1, "000-RFIDCtrl", "------In ReadIDs" & "|发生错误：" & ErrorDesc)
    Call PDTRACELOG(2, "000-RFIDCtrl", "------Out ReadIDs(1)")
End Function

'**********************************************************
'根据需要读取电子标签中的数据。
'   输入:   标签ID号，数据开始位，要读取的长度
'   输出：  成功与否标志，读取到的数据,错误描述。
'   data数组的赋值将从下标零开始
'**********************************************************
Public Function ReadRawData(TagID As String, StartPos As Long, ReqLen As Long, ByRef data() As Byte, ErrorDesc As String) As Boolean
    On Error GoTo ErrDeal
    Call PDTRACELOG(2, "000-RFIDCtrl", "------In ReadRawData")
    Dim RetData(7) As Byte
    
    '判断标签ID是否合法，如不合法，跳转到ErrDeal。
    If Not IDIslegal(TagID, ErrorDesc) Then
        ErrorDesc = "标签ID" & TagID & "不合法"
        Call PDTRACELOG(1, "000-RFIDCtrl", "------In ReadRawData" & "|标签ID" & TagID & "不合法")
        GoTo ErrDeal
    End If
    
    '判断数据开始位和读取长度是否合法，如不合法，跳转到ErrDeal。
    '用户数据起始地址；（8-223）
    If StartPos < 8 Or StartPos > 223 Then
        ErrorDesc = "起始位置:" & StartPos & "不正确（应该在8-223之间）"
        Call PDTRACELOG(1, "000-RFIDCtrl", "------In ReadRawData" & "|起始位置:" & StartPos & "不正确（应该在8-223之间）")
        GoTo ErrDeal
    End If
    
'    If (StartPos + ReqLen) > 224 Then
'        ErrorDesc = ""
'        Call PDTRACELOG(1, "000-RFIDCtrl", "------in ReadRawData" & "|起始位置")
'        GoTo ErrDeal
'    End If

    '计算需要读取的次数（每次读取8个字节）
    Dim times As Integer
    times = Int(ReqLen / 8)
    If ReqLen Mod 8 <> 0 Then
        times = times + 1
    End If
    Call PDTRACELOG(3, "000-RFIDCtrl", "------In ReadRawData" & "|读取的次数:" & times)
    
    '发送读取指定ID的电子标签数据的命令。
    Dim tt As Integer
    Dim i As Integer
    
    Dim temp(7) As Byte
    Call StringToByteArray(TagID, temp)

    Dim rawdata() As Byte
    ReDim rawdata(ReqLen - 1) As Byte
    
    Dim Index As Integer
    Call PDTRACELOG(3, "000-RFIDCtrl", "------In ReadRawData" & "|根据次数，发送XCReadUserData指令")
    Sleep InnerMinCmdInterval
    For Index = 1 To times
'        Sleep InnerMinCmdInterval
        PrintDetailInfo "ReadRawData|XCReadUserData"
        aStatus = XCReadUserData(hCom, 0, StartPos + (Index - 1) * 8, 8, temp(0), RetData(0))
        PrintDetailInfo "ReadRawData|XCReadUserData()"

        Call PDTRACELOG(3, "000-RFIDCtrl", "------In ReadRawData" & "|hCom = " & hCom)
'________________________________________________
'        aStatus = 1            '无设备时调试使用
'        Dim bb As Integer
'        For bb = 0 To 7
'            RetData(bb) = bb + (Index - 1) * 8
'        Next
'________________________________________________
        If aStatus > 0 Then
            '成功
            Call PDTRACELOG(3, "000-RFIDCtrl", "------In ReadRawData" & "|aStatus=" & aStatus & "(读取成功)")
        Else
            '读取失败
            ErrorDesc = "读取失败,aStatus=" & aStatus
            Call PDTRACELOG(1, "000-RFIDCtrl", "------In ReadRawData" & "|aStatus=" & aStatus & "(0-接收数据错；3-读标签ID失败；2-没有应答信息，或其他错)")
            GoTo ErrDeal
        End If
    
        If Index = times And (ReqLen Mod 8) <> 0 Then
            tt = ReqLen Mod 8
        Else
            tt = 8
        End If
        
        For i = 1 To tt
            rawdata((Index - 1) * 8 + i - 1) = RetData(i - 1)
        Next
        
    Next
    Call PDTRACELOG(3, "000-RFIDCtrl", "------In ReadRawData" & "|读取原始数据完成")
    
    '将返回值设置为TRUE。
    data = rawdata
    ReadRawData = True
    Call PDTRACELOG(2, "000-RFIDCtrl", "------Out ReadRawData")
Exit Function
ErrDeal:
    '将返回值设置为FALSE
    ErrorDesc = ErrorDesc & Err.Description
    ReadRawData = False
    Call PDTRACELOG(1, "000-RFIDCtrl", "------In ReadRawData" & "|发生错误：" & ErrorDesc)
    Call PDTRACELOG(2, "000-RFIDCtrl", "------Out ReadRawData(1)")
End Function

'**********************************************************
'根据需要读取电子标签中的条码字符串。
'   输入:   标签ID号，
'   输出：  成功与否标志，读取到的条码字符串,错误描述。
'**********************************************************
Public Function ReadCode(TagID As String, Code As String, ErrorDesc As String) As Boolean
    On Error GoTo ErrorDeal
    Call PDTRACELOG(2, "000-RFIDCtrl", "------In ReadCode")
    
    '前两个字节temp(0),temp(1)表示电子标签中存储的所有有效字节长度，包括长度本身和CRC校验。
    Dim data() As Byte
    Dim Length As Long
    
    '先读取第一、第二个字节，以决定长度
    '    ========================
    '    判断数据开始位和读取长度是否合法，如不合法，跳转到ErrDeal。
    '    用户数据起始地址；（8-223）
    '    指定读数据的长度=8;8个字节
    '    ========================
    Dim Succeed As Boolean
    
    '读取长度
    Succeed = ReadKeyInfo(TagID, ErrorDesc)
    If Not Succeed Then
        Call PDTRACELOG(1, "000-RFIDCtrl", "------In ReadCode" & "|无法读取长度信息," & ErrorDesc)
        GoTo ErrorDeal
    End If
    
    Length = CodeLength

    '若长度为6，则确认标签携带0个条码，返回成功并退出
    
    '读取原始数据
    Call PDTRACELOG(3, "000-RFIDCtrl", "------In ReadCode" & "|开始读取原始数据，长度为：" & Length)
    Succeed = ReadRawData(TagID, 8, Length, data, ErrorDesc)
'___________________________________________________________________
'    Succeed = True    '无设备时调试使用
'
'    ReDim data(Length - 1) As Byte
'    data(0) = 20
'    data(1) = 0
'    data(2) = 0
'    data(3) = 0
'    data(4) = 5
'    data(5) = 212
'    data(6) = 111
'    data(7) = 111
'    data(8) = 0
'    data(9) = 1
'    data(10) = 2
'    data(11) = 3
'    data(12) = 4
'    data(13) = 5
'    data(14) = 6
'    data(15) = 7
'    data(16) = 8
'    data(17) = 9
'    data(18) = 94
'    data(19) = 195
'___________________________________________________________________

    If Not Succeed Then
        Call PDTRACELOG(1, "000-RFIDCtrl", "------In ReadCode" & "|无法读取电子标签中的原始数据," & ErrorDesc)
        GoTo ErrorDeal
    End If

    '根据CRC校验码做校验
    Call PDTRACELOG(3, "000-RFIDCtrl", "------In ReadCode" & "|开始做CRC校验错误")
    
    Dim Index As Integer
    Dim crc_pre() As Byte
    ReDim crc_pre(UBound(data) - 2) As Byte
    For Index = 0 To UBound(crc_pre)
        crc_pre(Index) = data(Index)
    Next
    Dim crc() As Byte
    crc = CRC16_2(crc_pre)

    If Not (crc(0) = data(Length - 1) And crc(1) = data(Length - 2)) Then
        Call PDTRACELOG(1, "000-RFIDCtrl", "------In ReadCode" & "|CRC校验，数据错误")
        GoTo ErrorDeal
    Else
        Call PDTRACELOG(3, "000-RFIDCtrl", "------In ReadCode" & "|CRC校验正确")
    End If
    
    '解压缩，返回条码字符串
    Call PDTRACELOG(3, "000-RFIDCtrl", "------In ReadCode" & "|开始解压缩数据")
    Dim code_temp() As Byte
    ReDim code_temp(UBound(data) - 8) As Byte
    For Index = 0 To UBound(data) - 8
        code_temp(Index) = data(6 + Index)
    Next
    
    Dim depress_data As String
    Succeed = ComDecompressBarcode1.Depress(code_temp, depress_data, ErrorDesc)
'___________________________________________________________________
'    Succeed = True     '无设备时调试使用
'    depress_data = "0123456111111110505050123456789"
'___________________________________________________________________
    If Not Succeed Then
        Call PDTRACELOG(1, "000-RFIDCtrl", "------In ReadCode" & "|解压数据时出错" & ErrorDesc)
        GoTo ErrorDeal
    Else
        Call PDTRACELOG(3, "000-RFIDCtrl", "------In ReadCode" & "|解压数据成功")
    End If
    
    Code = depress_data
    ReadCode = True
    Call PDTRACELOG(2, "000-RFIDCtrl", "------Out ReadCode")
Exit Function
ErrorDeal:

    ErrorDesc = ErrorDesc & Err.Description
    ReadCode = False
    Call PDTRACELOG(1, "000-RFIDCtrl", "------In ReadCode" & "|发生错误：" & ErrorDesc)
    Call PDTRACELOG(2, "000-RFIDCtrl", "------Out ReadCode(1)")
End Function

'***********************************************************
'根据需要，把数据写入电子标签，返回成功与否的标志。
'   输入:   电子标签ID，需要写入的数据、数据开始位、数据长度
'   输出：  成功与否标志,错误描述。
'   从Data数组的下标零开始写入
'***********************************************************
Public Function WriteRawData(TagID As String, data() As Byte, StartPos As Long, ReqLen As Long, ErrorDesc As String) As Boolean
    On Error GoTo ErrDeal
    Call PDTRACELOG(2, "000-RFIDCtrl", "------In WriteRawData")
    
    Dim Index As Integer
    
    '判断标签ID是否合法，如不合法，跳转到ErrDeal。
    If Not IDIslegal(TagID, ErrorDesc) Then
        ErrorDesc = "52" & "@" & "标签ID" & TagID & "不合法"
        Call PDTRACELOG(1, "000-RFIDCtrl", "------In WriteRawData" & "|标签ID" & TagID & "不合法")
        GoTo ErrDeal
    End If
    
    '*******************************************
    '判断数据、开始位置和数据长度的合法性。
    '如不合法，跳转到ErrDeal。
    '写入起始地址.（8-223）
    '写入的n个字节数据（n=1~4）
    '要写入的数据长度（1~4），缺省为1；
    '*******************************************
    If StartPos < 8 Or StartPos > 223 Then
        ErrorDesc = "起始位置:" & StartPos & "不正确（应该在8-223之间）"
        Call PDTRACELOG(1, "000-RFIDCtrl", "------In WriteRawData" & "|" & ErrorDesc)
        GoTo ErrDeal
    End If
    If ReqLen < 1 Or ReqLen > 216 Then
        ErrorDesc = "写入长度:" & ReqLen & "不正确（应该为1-216之间）"
        Call PDTRACELOG(1, "000-RFIDCtrl", "------In WriteRawData" & "|" & ErrorDesc)
        GoTo ErrDeal
    End If
    
    '发送写入数据的命令并等待反馈。
    Dim temp(7) As Byte
    Call StringToByteArray(TagID, temp)
    
    Dim RLen As Integer
    Dim times As Integer
    RLen = UBound(data) + 1
    times = Int(RLen / 4)
    If RLen Mod 4 <> 0 Then
        times = times + 1
    End If
    Call PDTRACELOG(3, "000-RFIDCtrl", "------In WriteRawData" & "|开始写入原始数据写入的次数为" & times)
     '开始写入，每次写入4个
    Dim tLen As Integer
    Dim i As Integer
    Sleep InnerMinCmdInterval
    For Index = 1 To times
        If Index = times And RLen Mod 4 <> 0 Then
            tLen = (RLen Mod 4)
        Else
            tLen = 4
        End If
        
        PrintDetailInfo "WriteRawData|XCWriteUserData"
        aStatus = XCWriteUserData(hCom, 0, StartPos + (Index - 1) * 4, temp(0), data((Index - 1) * 4), tLen)
        PrintDetailInfo "WriteRawData|XCWriteUserData()"
'___________________________________________________________________
'        aStatus = 1        '无设备时调试使用
'___________________________________________________________________
        If aStatus = 1 Then
            '成功
            Sleep InnerMinCmdInterval
            Call PDTRACELOG(3, "000-RFIDCtrl", "------In WriteRawData" & "|写入原始数据错误,aStatus = " & aStatus & "(写入成功)")
        Else
            '写入失败
            Call PDTRACELOG(1, "000-RFIDCtrl", "------In WriteRawData" & "|写入原始数据错误,aStatus = " & aStatus & "(0-接收数据错；3-读标签ID失败；2-其他错)")
            ErrorDesc = "53" & "@" & "写入失败" & "(写入原始数据的返回值 = " & aStatus & ")"
            GoTo ErrDeal
        End If
    Next
    Call PDTRACELOG(3, "000-RFIDCtrl", "------In WriteRawData" & "|结束写入原始数据")
  
    '把数据读出比较是否与写入的相同
    Call PDTRACELOG(3, "000-RFIDCtrl", "------In WriteRawData" & "|开始比较读出数据是否与写入的相同")
    Dim temp_read() As Byte
    If ReadRawData(TagID, StartPos, ReqLen, temp_read, ErrorDesc) Then
'_____________________________________________________
'        Dim tempb1 As String           '调试用
'        Dim tempb2 As String
'        tempb1 = ByteToString(data)
'        tempb2 = ByteToString(temp_read)
'_____________________________________________________
        For Index = 1 To ReqLen
            If Not temp_read(Index - 1) = data(Index - 1) Then
                Call PDTRACELOG(1, "000-RFIDCtrl", "------In WriteRawData" & "|读出数据与写入的不符!")
                Call PDTRACELOG(1, "000-RFIDCtrl", "------In WriteRawData" & "|TagID=(" & TagID & "),开始位=(" & StartPos & "),长度=(" & ReqLen & ")")
                Call PDTRACELOG(1, "000-RFIDCtrl", "------In WriteRawData" & "|写入数据:(" & ByteToString(data) & ")")