[VB]CRC计算小程序

aq2

[VB]CRC计算小程序　 [复制链接]

上传一个用VB编的CRC码生成程序；

源码如下：

'CRC校验码生成
Private Function CrcResult(ByVal Data As Long, ByVal Genpoly As Long, ByVal CrcData As Long) As Long
Dim n As Integer
Data = Data * 2
For n = 8 To 1 Step -1
    Data = Fix(Data / 2)
    If ((Data Xor CrcData) And 1) Then
        CrcData = Fix(CrcData / 2) Xor Genpoly
    Else
        CrcData = Fix(CrcData / 2)
    End If
Next n
CrcResult = CrcData
End Function

Private Sub Command1_Click()
Dim BL As Byte                              '数据长度
Dim n As Byte                               '循环量
Dim Cmd As String                           '字符串
Dim crc As Long                             'CRC寄存器
Dim fx() As Byte                            '发送的数据
Cmd = Text1.Text
BL = Len(Cmd) / 2
ReDim fx(BL + 1)                         '按命令长度重新定义数组
crc = &HFFFF&                               'CRC初值
For n = 0 To BL - 1
    fx(n) = CLng("&H" & Mid(Cmd, 2 * n + 1, 2)) '分解命令为字节
    crc = CrcResult(fx(n), &HA001&, crc)     'CRC校验码生成调用
Next
fx(BL) = CByte(crc And &HFF&)                '得到的校验高位
fx(BL + 1) = CByte(Fix(crc / 256) And &HFF&) '得到的校验低位

    Text2.Text = Hex(fx(BL))                  '显示crc
    Text3.Text = Hex(fx(BL + 1))
End Sub