clscomm.cls

应用串口通讯, 获取产品信息, 并与SAMPLE信息比较, 自动判断产品是否合格

    sExportPath = Trim(sExportPath)
    If TypeName(m_ResultBytes) = "Empty" Then
        DisplayMsg "No bytes ever read from EEPROM !"
        Exit Sub
    End If
    
    On Error GoTo ExportToHex_Error
    lStartAddress = m_lStartAddress
    lEndAddress = m_lStartAddress + UBound(m_ResultBytes)
    
    DisplayMsg "Exporting to " & sExportPath & " (0x" & Hex(lStartAddress) & " - 0x" _
        & Hex(lEndAddress) & ")"
    
    ' make the hex file
    iFH = FreeFile
    Open sExportPath For Output As #iFH
    iCount = 16
    For lAddress = lStartAddress To lEndAddress Step 16
        If lAddress + 16 >= lEndAddress Then
            ' last rec indicator
            bRecIndicator = True
            iCount = lEndAddress - lAddress + 1
        End If
        
        ' write the line
        sLine = ":" & FormatHex(iCount) & FormatHex(lAddress, , 4) & "00"
        For i = 0 To iCount - 1
            sLine = sLine & FormatHex(m_ResultBytes(lAddress + i))
        Next
        'checksum
        sLine = sLine & oIntelHex.CalcCheckSum(sLine)
        Print #iFH, sLine
        
        If bRecIndicator Then
            Print #iFH, ":00000001FF"
            Exit For
        End If
    Next
    
    Close #iFH
    iFH = 0
    
    DisplayMsg "Export successful"
    
ExportToHex_Error:
    If Err <> 0 Then DisplayMsg "Invalid format"
    On Error GoTo 0
    If iFH > 0 Then Close #iFH
    
End Sub

Public Function CheckVersion() As Boolean
Dim aBytes As Variant, iSystem As Byte, bResult As Boolean, sVersion As String
Dim iLen As Integer, i As Integer, iTrial As Integer

    If Not m_oComm.PortOpen Then
        ' com port not opened
        DisplayMsg "Com port not opened !"
        Exit Function
    End If
    
    If Not m_bConnected Then
        ' not connected
        DisplayMsg "UUT not connected !"
        Exit Function
    End If

    Select Case UCase(m_sSystem)
    Case "FP"   'FP
        iSystem = &H38
    Case "PP"   'PP
        iSystem = &H78
    End Select

    DisplayMsg "Check firmware version"
    
    ReDim aBytes(0 To 4) As Byte
    aBytes(0) = &HF0
    aBytes(1) = iSystem
    aBytes(2) = UBound(aBytes) + 1
    aBytes(3) = &H1A
    aBytes(4) = &HD
    
    bResult = False
    For iTrial = 1 To m_iMaxTrialCount
        SendBytes aBytes
        If ReadBytes(100, &HD) Then
            If m_ResultBytes(1) = aBytes(1) - &H10 Then bResult = True
        End If
        If bResult Then Exit For
    Next
    
    If Not bResult Then
        DisplayMsg "Invalid reply"
    Else
        iLen = CInt(m_ResultBytes(2)) - 5
        For i = 1 To iLen
            sVersion = sVersion & Chr(m_ResultBytes(i + 3))
        Next
        DisplayMsg sVersion
        m_ResultHexStr = sVersion
    End If
    
    CheckVersion = bResult

End Function

Public Function ResetByWatchdog() As Boolean
Dim aBytes As Variant, iSystem As Byte, bResult As Boolean
Dim iLen As Integer, i As Integer, iTrial As Integer

    If Not m_oComm.PortOpen Then
        ' com port not opened
        DisplayMsg "Com port not opened !"
        Exit Function
    End If
    
    If Not m_bConnected Then
        ' not connected
        DisplayMsg "UUT not connected !"
        Exit Function
    End If

    Select Case UCase(m_sSystem)
    Case "FP"   'FP
        iSystem = &H38
    Case "PP"   'PP
        iSystem = &H78
    End Select

    DisplayMsg "Watchdog reset (no stack)"
    
    ReDim aBytes(0 To 5) As Byte
    aBytes(0) = &HF0
    aBytes(1) = iSystem
    aBytes(2) = UBound(aBytes) + 1
    aBytes(3) = &H18
    aBytes(4) = 0
    aBytes(5) = &HD
    
    bResult = False
    For iTrial = 1 To m_iMaxTrialCount
        SendBytes aBytes
        If ReadBytes(6, &HD) Then
            If m_ResultBytes(1) = aBytes(1) - &H10 Then bResult = True
        End If
        If bResult Then Exit For
    Next
    
    If Not bResult Then
        DisplayMsg "Invalid reply"
    Else
        DisplayMsg "Reset ack received"
    End If
    
    ResetByWatchdog = bResult
End Function

'Allow format of sParam :
'1. <id> which is a numeric number
'2. off
Public Function Buzzer(sParam As String) As Boolean
Dim aBytes As Variant, iSystem As Byte, bResult As Boolean, bOn As Boolean
Dim iLen As Integer, i As Integer, aParams As Variant, iTrial As Integer

    If Not m_oComm.PortOpen Then
        ' com port not opened
        DisplayMsg "Com port not opened !"
        Exit Function
    End If
    
    If Not m_bConnected Then
        ' not connected
        DisplayMsg "UUT not connected !"
        Exit Function
    End If

    ' extract command
    aParams = Split(sParam)
    If UBound(aParams) = -1 Then
        DisplayMsg "Invalid command"
        Exit Function
    End If
    
    Select Case LCase(Left(aParams(0), 1))
    Case "0" To "9" ' pattern ID
        bOn = True
        m_iLastBuzzerID = CInt(aParams(0))
    Case "o"    ' turn off buzzer
        bOn = False
    Case Else
        DisplayMsg "Invalid command"
        Exit Function
    End Select
    
    Select Case UCase(m_sSystem)
    Case "FP"   'FP
        iSystem = &H38
    Case "PP"   'PP
        iSystem = &H78
    End Select

    DisplayMsg "Buzzer command"
    
    ReDim aBytes(0 To 6) As Byte
    aBytes(0) = &HF0
    aBytes(1) = iSystem
    aBytes(2) = UBound(aBytes) + 1
    aBytes(3) = &H10
    aBytes(4) = IIf(bOn, 1, 0)
    aBytes(5) = CByte(m_iLastBuzzerID)
    aBytes(6) = &HD
    
    bResult = False
    For iTrial = 1 To m_iMaxTrialCount
        SendBytes aBytes
        If ReadBytes(6, &HD) Then
            If m_ResultBytes(1) = aBytes(1) - &H10 Then bResult = True
        End If
        If bResult Then Exit For
    Next
    
    If Not bResult Then
        DisplayMsg "Invalid reply"
    Else
        If bOn Then
            DisplayMsg "Buzzer pattern " & m_iLastBuzzerID & " on"
        Else
            DisplayMsg "Buzzer off"
        End If
    End If
    
    Buzzer = bResult
End Function

Public Function SendHexCommand(ByVal sParam As String) As Boolean
Dim aBytes As Variant, iSystem As Byte, bResult As Boolean, sVersion As String
Dim iLen As Integer, i As Integer, iTrial As Integer

    If Not m_oComm.PortOpen Then
        ' com port not opened
        DisplayMsg "Com port not opened !"
        Exit Function
    End If
    
    If Not m_bConnected Then
        ' not connected
        DisplayMsg "UUT not connected !"
        Exit Function
    End If

    Select Case UCase(m_sSystem)
    Case "FP"   'FP
        iSystem = &H38
    Case "PP"   'PP
        iSystem = &H78
    End Select

    DisplayMsg "Send hex str: " & sParam
    
    For iTrial = 1 To m_iMaxTrialCount
        aBytes = SendHex(sParam)
        
        ReadBytes 1024, , 1
        If TypeName(m_ResultBytes) <> "Empty" Then
            If m_ResultBytes(1) = aBytes(1) - &H10 Then bResult = True
        End If
        If bResult Then Exit For
    Next
    
    If Not bResult Then
        DisplayMsg "Invalid reply"
    Else
        DisplayMsg "Hex string Sent"
    End If
End Function

Public Function ClearRegistration() As Boolean
Dim aBytes As Variant, iSystem As Byte, bResult As Boolean
Dim iLen As Integer, i As Integer, iTrial As Integer

    If Not m_oComm.PortOpen Then
        ' com port not opened
        DisplayMsg "Com port not opened !"
        Exit Function
    End If
    
    If Not m_bConnected Then
        ' not connected
        DisplayMsg "UUT not connected !"
        Exit Function
    End If

    Select Case UCase(m_sSystem)
    Case "FP"   'FP
        iSystem = &H38
    Case "PP"   'PP
        iSystem = &H78
    End Select

    DisplayMsg "Clear registration"
    
    ReDim aBytes(0 To 5) As Byte
    aBytes(0) = &HF0
    aBytes(1) = iSystem
    aBytes(2) = UBound(aBytes) + 1
    aBytes(3) = &H1E
    aBytes(4) = 0
    aBytes(5) = &HD
    
    bResult = False
    For iTrial = 1 To m_iMaxTrialCount
        SendBytes aBytes
        If ReadBytes(6, &HD) Then
            If m_ResultBytes(1) = aBytes(1) - &H10 Then bResult = True
        End If
        If bResult Then Exit For
    Next
    
    If Not bResult Then
        DisplayMsg "Invalid reply"
    Else
        DisplayMsg "Registration cleared"
    End If
    
    ClearRegistration = bResult
End Function

Public Function EnterTBR(ByVal iMode As Integer) As Boolean
Dim aBytes As Variant, iSystem As Byte, bResult As Boolean
Dim iLen As Integer, i As Integer, iTBRModeValue As Integer, iTrial As Integer

    If Not m_oComm.PortOpen Then
        ' com port not opened
        DisplayMsg "Com port not opened !"
        Exit Function
    End If
    
    If Not m_bConnected Then
        ' not connected
        DisplayMsg "UUT not connected !"
        Exit Function
    End If

    Select Case UCase(m_sSystem)
    Case "FP"   'FP
        iSystem = &H38
    Case "PP"   'PP
        iSystem = &H78
    End Select

    Select Case iMode
    Case 6
        iTBRModeValue = 1
    Case 10
        iTBRModeValue = 2
    End Select

    DisplayMsg "Enter TBR " & iMode
    
    ReDim aBytes(0 To 6) As Byte
    aBytes(0) = &HF0
    aBytes(1) = iSystem
    aBytes(2) = UBound(aBytes) + 1
    aBytes(3) = &H46
    aBytes(4) = iTBRModeValue
    aBytes(5) = 0
    aBytes(6) = &HD
    
    bResult = False
    
    For iTrial = 1 To m_iMaxTrialCount
        SendBytes aBytes
        If ReadBytes(6, &HD) Then
            If m_ResultBytes(1) = aBytes(1) - &H10 Then bResult = True
        End If
        If bResult Then Exit For
    Next
    
    If Not bResult Then
        DisplayMsg "Invalid reply"
    Else
        DisplayMsg "TBR " & iMode & " set"
    End If
    
    EnterTBR = bResult
End Function