modcrc.bas

一个modbus的测试工具

Attribute VB_Name = "modCrc"
Option Explicit

Global giCRC16_Table(255) As Integer

Public Sub gsubCRC16_Init()
    Dim iCrc_Data As Integer, iCrc_Crc As Integer
    Dim i As Integer, j As Byte
    
    For i = 0 To 255
        Let iCrc_Data = gfunLeftMove(i, 1)
        Let iCrc_Crc = 0
        For j = 0 To 7
            Let iCrc_Data = gfunRightMove(iCrc_Data, 1)
            If (iCrc_Data Xor iCrc_Crc) And &H1 Then
                Let iCrc_Crc = gfunRightMove(iCrc_Crc, 1) Xor &HA001
            Else
                Let iCrc_Crc = gfunRightMove(iCrc_Crc, 1)
            End If
        Next j
        Let giCRC16_Table(i) = iCrc_Crc
    Next i
End Sub

Public Function gfunLeftMove(iIn_Data As Integer, byBits As Byte) As Integer
    Dim i As Byte
    Dim iData As Integer
    
    Let i = 1
    Let iData = iIn_Data
    While i <= byBits
        If iData > &H7FFF / 2 Then
            Let iData = (iData - &H7FFF) * 2
        ElseIf iData < &H8000 / 2 Then
            Let iData = (iData - &H8000) * 2
        Else
            Let iData = iData * 2
        End If
        Let i = i + 1
    Wend
    Let gfunLeftMove = iData
End Function

Public Function gfunRightMove(iIn_Data As Integer, byBits As Byte) As Integer
    Dim i As Byte
    Dim iData As Integer
    
    Let i = 1
    Let iData = iIn_Data
    While i <= byBits
        If iData < 0 Then
            Let iData = Int(iData / 2) - &H8000
        Else
            Let iData = Int(iData / 2)
        End If
        Let i = i + 1
    Wend
    Let gfunRightMove = iData
End Function

Public Function gfunCal_CRC16(byInData As Byte, iCRC16 As Integer) As Integer
    Static byCrc_Data As Integer
    
    Let byCrc_Data = iCRC16 Xor byInData
    Let gfunCal_CRC16 = gfunRightMove(iCRC16, 8) Xor giCRC16_Table(byCrc_Data And &HFF)
End Function