clscomm.cls

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

Public Function Connect(ByVal sSystem As String) As Boolean
Dim sCmd As String, iTrial As Integer

    If Not m_oComm.PortOpen Then
        ' com port not opened
        DisplayMsg "Com port not opened !"
        Exit Function
    End If
    
    Select Case UCase(sSystem)
    Case "FP"   'FP
        sCmd = "30"
    Case "PP"   'PP
        sCmd = "70"
    Case Else
        DisplayMsg "Invalid system type !"
        Exit Function
    End Select
    
    m_sSystem = UCase(sSystem)
    
    DisplayMsg "Connect " & sSystem
    
    For iTrial = 1 To m_iMaxTrialCount
        SendHex "F0 " & sCmd & " 04 0D"
        m_bConnected = False
        If ReadBytes(4) Then
            If m_ResultBytes(1) = CByte(HexToLong(sCmd) - &H10) Then
                m_bConnected = True
            End If
        End If
        If m_bConnected Then Exit For
    Next
    
    If m_bConnected Then
        DisplayMsg "Connect successful"
    Else
        DisplayMsg "Connect failed"
    End If
    
    Connect = m_bConnected
End Function

' Either one of the formats :
'1. <start addr> - <end addr>
'2. <start addr> [<count>]
Public Function ReadEEprom(ByVal sParam As String) As Boolean
Dim aParams As Variant, lStartAddr As Long, lEndAddr As Long
Dim iCount As Long, iSystem As Byte, lStepSize As Long
Dim aBytes As Variant, bResult As Boolean, iTrial
Dim lTotalCount As Long, aFinalBytes As Variant, sFinalHexStr As String

    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
    
    On Error GoTo ReadEEprom_Error

    aParams = Split(sParam)
    Select Case UBound(aParams)
    Case 0  '<start addr>
        lStartAddr = HexToLong(aParams(0))
        lEndAddr = lStartAddr
        lTotalCount = 1
    Case 1  '<start addr> <count>
        lStartAddr = HexToLong(aParams(0))
        lTotalCount = CLng(aParams(1))
        If lTotalCount = 0 Then
            Err.Number = -1
            GoTo ReadEEprom_Error
        End If
        lEndAddr = lStartAddr + lTotalCount - 1
    Case 2  '<start addr> - <end addr>
        lStartAddr = HexToLong(aParams(0))
        lEndAddr = HexToLong(aParams(2))
        If aParams(1) <> "-" Or lEndAddr < lStartAddr Then
            Err.Number = -1
            GoTo ReadEEprom_Error
        End If
        lTotalCount = lEndAddr - lStartAddr + 1
    Case Else
        Err.Number = -1
        GoTo ReadEEprom_Error
    End Select
    
    Select Case UCase(m_sSystem)
    Case "FP"   'FP
        iSystem = &H30
    Case "PP"   'PP
        iSystem = &H70
    End Select

    m_lStartAddress = lStartAddr
    lStepSize = 50
    For lStartAddr = lStartAddr To lEndAddr Step lStepSize
        iTrial = 0
        bResult = False
        Do While iTrial < m_iMaxTrialCount And Not bResult
            iTrial = iTrial + 1
        
            iCount = lStepSize
            If lStartAddr + iCount - 1 > lEndAddr Then
                iCount = lEndAddr - lStartAddr + 1
            End If
            
            ReDim aBytes(0 To 6) As Byte
            aBytes(0) = &HF0
            aBytes(1) = iSystem + 5
            aBytes(2) = 7
            aBytes(3) = lStartAddr \ 256
            aBytes(4) = lStartAddr Mod 256
            aBytes(5) = CByte(iCount)
            aBytes(6) = &HD
            
            On Error GoTo 0
            
            DisplayMsg "Read EEPROM 0x" & Hex(lStartAddr) & " to 0x" & Hex(lStartAddr + iCount - 1) & " (" & iCount & " bytes)"
            
            SendBytes aBytes
            If ReadBytes(iCount + 6) Then
                If m_ResultBytes(1) = aBytes(1) - &H10 Then bResult = True
            End If
            
            If Not bResult Then
                DisplayMsg "Invalid reply"
            Else
                DisplayMsg "Data: " & Mid(m_ResultHexStr, 16, Len(m_ResultHexStr) - 18)
                ConcatBytes aFinalBytes, m_ResultBytes, 5, iCount
                sFinalHexStr = sFinalHexStr & Mid(m_ResultHexStr, 16, iCount * 3)
            End If
        Loop    ' Do While iTrial < m_im_iMaxTrialCount And Not bResult
    Next
    
    m_ResultBytes = aFinalBytes
    m_ResultHexStr = Trim(sFinalHexStr)

ReadEEprom_Error:
    If Err <> 0 Then DisplayMsg "Invalid format"
    On Error GoTo 0
    
    ReadEEprom = bResult
End Function

' Either one of the following formats
' 1. <start addr> <byte1> <byte2> ...
' 2. <start addr> - <end addr> <byte>
Public Function WriteEEprom(ByVal sParam As String) As Boolean
Dim aParams As Variant, lStartAddr As Long, lEndAddr As Long
Dim iCount As Integer, iSystem As Byte, i As Integer, iByteVal As Byte
Dim aBytes As Variant, bResult As Boolean, 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
    
    On Error GoTo WriteEEprom_Error

    aParams = Split(sParam)
    If UBound(aParams) < 1 Then
        Err.Number = -1
        GoTo WriteEEprom_Error
    End If
    
    If aParams(1) = "-" And UBound(aParams) > 3 Then
        Err.Number = -1
        GoTo WriteEEprom_Error
    End If
    
    
    Select Case UCase(m_sSystem)
    Case "FP"   'FP
        iSystem = &H30
    Case "PP"   'PP
        iSystem = &H70
    End Select
    
    If aParams(1) = "-" Then
        '<start addr> - <end addr> <byte>
        lStartAddr = HexToLong(aParams(0))
        lEndAddr = HexToLong(aParams(2))
        iCount = lEndAddr - lStartAddr + 1
        If iCount <= 0 Then
            Err.Number = -1
            GoTo WriteEEprom_Error
        End If
        
        ReDim aBytes(0 To iCount + 5) As Byte
        aBytes(0) = &HF0
        aBytes(1) = iSystem + 4
        aBytes(2) = iCount + 6
        aBytes(3) = lStartAddr \ 256
        aBytes(4) = lStartAddr Mod 256
        aBytes(iCount + 5) = &HD
        
        iByteVal = CByte(HexToLong(aParams(3)))
        For i = 1 To iCount
            aBytes(4 + i) = iByteVal
        Next
    Else
        '<start addr> <end addr> <byte1> <byte2> ...
        lStartAddr = HexToLong(aParams(0))
        iCount = UBound(aParams)
        lEndAddr = lStartAddr + iCount - 1
        ReDim aBytes(0 To iCount + 5) As Byte
        aBytes(0) = &HF0
        aBytes(1) = iSystem + 4
        aBytes(2) = iCount + 6
        aBytes(3) = lStartAddr \ 256
        aBytes(4) = lStartAddr Mod 256
        aBytes(iCount + 5) = &HD
        
        For i = 1 To iCount
            aBytes(4 + i) = CByte(HexToLong(aParams(i)))
        Next
    End If

    On Error GoTo 0
    
    DisplayMsg "Write EEPROM 0x" & Hex(lStartAddr) & " to 0x" & Hex(lEndAddr) & " (" & iCount & " bytes)"
    
    bResult = False
    For iTrial = 1 To m_iMaxTrialCount
        SendBytes aBytes
        If ReadBytes(iCount + 6) 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 "Data: " & Mid(m_ResultHexStr, 16, Len(m_ResultHexStr) - 18)
    End If

WriteEEprom_Error:
    If Err <> 0 Then DisplayMsg "Invalid format"
    On Error GoTo 0
    
    WriteEEprom = bResult
End Function

' Format of sCommand is either one of the followings :
' 1. <start address> - <end address>
Public Function CompareBytes(ByVal sCommand) As Boolean
Dim bResult As Boolean, lAddress As Long, ByteValue As Variant
Dim lStartAddress As Long, lEndAddress As Long
Dim aParams As Variant, i As Integer, sLine As String
Dim aInvalidAddresses As Variant, aInvalidValues As Variant, bFailedAddress As Boolean

    m_bCompareResult = False
    m_sCompareFailureResult = ""
    
    aParams = Split(sCommand)
    If UBound(aParams) < 2 Then
        DisplayMsg "Invalid command"
        Exit Function
    End If
    If aParams(1) <> "-" Then
        DisplayMsg "Invalid command"
        Exit Function
    End If

    On Error GoTo CompareBytes_Error
    lStartAddress = HexToLong(aParams(0))
    lEndAddress = HexToLong(aParams(2))
    
    DisplayMsg "Compare " & FormatHex(lStartAddress, "0x", 3) & " - " & FormatHex(lEndAddress, "0x", 3)
    
    If lStartAddress < Me.StartAddress Or lStartAddress < oIntelHex.StartAddress _
        Or lEndAddress > Me.EndAddress Or lEndAddress > oIntelHex.EndAddress _
        Then
        DisplayMsg "Address out of range error"
        Exit Function
    End If

    For lAddress = lStartAddress To lEndAddress
        bFailedAddress = True
        ByteValue = oIntelHex.DataByte(lAddress)
        If TypeName(ByteValue) = "Empty" Then
            bFailedAddress = False
        Else
            If m_ResultBytes(lAddress - m_lStartAddress) <> ByteValue Then
                bFailedAddress = False
            End If
        End If
        
        If Not bFailedAddress Then
            ConcatArray aInvalidAddresses, lAddress
            ConcatArray aInvalidValues, m_ResultBytes(lAddress - m_lStartAddress)
        End If
    Next
    
    If TypeName(aInvalidAddresses) = "Empty" Then
        bResult = True
    End If
    
CompareBytes_Error:
    If Err <> 0 Then
        bResult = False
        DisplayMsg "Compare error"
    End If
    On Error GoTo 0

    If bResult Then
        DisplayMsg "Compare successful"
    Else
        DisplayMsg "Compare failed"
        For i = 0 To UBound(aInvalidAddresses)
            sLine = "Addr " & FormatHex(aInvalidAddresses(i), "0x", 4) & ":" _
                & "Correct val " & FormatHex(oIntelHex.DataByte(aInvalidAddresses(i))) _
                & " , Wrong val " & FormatHex(aInvalidValues(i))
            m_sCompareFailureResult = m_sCompareFailureResult & sLine & vbCrLf
            DisplayMsg sLine
        Next
    End If

    m_bCompareResult = bResult
    CompareBytes = bResult
End Function

Public Sub DoMacro(ByVal sMacroPath As String)
Dim iFH As Integer, sFile As String, iLine As Integer, sMsg As String
Dim sLine As String, ch As String

    sFile = Dir(sMacroPath)
    If sFile = "" Then
        Err.Number = -1
        GoTo DoMacro_Error
    End If

    iFH = FreeFile
    On Error GoTo DoMacro_Error
    Open sMacroPath For Input As #iFH
    
    DisplayMsg "Executing macro '" & sMacroPath & "'"
    Do While Not EOF(iFH)
        iLine = iLine + 1
        Input #iFH, sLine
        sLine = Trim(sLine)
        
        ch = Left(sLine, 1)
        If sLine <> "" And ch <> "#" And ch <> ";" And ch <> "/" And ch <> "'" Then
            Execute sLine
        End If
    Loop
    Close #iFH
    iFH = 0
    
DoMacro_Error:
    If Err <> 0 Then
        sMsg = "Macro '" & sMacroPath & "' execution error"
        If iLine > 0 Then
            sMsg = sMsg & " at line " & iLine
        Else
            sMsg = sMsg & " : Cannot open file"
        End If
        DisplayMsg sMsg
    End If
    
    On Error GoTo 0
    If iFH > 0 Then Close #iFH
End Sub

' Export all bytes in m_ResultBytes()
Public Sub ExportToHex(ByVal sExportPath As String)
Dim lStartAddress As Long, lEndAddress As Long, aParams As Variant
Dim iFH As Integer, sLine As String, lAddress As Long, iCount As Integer, i As Integer
Dim bRecIndicator As Boolean

'debug
'ReDim m_ResultBytes(0 To 20) As Byte
'For i = 0 To 20
'    m_ResultBytes(i) = i
'Next