clscomm.cls

一个VB实现串口通讯的经典示例.非常简明, 使用, 本人大部分通讯程序与之类同

    End If
    
    Select Case UCase(sSystem)
    Case "FP"   'FP
        sCmd = "30"
    Case "PP"   'PP
        sCmd = "70"
    Case Else
        If bInteractive Then MsgBox "Invalid system type !", , "Error"
        Exit Function
    End Select
    
    m_sSystem = UCase(sSystem)
    
    DisplayMsg "Connect " & sSystem
    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
        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 Sub ReadEEprom(ByVal sParam As String)
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
Dim lTotalCount As Long, aFinalBytes As Variant, sFinalHexStr As String

    If Not m_oComm.PortOpen Then
        ' com port not opened
        MsgBox "Com port not opened !", vbOKOnly, "Error"
        Exit Sub
    End If
    
    If Not m_bConnected Then
        ' not connected
        MsgBox "UUT not connected !", vbOKOnly, "Error"
        Exit Sub
    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
        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)"
        
        bResult = False
        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
    Next
    
    m_ResultBytes = aFinalBytes
    m_ResultHexStr = Trim(sFinalHexStr)

ReadEEprom_Error:
    If Err <> 0 Then DisplayMsg "Invalid format"
    On Error GoTo 0
End Sub

' Either one of the following formats
' 1. <start addr> <byte1> <byte2> ...
' 2. <start addr> - <end addr> <byte>
Public Sub WriteEEprom(ByVal sParam As String)
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

    If Not m_oComm.PortOpen Then
        ' com port not opened
        MsgBox "Com port not opened !", vbOKOnly, "Error"
        Exit Sub
    End If
    
    If Not m_bConnected Then
        ' not connected
        MsgBox "UUT not connected !", vbOKOnly, "Error"
        Exit Sub
    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
    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)
    End If

WriteEEprom_Error:
    If Err <> 0 Then DisplayMsg "Invalid format"
    On Error GoTo 0
End Sub

' 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
Dim aInvalidAddresses As Variant, aInvalidValues As Variant, bFailedAddress As Boolean

    m_bCompareResult = False
    
    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 < m_oIntelHex.StartAddress _
        Or lEndAddress > Me.EndAddress Or lEndAddress > m_oIntelHex.EndAddress _
        Then
        DisplayMsg "Address out of range error"
        Exit Function
    End If

    For lAddress = lStartAddress To lEndAddress
        bFailedAddress = True
        ByteValue = m_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)
            DisplayMsg "Addr " & FormatHex(aInvalidAddresses(i), "0x", 4) & ":" _
                & "Correct val " & FormatHex(m_oIntelHex.DataByte(aInvalidAddresses(i))) _
                & " , Wrong val " & FormatHex(aInvalidValues(i))
        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

    sExportPath = Trim(sExportPath)
    If TypeName(m_ResultBytes) = "Empty" Then