clsintelhex.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsIntelHex"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private m_colRows As Collection ' address array (long), must start with xxx0
Private m_LastPath As String, m_dLastFileDateTime As Date

Private Sub Class_Initialize()
    Set m_colRows = New Collection
End Sub

Public Sub Init()
Dim i As Integer, oRow As clsDataRow

    ' delete row content
    Do While m_colRows.Count > 0
        Set oRow = m_colRows(1)
        m_colRows.Remove 1
        Set oRow = Nothing
    Loop
End Sub

Public Sub WriteData(ByVal lAddress As Long, ByVal iDataByte As Byte)
Dim lStartAddress As Long, oRow As clsDataRow
Dim sStartAddress As String, iOffset As Integer

    ' Make the start addr as xxx0
    lStartAddress = lAddress And &HFFFFFFF0
    sStartAddress = CStr(lStartAddress)
    iOffset = lAddress And &HF
    
    On Error Resume Next
    ' search if the start address exists
    Set oRow = m_colRows(sStartAddress)
    
    If Err.Number = 5 Then
        Set oRow = New clsDataRow
        oRow.StartAddress = lStartAddress
        m_colRows.Add oRow, sStartAddress
    End If
    On Error GoTo 0
    
    'update the data byte
    oRow.DataByte(iOffset) = iDataByte
End Sub

Public Function ReadFile(ByVal sFilePath As String, Optional ByVal bForceRead As Boolean = False) As Boolean
Dim iFh As Integer, sLine As String, bOpened As Boolean
Dim bResult As Boolean, iDataLen As Long, lAddress As Long
Dim sData As String, i As Long, sFile As String, lLine As Long

    sFile = Dir(sFilePath)
    If sFile = "" Then
        ReadFile = False
        Exit Function
    End If

    If Not bForceRead And m_LastPath = sFilePath And m_dLastFileDateTime = FileDateTime(sFilePath) Then
        ReadFile = True
        Exit Function
    End If

    Init

    'On Error GoTo ReadFile_Error
    iFh = FreeFile
    Open sFilePath For Input As #iFh
    bOpened = True
    m_LastPath = ""

    lLine = 0
    Do While Not EOF(iFh)
        Input #iFh, sLine
        lLine = lLine + 1
        
        If CalcCheckSum(sLine) <> Right(sLine, 2) Then
            If MsgBox("Wrong checksum at line #" & lLine & vbCrLf & "Continue loading ?", vbYesNo, "Checksum error") <> vbYes Then
                Exit Do
            End If
        End If
        
        iDataLen = HexToLong(Mid(sLine, 2, 2))
        lAddress = HexToLong(Mid(sLine, 4, 4))
        sData = Mid(sLine, 10, iDataLen * 2)
        
        If Mid(sLine, 8, 2) = "01" Then Exit Do
        
        For i = 1 To iDataLen
            WriteData i - 1 + lAddress, CByte(HexToLong(Mid(sData, (i - 1) * 2 + 1, 2)))
        Next
    Loop
    Close #iFh
    bOpened = False
    m_LastPath = sFilePath
    m_dLastFileDateTime = FileDateTime(sFilePath)
    bResult = True

ReadFile_Error:
    If Err <> 0 Then
        MsgBox "Read file '" & sFilePath & "' error !" & vbCrLf _
            & Err.Description
    End If
    
    If bOpened Then Close #iFh
    On Error GoTo 0
    
    ReadFile = bResult
End Function

Public Property Get DataByte(ByVal lAddress As Long) As Variant
Dim lStartAddress As Long, oRow As clsDataRow
Dim sStartAddress As String, iOffset As Integer
Dim Result As Variant

    ' Make the start addr as xxx0
    lStartAddress = lAddress And &HFFFFFFF0
    sStartAddress = CStr(lStartAddress)
    iOffset = lAddress And &HF
    
    On Error Resume Next
    ' search if the start address exists
    Set oRow = m_colRows(sStartAddress)
    
    If Err.Number = 0 Then
        Result = oRow.DataByte(iOffset)
    End If
    On Error GoTo 0
    
    DataByte = Result
End Property

Public Property Get PathName() As String
    PathName = m_LastPath
End Property

Public Property Get StartAddress() As Long
Dim lAddress As Long

    If m_colRows.Count > 0 Then lAddress = m_colRows(1).StartAddress
        
    StartAddress = lAddress
End Property

Public Property Get EndAddress() As Long
Dim lAddress As Long, i As Integer, oRow As clsDataRow

    If m_colRows.Count > 0 Then
        Set oRow = m_colRows(m_colRows.Count)
        lAddress = oRow.StartAddress
        For i = 0 To 15
            If TypeName(oRow.DataByte(i)) <> "Empty" Then
                lAddress = oRow.StartAddress + i
            End If
        Next
    End If
    
    EndAddress = lAddress
End Property

' sLine is the whole line, i.e. ":xxxxx"
' Output is 2-digit hex checksum as string
Public Function CalcCheckSum(ByVal sLine As String) As String
Dim i As Integer, iLen As Integer, sOrgCS As String, lCheckSum As Long
Dim lDataByteCnt As Long

    lDataByteCnt = HexToLong(Mid(sLine, 2, 2))
    iLen = 8 + lDataByteCnt * 2
    lCheckSum = 0
    For i = 2 To iLen Step 2
        lCheckSum = lCheckSum + HexToLong(Mid(sLine, i, 2))
    Next
    lCheckSum = 1 + (Not lCheckSum And &HFF)
    
    CalcCheckSum = FormatHex(lCheckSum)
End Function