clscomm.cls

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

        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 & m_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

    If Not m_oComm.PortOpen Then
        ' com port not opened
        MsgBox "Com port not opened !", vbOKOnly, "Error"
        Exit Function
    End If
    
    If Not m_bConnected Then
        ' not connected
        MsgBox "UUT not connected !", vbOKOnly, "Error"
        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
    SendBytes aBytes
    If ReadBytes(100, &HD) Then
        If m_ResultBytes(1) = aBytes(1) - &H10 Then bResult = True
    End If
    
    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

    If Not m_oComm.PortOpen Then
        ' com port not opened
        MsgBox "Com port not opened !", vbOKOnly, "Error"
        Exit Function
    End If
    
    If Not m_bConnected Then
        ' not connected
        MsgBox "UUT not connected !", vbOKOnly, "Error"
        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
    SendBytes aBytes
    If ReadBytes(6, &HD) Then
        If m_ResultBytes(1) = aBytes(1) - &H10 Then bResult = True
    End If
    
    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

    If Not m_oComm.PortOpen Then
        ' com port not opened
        MsgBox "Com port not opened !", vbOKOnly, "Error"
        Exit Function
    End If
    
    If Not m_bConnected Then
        ' not connected
        MsgBox "UUT not connected !", vbOKOnly, "Error"
        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
    SendBytes aBytes
    If ReadBytes(6, &HD) Then
        If m_ResultBytes(1) = aBytes(1) - &H10 Then bResult = True
    End If
    
    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

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

    If Not m_oComm.PortOpen Then
        ' com port not opened
        MsgBox "Com port not opened !", vbOKOnly, "Error"
        Exit Function
    End If
    
    If Not m_bConnected Then
        ' not connected
        MsgBox "UUT not connected !", vbOKOnly, "Error"
        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
    SendBytes aBytes
    If ReadBytes(6, &HD) Then
        If m_ResultBytes(1) = aBytes(1) - &H10 Then bResult = True
    End If
    
    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

    If Not m_oComm.PortOpen Then
        ' com port not opened
        MsgBox "Com port not opened !", vbOKOnly, "Error"
        Exit Function
    End If
    
    If Not m_bConnected Then
        ' not connected
        MsgBox "UUT not connected !", vbOKOnly, "Error"
        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
    SendBytes aBytes
    If ReadBytes(6, &HD) Then
        If m_ResultBytes(1) = aBytes(1) - &H10 Then bResult = True
    End If
    
    If Not bResult Then
        DisplayMsg "Invalid reply"
    Else
        DisplayMsg "TBR " & iMode & " set"
    End If
    
    EnterTBR = bResult
End Function