Function CRC16(data() As Byte) As String
Dim CRC16Lo As Byte, CRC16Hi As Byte 'CRC 寄存器
Dim CL As Byte, CH As Byte '多项式码&HA001
Dim SaveHi As Byte, SaveLo As Byte
Dim i As Integer
Dim Flag As Integer
CRC16Lo = &HFF
CRC16Hi = &HFF
CL = &H1
CH = &HA0
For i = 0 To UBound(data)
CRC16Lo = CRC16Lo Xor data(i) '每一个数据与CRC寄存器进行异或
For Flag = 0 To 7
SaveHi = CRC16Hi
SaveLo = CRC16Lo
CRC16Hi = CRC16Hi / 2 '高位右移一位
CRC16Lo = CRC16Lo / 2 '低位右移一位
If ((SaveHi And &H1) = &H1) Then '如果高位字节最后一位为1
CRC16Lo = CRC16Lo Or &H80 '则低位字节右移后前面补1
End If '否则自动补0
If ((SaveLo And &H1) = &H1) Then '如果LSB为1,则与多项式码进行异或
CRC16Hi = CRC16Hi Xor CH
CRC16Lo = CRC16Lo Xor CL
End If
Next Flag
Next i
Dim ReturnData(1) As Byte
ReturnData(0) = CRC16Hi 'CRC高位
ReturnData(1) = CRC16Lo 'CRC低位
CRC16 = ReturnData
End Function
Dim CRC16Lo As Byte, CRC16Hi As Byte 'CRC 寄存器
Dim CL As Byte, CH As Byte '多项式码&HA001
Dim SaveHi As Byte, SaveLo As Byte
Dim i As Integer
Dim Flag As Integer
CRC16Lo = &HFF
CRC16Hi = &HFF
CL = &H1
CH = &HA0
For i = 0 To UBound(data)
CRC16Lo = CRC16Lo Xor data(i) '每一个数据与CRC寄存器进行异或
For Flag = 0 To 7
SaveHi = CRC16Hi
SaveLo = CRC16Lo
CRC16Hi = CRC16Hi / 2 '高位右移一位
CRC16Lo = CRC16Lo / 2 '低位右移一位
If ((SaveHi And &H1) = &H1) Then '如果高位字节最后一位为1
CRC16Lo = CRC16Lo Or &H80 '则低位字节右移后前面补1
End If '否则自动补0
If ((SaveLo And &H1) = &H1) Then '如果LSB为1,则与多项式码进行异或
CRC16Hi = CRC16Hi Xor CH
CRC16Lo = CRC16Lo Xor CL
End If
Next Flag
Next i
Dim ReturnData(1) As Byte
ReturnData(0) = CRC16Hi 'CRC高位
ReturnData(1) = CRC16Lo 'CRC低位
CRC16 = ReturnData
End Function
Private Sub Command1_Click()
Dim CRC() As Byte
Dim d() As Byte
ReDim d(7) As Byte
Dim s As String
Dim str As String
Dim i As Integer
d(0) = Text1.Text
d(1) = 3
d(2) = 40
d(3) = 11
d(4) = 0
d(5) = 3
CRC = CRC16(d)
str = CRC
s = ""
For i = 1 To LenB(str)
s = s + Hex(AscB(MidB(str, i, 1)))
Next i
Label1.Caption = s
Label7.Caption = Right(s, 2)
Label6.Caption = Mid(s, 1, 2)
If Len(s) < 4 Then
Label6.Caption = Mid(s, 1, 1)
End If
End With
End Sub
Dim CRC() As Byte
Dim d() As Byte
ReDim d(7) As Byte
Dim s As String
Dim str As String
Dim i As Integer
d(0) = Text1.Text
d(1) = 3
d(2) = 40
d(3) = 11
d(4) = 0
d(5) = 3
CRC = CRC16(d)
str = CRC
s = ""
For i = 1 To LenB(str)
s = s + Hex(AscB(MidB(str, i, 1)))
Next i
Label1.Caption = s
Label7.Caption = Right(s, 2)
Label6.Caption = Mid(s, 1, 2)
If Len(s) < 4 Then
Label6.Caption = Mid(s, 1, 1)
End If
End With
End Sub