rfidctrl.ctl

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

                Call PDTRACELOG(1, "000-RFIDCtrl", "------In WriteRawData" & "|读出数据:(" & ByteToString(temp_read) & ")")
                ErrorDesc = "55" & "@" & "读出数据与写入的不符"
                GoTo ErrDeal
            End If
        Next
    Else
        ErrorDesc = "54" & "@" & "写入后读出数据比较时，读出数据失败"
        Call PDTRACELOG(1, "000-RFIDCtrl", "------In WriteRawData" & "|写入后读出数据比较时，读出数据失败")
        GoTo ErrDeal
    End If

    '将返回值设置为TRUE。
    WriteRawData = True
    Call PDTRACELOG(2, "000-RFIDCtrl", "------Out WriteRawData")
Exit Function
ErrDeal:
    '将返回值设置为FALSE
    ErrorDesc = ErrorDesc & Err.Description
    WriteRawData = False
    Call PDTRACELOG(1, "000-RFIDCtrl", "------In WriteRawData" & "|发生错误：" & ErrorDesc)
    Call PDTRACELOG(2, "000-RFIDCtrl", "------Out WriteRawData(1)")
End Function

'***********************************************************
'根据需要，把数据写入电子标签，返回成功与否的标志。
'   输入:   电子标签ID，与关联关系数据库数据一致性标志,需要写入的条码字符串
'   输出：  成功与否标志,错误描述。
'***********************************************************
Public Function WriteCode(TagID As String, Synchronized As Boolean, CodeStr As String, ErrorDesc As String) As Boolean
    On Error GoTo ErrDeal
    Call PDTRACELOG(2, "000-RFIDCtrl", "------In WriteCode")
    
    '压缩条码字符串
    Call PDTRACELOG(3, "000-RFIDCtrl", "------In WriteCode" & "|开始压缩条码字符串")
    Call PDTRACELOG(1, "000-RFIDCtrl", "------In WriteCode" & "|条码字符串:(" & CodeStr & ")")
    Dim compress_data() As Byte
    Dim Succeed As Boolean

    Succeed = ComDecompressBarcode1.Compress(CodeStr, compress_data, ErrorDesc)
'_____________________________________________________________________________________
'    Succeed = True     '无设备时调试使用
'    Dim bb As Integer
'    ReDim compress_data(20) As Byte
'    For bb = 0 To 20
'        compress_data(bb) = bb
'    Next
'_____________________________________________________________________________________
    If Not Succeed Then
        Call PDTRACELOG(1, "000-RFIDCtrl", "------In WriteCode" & "|压缩数据时出错:" & ErrorDesc)
        ErrorDesc = "71" & "@" & ErrorDesc
        GoTo ErrDeal
    Else
        Call PDTRACELOG(3, "000-RFIDCtrl", "------In WriteCode" & "|压缩数据成功")
    End If
    
    Call PDTRACELOG(3, "000-RFIDCtrl", "------In WriteCode" & "|开始填充需要写入电子标签的byte数据")
    Dim Index As Integer
    Dim temp() As Byte
    ReDim temp(UBound(compress_data) + 8) As Byte
    '前两个字节temp(0),temp(1)表示电子标签中存储的所有有效字节长度，包括长度本身和CRC校验。
    If UBound(compress_data) + 8 + 1 > 255 Then
        temp(1) = Int((UBound(compress_data) + 8 + 1) / 256)
        temp(0) = UBound(compress_data) + 8 + 1 - Int((UBound(compress_data) + 8 + 1) / 256) * 256
    Else
        temp(1) = &H0
        temp(0) = UBound(compress_data) + 8 + 1
    End If
    '填充控制字和CRC校验码
    temp(2) = &H0
    If Synchronized Then
        temp(3) = &H80 '10000000b
    Else
        temp(3) = &H0
    End If
    
    Dim len_and_ctrl(3) As Byte
    len_and_ctrl(0) = temp(0)
    len_and_ctrl(1) = temp(1)
    len_and_ctrl(2) = temp(2)
    len_and_ctrl(3) = temp(3)
    Dim crc0() As Byte
    crc0 = CRC16_2(len_and_ctrl)
    temp(4) = crc0(1)
    temp(5) = crc0(0)
    
    '填充条码压缩后的数据
    For Index = 6 To UBound(temp) - 2
        temp(Index) = compress_data(Index - 6)
    Next
    
    '计算校验字
    Dim crc_pre() As Byte
    ReDim crc_pre(UBound(temp) - 2) As Byte
    For Index = 0 To UBound(crc_pre)
        crc_pre(Index) = temp(Index)
    Next
    Dim crc() As Byte
    crc = CRC16_2(crc_pre)
    'CRC16校验码，顺序为：低字节，高字节。
    '    ReturnData(0) = CRC16Hi        'CRC高位
    '    ReturnData(1) = CRC16Lo        'CRC低位
    temp(UBound(temp) - 1) = crc(1)
    temp(UBound(temp)) = crc(0)
    
    Call PDTRACELOG(3, "000-RFIDCtrl", "------In WriteCode" & "|完成填充需要写入电子标签的byte数据")
    
    '写入全部数据,temp
    '===========================
    '判断数据、开始位置和数据长度的合法性。
    '如不合法，跳转到ErrDeal。
    '写入起始地址.（8-223）
    '写入的n个字节数据（n=1~4）
    '要写入的数据长度（1~4），缺省为1；
    '===========================
    Dim RLen As Long
    RLen = UBound(temp) + 1
    
    '写入数据
    Call PDTRACELOG(3, "000-RFIDCtrl", "------In WriteCode" & "|开始写入原始数据")
    Succeed = WriteRawData(TagID, temp, 8, RLen, ErrorDesc)
    If Not Succeed Then
        Call PDTRACELOG(1, "000-RFIDCtrl", "------In WriteCode" & "|写入原始数据失败," & ErrorDesc)
        GoTo ErrDeal
    Else
        Call PDTRACELOG(3, "000-RFIDCtrl", "------In WriteCode" & "|成功写入原始数据")
    End If
    WriteCode = True
    Call PDTRACELOG(2, "000-RFIDCtrl", "------Out WriteCode")
Exit Function
ErrDeal:
    ErrorDesc = ErrorDesc & Err.Description
    WriteCode = False
    Call PDTRACELOG(1, "000-RFIDCtrl", "------In WriteCode" & "|字符串：(" & CodeStr & "),发生错误：" & ErrorDesc)
    Call PDTRACELOG(2, "000-RFIDCtrl", "------Out WriteCode(1)")
End Function

'**********************************************************
'清除电子标签中的数据。
'   输入:   电子标签ID,与关联关系数据库数据一致性标志
'   输出：  成功与否标志，错误描述
'**********************************************************
Public Function ClearTag(TagID As String, Synchronized As Boolean, ErrorDesc As String) As Boolean
    '处理方式同WriteCode.
    On Error GoTo ErrDeal
    Call PDTRACELOG(2, "000-RFIDCtrl", "------In ClearTag")
  
    Dim Succeed As Boolean
    Dim Index As Integer
    
    Call PDTRACELOG(3, "000-RFIDCtrl", "------In ClearTag" & "|开始填充需要写入电子标签的byte数据")
    Dim temp() As Byte
    ReDim temp(215) As Byte
    '前两个字节temp(0),temp(1)表示电子标签中存储的所有有效字节长度，包括长度本身和CRC校验。

    '填充控制字和CRC校验码
    temp(0) = 216
    temp(1) = 0
    temp(2) = &H0
    If Synchronized Then
        temp(3) = &H80 '10000000b
    Else
        temp(3) = &H0
    End If
    
    Dim len_and_ctrl(3) As Byte
    len_and_ctrl(0) = temp(0)
    len_and_ctrl(1) = temp(1)
    len_and_ctrl(2) = temp(2)
    len_and_ctrl(3) = temp(3)
    Dim crc0() As Byte
    crc0 = CRC16_2(len_and_ctrl)
    temp(4) = crc0(1)
    temp(5) = crc0(0)
    
    '填充清零条码的数据
    For Index = 6 To 213
        temp(Index) = 0
    Next
    
    '计算校验字
    Dim crc_pre() As Byte
    ReDim crc_pre(UBound(temp) - 2) As Byte
    For Index = 0 To UBound(crc_pre)
        crc_pre(Index) = temp(Index)
    Next
    Dim crc() As Byte
    crc = CRC16_2(crc_pre)
    'CRC16校验码，顺序为：低字节，高字节。
    '    ReturnData(0) = CRC16Hi        'CRC高位
    '    ReturnData(1) = CRC16Lo        'CRC低位
    temp(UBound(temp) - 1) = crc(1)
    temp(UBound(temp)) = crc(0)
    
    Call PDTRACELOG(3, "000-RFIDCtrl", "------In ClearTag" & "|成功填充需要写入电子标签的byte数据")
    
    '写入全部数据,temp
    '===========================
    '判断数据、开始位置和数据长度的合法性。
    '如不合法，跳转到ErrDeal。
    '写入起始地址.（8-223）
    '写入的n个字节数据（n=1~4）
    '要写入的数据长度（1~4），缺省为1；
    '===========================
    Dim RLen As Long
    RLen = UBound(temp) + 1

    '写入数据
    Call PDTRACELOG(3, "000-RFIDCtrl", "------In ClearTag" & "|开始写入原始数据")
    Succeed = WriteRawData(TagID, temp, 8, RLen, ErrorDesc)
'___________________________________________________________________
'    Succeed = True     '无设备时调试用
'___________________________________________________________________
    If Not Succeed Then
        Call PDTRACELOG(1, "000-RFIDCtrl", "------In ClearTag" & "|写入原始数据失败," & ErrorDesc)
        GoTo ErrDeal
    Else
        Call PDTRACELOG(3, "000-RFIDCtrl", "------In ClearTag" & "|成功写入原始数据")
    End If

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

'*********************************************************************
'根据需要获取RFID的当前状态。
'   输入:   无
'   输出：  成功与否标志，错误描述，设备状态值：0 设备Unready 1 设备Ready
'   （RFID设备暂时不支持）
'*********************************************************************
Public Function GetReaderStatus(ByRef status As Integer, ErrorDesc As String) As Boolean

    Call PDTRACELOG(2, "000-RFIDCtrl", "------In GetReaderStatus")
    ErrorDesc = "设备不支持此方法"
    GoTo ErrDeal
    
    On Error GoTo ErrDeal
    '发送取状态指令并等待反馈。

    '如超时，跳转到ErrDeal。

    '设置状态值。
    status = 1

    '将返回值设置为TRUE。
    GetReaderStatus = True
    Call PDTRACELOG(2, "000-RFIDCtrl", "------Out GetReaderStatus")
Exit Function
ErrDeal:
    '将返回值设置为FALSE
    ErrorDesc = ErrorDesc & Err.Description
    GetReaderStatus = False
    Call PDTRACELOG(1, "000-RFIDCtrl", "------In GetReaderStatus" & "|发生错误：" & ErrorDesc)
    Call PDTRACELOG(2, "000-RFIDCtrl", "------Out GetReaderStatus(1)")
End Function


Private Sub UserControl_Initialize()
    '在polling的使用记录读取到的ID号列表用
    ReDim IDInfos(0) As IDInfo
    NeedNextAlert = False
    CurState = StateClosed
End Sub

'*********************************************************
'和Container之间的属性交互
'*********************************************************
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    CurState = StateClosed
    
    InnerCommType = PropBag.ReadProperty("CommType", InnerCommType)
    InnerCommParam = PropBag.ReadProperty("CommParam", InnerCommParam)
'    InnerReaderSN = PropBag.ReadProperty("ReaderSN", InnerReaderSN)
    InnerAutoRead = PropBag.ReadProperty("AutoRead", InnerAutoRead)
    InnerReadCtrlInfoWhenCallingReadIDs = PropBag.ReadProperty("ReadCtrlInfoWhenCallingReadIDs", InnerReadCtrlInfoWhenCallingReadIDs)
'    InnerPollingInterval = PropBag.ReadProperty("PollingInterval", InnerPollingInterval)
'    InnerDispatchMethodWhenGetID = PropBag.ReadProperty("DispatchMethodWhenGetID", InnerDispatchMethodWhenGetID)
'    InnerSameIDinterval = PropBag.ReadProperty("SameIDinterval", InnerSameIDinterval)
'    InnerReaderResponseTimeout = PropBag.ReadProperty("ReaderResponseTimeout", InnerReaderResponseTimeout)
'    InnerLogLevel = PropBag.ReadProperty("LogLevel", InnerLogLevel)
'    InnerLogKeepDays = PropBag.ReadProperty("LogKeepDays", InnerLogKeepDays)
    
    InnerOtherParam = PropBag.ReadProperty("OtherParam", InnerOtherParam)
'    InnerLogPath = PropBag.ReadProperty("LogPath", InnerLogPath)
    
    InnerWorkingFolder = PropBag.ReadProperty("WorkingFolder", InnerWorkingFolder)

End Sub

'固定控件在设计的时候的尺寸大小
Private Sub UserControl_Resize()
    UserControl.Width = Picture1.Width
    UserControl.Height = Picture1.Height
End Sub

Private Sub UserControl_Terminate()
    '清除过期日志。
    Dim fs As Scripting.FileSystemObject
    If fs Is Nothing Then
        Set fs = New Scripting.FileSystemObject
    End If
    If fs.FolderExists(InnerLogPath) Then
        ClearLogFile
    End If
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    PropBag.WriteProperty "CommType", InnerCommType
    PropBag.WriteProperty "CommParam", InnerCommParam
    PropBag.WriteProperty "ReaderSN", InnerReaderSN
    PropBag.WriteProperty "AutoRead", InnerAutoRead
    PropBag.WriteProperty "ReadCtrlInfoWhenCallingReadIDs", InnerReadCtrlInfoWhenCallingReadIDs
 '   PropBag.WriteProperty "PollingInterval", InnerPollingInterval
 '   PropBag.WriteProperty "DispatchMethodWhenGetID", InnerDispatchMethodWhenGetID
 '   PropBag.WriteProperty "SameIDinterval", InnerSameIDinterval
 '   PropBag.WriteProperty "ReaderResponseTimeout", InnerReaderResponseTimeout
 '   PropBag.WriteProperty "LogLevel", InnerLogLevel
 '   PropBag.WriteProperty "LogKeepDays", InnerLogKeepDays
    
    PropBag.WriteProperty "OtherParam", InnerOtherParam
 '   PropBag.WriteProperty "LogPath", InnerLogPath
    
    PropBag.WriteProperty "WorkingFolder", InnerWorkingFolder
End Sub

'********************************************************************************
'根据RFID读写设备当前的工作情况，能够发出相应得信号给四色报警灯。
'**        ：