如果我想对上面这段数据进行CRC校验，CRC运算的方法是：校验方程为：G(x)=x16+x12+x5+1 初始值为：0
我现在要判断我要对例如上面的这段数据进行CRC校验计算，如果计算完的结果为0，就说明我接收到的数据是没有错误的，如果CRC校验计算完结果不为0就说明我接收到的数据里边有错误了，这个我就需要重新接收对方给我发的下一个数据了。
（如果有说的不清楚地地方请问我，如果需要贴上我的代码也请说）谢谢大家帮忙。
47 个解决方案
#1
CCITT的东西，以前我做过，晚上回家弄给你
#2
关注
#3
太好了，晚上我在线等你吧，谢谢你。
#4
自己顶顶。
#5
不过我们当时做的是去掉前面和后面的标识符，只算数据体的，也就是
开始符+数据体+二字节校验+结束符
开始符+数据体+二字节校验+结束符
#6
我的是
数据标识 + 帧序号 + 版本号 + 数据段 + CRC校验
1 Byte 2 Bytes 1 Byte 36 Bytes 2 Bytes
一共42个字节，
”010001010001090522110555021234EEEE05110609050000510162060003450200822000000000003050“
上边这段就是我提取完需要做CRC校验的数据，一共42个字节。
数据标识 + 帧序号 + 版本号 + 数据段 + CRC校验
1 Byte 2 Bytes 1 Byte 36 Bytes 2 Bytes
一共42个字节，
”010001010001090522110555021234EEEE05110609050000510162060003450200822000000000003050“
上边这段就是我提取完需要做CRC校验的数据，一共42个字节。
#7
'CRC低位字节值表
Private Function GetCRCLo(ByVal lngIndex As Long) As Integer
GetCRCLo = VBA.Choose(lngIndex + 1, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40)
End Function
'CRC高位字节值表
Private Function GetCRCHi(ByVal lngIndex As Long) As Integer
GetCRCHi = VBA.Choose(lngIndex + 1, _
&H0, &HC0, &HC1, &H1, &HC3, &H3, &H2, &HC2, &HC6, &H6, &H7, &HC7, &H5, &HC5, &HC4, &H4, _
&HCC, &HC, &HD, &HCD, &HF, &HCF, &HCE, &HE, &HA, &HCA, &HCB, &HB, &HC9, &H9, &H8, &HC8, _
&HD8, &H18, &H19, &HD9, &H1B, &HDB, &HDA, &H1A, &H1E, &HDE, &HDF, &H1F, &HDD, &H1D, &H1C, &HDC, _
&H14, &HD4, &HD5, &H15, &HD7, &H17, &H16, &HD6, &HD2, &H12, &H13, &HD3, &H11, &HD1, &HD0, _
&H10, &HF0, &H30, &H31, &HF1, &H33, &HF3, &HF2, &H32, &H36, &HF6, &HF7, &H37, &HF5, &H35, &H34, &HF4, _
&H3C, &HFC, &HFD, &H3D, &HFF, &H3F, &H3E, &HFE, &HFA, &H3A, &H3B, &HFB, &H39, &HF9, &HF8, &H38, _
&H28, &HE8, &HE9, &H29, &HEB, &H2B, &H2A, &HEA, &HEE, &H2E, &H2F, &HEF, &H2D, &HED, &HEC, &H2C, _
&HE4, &H24, &H25, &HE5, &H27, &HE7, &HE6, &H26, &H22, &HE2, &HE3, &H23, &HE1, &H21, &H20, &HE0, _
&HA0, &H60, &H61, &HA1, &H63, &HA3, &HA2, &H62, &H66, &HA6, &HA7, &H67, &HA5, &H65, &H64, &HA4, _
&H6C, &HAC, &HAD, &H6D, &HAF, &H6F, &H6E, &HAE, &HAA, &H6A, &H6B, &HAB, &H69, &HA9, &HA8, &H68, _
&H78, &HB8, &HB9, &H79, &HBB, &H7B, &H7A, &HBA, &HBE, &H7E, &H7F, &HBF, &H7D, &HBD, &HBC, &H7C, _
&HB4, &H74, &H75, &HB5, &H77, &HB7, &HB6, &H76, &H72, &HB2, &HB3, &H73, &HB1, &H71, &H70, &HB0, _
&H50, &H90, &H91, &H51, &H93, &H53, &H52, &H92, &H96, &H56, &H57, &H97, &H55, &H95, &H94, &H54, _
&H9C, &H5C, &H5D, &H9D, &H5F, &H9F, &H9E, &H5E, &H5A, &H9A, &H9B, &H5B, &H99, &H59, &H58, &H98, _
&H88, &H48, &H49, &H89, &H4B, &H8B, &H8A, &H4A, &H4E, &H8E, &H8F, &H4F, &H8D, &H4D, &H4C, &H8C, _
&H44, &H84, &H85, &H45, &H87, &H47, &H46, &H86, &H82, &H42, &H43, &H83, &H41, &H81, &H80, &H40)
End Function
'16码(8位)的校验
Private Function CRC16(ByRef data() As Byte) As String
Dim i As Integer
Dim iIndex As Long
Dim CRC16Hi As Integer '高位
Dim CRC16Lo As Integer '低位
Dim strTemp As String
CRC16Hi = 0
CRC16Lo = 0
'1 以低位值与所传的数据的每一位的十进制值异或(得出高低对照表的索引)
'2 以高位值与所得索引到低位对照表中找出低位值异或(得出低位值)
'3 以所得索引到高位对照表中找出高位值(得出高位值)
'4 循环
'5 将最终的高位与低位值分别转换成十六进制的值
'6 转换成字符串相加(得出CRC校验值)
For i = 0 To UBound(data)
iIndex = CRC16Lo Xor data(i)
CRC16Lo = CRC16Hi Xor GetCRCLo(iIndex) '低位处理
CRC16Hi = GetCRCHi(iIndex) '高位处理
Next i
'得到校验值
strTemp = CStr(Hex(CRC16Hi)) '高位
If VBA.Len(strTemp) = 1 Then
strTemp = "0" & strTemp
End If
CRC16 = strTemp '低位
strTemp = CStr(Hex(CRC16Lo))
If VBA.Len(strTemp) = 1 Then
strTemp = "0" & strTemp
End If
CRC16 = CRC16 & strTemp
End Function
'校验接受的值
Private Function VerifyCRCData() As Boolean
On Error GoTo ErrorLine:
Dim varVerifyCRC() As Byte
Dim varCRC As Variant
Dim intIndex As Integer
Dim SpecialCRC As Variant
Dim i As Integer
VerifyCRCData = False
intIndex = VBA.LenB(mvar_RXData) - 1
If Not (intIndex >= 8) Then
GoTo ErrorLine:
End If
If Not (mvar_RXData(0) = 226 And mvar_RXData(intIndex) = 221) Then
GoTo ErrorLine:
End If
varCRC = CStr(Hex(mvar_RXData(intIndex - 2))) & _
CStr(Hex(mvar_RXData(intIndex - 1)))
If Len(varCRC) <> 4 Then
varCRC = CStr(Format(Hex(mvar_RXData(intIndex - 2)), "00")) & _
CStr(Format(Hex(mvar_RXData(intIndex - 1)), "00"))
varCRC = ""
If Len(varCRC) <> 4 Then
SpecialCRC = Hex(mvar_RXData(intIndex - 2))
If Len(SpecialCRC) = 1 Then
varCRC = "0" & SpecialCRC
Else
varCRC = SpecialCRC
End If
SpecialCRC = Hex(mvar_RXData(intIndex - 1))
If Len(SpecialCRC) = 1 Then
varCRC = varCRC & "0" & SpecialCRC
Else
varCRC = varCRC & SpecialCRC
End If
End If
End If
ReDim varVerifyCRC(intIndex - 3) As Byte
For i = 0 To intIndex - 3
varVerifyCRC(i) = mvar_RXData(i)
Next i
If varCRC = CRC16(varVerifyCRC) Then
VerifyCRCData = True
End If
'VerifyCRCData = True
ErrorLine:
If Err.Number <> 0 Then
Err.Clear
End If
End Function
'接收数据
Private Function RCommand(ByVal Waitting As Single) As Boolean
On Error GoTo ErrorLine:
Dim slgEndTime As Single
RCommand = False
muenum_Status = lngCommErr
' slgEndTime = VBA.Timer + Waitting
'
' Do
' If slgEndTime <= VBA.Timer Then
' Exit Do
' End If
' VBA.DoEvents
' Loop
Sleep 50
If gobj_Comm.InBufferCount > 0 Then '判断有返回值
mvar_RXData = gobj_Comm.Input
' Debug.Print mvar_RXData(3)
'校验数据
If VerifyCRCData() = True Then
muenum_Status = lngNone
RCommand = True
Else
muenum_Status = lngDataErr
End If
End If
ErrorLine:
If Err.Number <> 0 Then
Err.Clear
mvar_RXData = ""
RCommand = False
End If
End Function
CRC16校验接收数据校验部分。利用查表得到
Private Function GetCRCLo(ByVal lngIndex As Long) As Integer
GetCRCLo = VBA.Choose(lngIndex + 1, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40)
End Function
'CRC高位字节值表
Private Function GetCRCHi(ByVal lngIndex As Long) As Integer
GetCRCHi = VBA.Choose(lngIndex + 1, _
&H0, &HC0, &HC1, &H1, &HC3, &H3, &H2, &HC2, &HC6, &H6, &H7, &HC7, &H5, &HC5, &HC4, &H4, _
&HCC, &HC, &HD, &HCD, &HF, &HCF, &HCE, &HE, &HA, &HCA, &HCB, &HB, &HC9, &H9, &H8, &HC8, _
&HD8, &H18, &H19, &HD9, &H1B, &HDB, &HDA, &H1A, &H1E, &HDE, &HDF, &H1F, &HDD, &H1D, &H1C, &HDC, _
&H14, &HD4, &HD5, &H15, &HD7, &H17, &H16, &HD6, &HD2, &H12, &H13, &HD3, &H11, &HD1, &HD0, _
&H10, &HF0, &H30, &H31, &HF1, &H33, &HF3, &HF2, &H32, &H36, &HF6, &HF7, &H37, &HF5, &H35, &H34, &HF4, _
&H3C, &HFC, &HFD, &H3D, &HFF, &H3F, &H3E, &HFE, &HFA, &H3A, &H3B, &HFB, &H39, &HF9, &HF8, &H38, _
&H28, &HE8, &HE9, &H29, &HEB, &H2B, &H2A, &HEA, &HEE, &H2E, &H2F, &HEF, &H2D, &HED, &HEC, &H2C, _
&HE4, &H24, &H25, &HE5, &H27, &HE7, &HE6, &H26, &H22, &HE2, &HE3, &H23, &HE1, &H21, &H20, &HE0, _
&HA0, &H60, &H61, &HA1, &H63, &HA3, &HA2, &H62, &H66, &HA6, &HA7, &H67, &HA5, &H65, &H64, &HA4, _
&H6C, &HAC, &HAD, &H6D, &HAF, &H6F, &H6E, &HAE, &HAA, &H6A, &H6B, &HAB, &H69, &HA9, &HA8, &H68, _
&H78, &HB8, &HB9, &H79, &HBB, &H7B, &H7A, &HBA, &HBE, &H7E, &H7F, &HBF, &H7D, &HBD, &HBC, &H7C, _
&HB4, &H74, &H75, &HB5, &H77, &HB7, &HB6, &H76, &H72, &HB2, &HB3, &H73, &HB1, &H71, &H70, &HB0, _
&H50, &H90, &H91, &H51, &H93, &H53, &H52, &H92, &H96, &H56, &H57, &H97, &H55, &H95, &H94, &H54, _
&H9C, &H5C, &H5D, &H9D, &H5F, &H9F, &H9E, &H5E, &H5A, &H9A, &H9B, &H5B, &H99, &H59, &H58, &H98, _
&H88, &H48, &H49, &H89, &H4B, &H8B, &H8A, &H4A, &H4E, &H8E, &H8F, &H4F, &H8D, &H4D, &H4C, &H8C, _
&H44, &H84, &H85, &H45, &H87, &H47, &H46, &H86, &H82, &H42, &H43, &H83, &H41, &H81, &H80, &H40)
End Function
'16码(8位)的校验
Private Function CRC16(ByRef data() As Byte) As String
Dim i As Integer
Dim iIndex As Long
Dim CRC16Hi As Integer '高位
Dim CRC16Lo As Integer '低位
Dim strTemp As String
CRC16Hi = 0
CRC16Lo = 0
'1 以低位值与所传的数据的每一位的十进制值异或(得出高低对照表的索引)
'2 以高位值与所得索引到低位对照表中找出低位值异或(得出低位值)
'3 以所得索引到高位对照表中找出高位值(得出高位值)
'4 循环
'5 将最终的高位与低位值分别转换成十六进制的值
'6 转换成字符串相加(得出CRC校验值)
For i = 0 To UBound(data)
iIndex = CRC16Lo Xor data(i)
CRC16Lo = CRC16Hi Xor GetCRCLo(iIndex) '低位处理
CRC16Hi = GetCRCHi(iIndex) '高位处理
Next i
'得到校验值
strTemp = CStr(Hex(CRC16Hi)) '高位
If VBA.Len(strTemp) = 1 Then
strTemp = "0" & strTemp
End If
CRC16 = strTemp '低位
strTemp = CStr(Hex(CRC16Lo))
If VBA.Len(strTemp) = 1 Then
strTemp = "0" & strTemp
End If
CRC16 = CRC16 & strTemp
End Function
'校验接受的值
Private Function VerifyCRCData() As Boolean
On Error GoTo ErrorLine:
Dim varVerifyCRC() As Byte
Dim varCRC As Variant
Dim intIndex As Integer
Dim SpecialCRC As Variant
Dim i As Integer
VerifyCRCData = False
intIndex = VBA.LenB(mvar_RXData) - 1
If Not (intIndex >= 8) Then
GoTo ErrorLine:
End If
If Not (mvar_RXData(0) = 226 And mvar_RXData(intIndex) = 221) Then
GoTo ErrorLine:
End If
varCRC = CStr(Hex(mvar_RXData(intIndex - 2))) & _
CStr(Hex(mvar_RXData(intIndex - 1)))
If Len(varCRC) <> 4 Then
varCRC = CStr(Format(Hex(mvar_RXData(intIndex - 2)), "00")) & _
CStr(Format(Hex(mvar_RXData(intIndex - 1)), "00"))
varCRC = ""
If Len(varCRC) <> 4 Then
SpecialCRC = Hex(mvar_RXData(intIndex - 2))
If Len(SpecialCRC) = 1 Then
varCRC = "0" & SpecialCRC
Else
varCRC = SpecialCRC
End If
SpecialCRC = Hex(mvar_RXData(intIndex - 1))
If Len(SpecialCRC) = 1 Then
varCRC = varCRC & "0" & SpecialCRC
Else
varCRC = varCRC & SpecialCRC
End If
End If
End If
ReDim varVerifyCRC(intIndex - 3) As Byte
For i = 0 To intIndex - 3
varVerifyCRC(i) = mvar_RXData(i)
Next i
If varCRC = CRC16(varVerifyCRC) Then
VerifyCRCData = True
End If
'VerifyCRCData = True
ErrorLine:
If Err.Number <> 0 Then
Err.Clear
End If
End Function
'接收数据
Private Function RCommand(ByVal Waitting As Single) As Boolean
On Error GoTo ErrorLine:
Dim slgEndTime As Single
RCommand = False
muenum_Status = lngCommErr
' slgEndTime = VBA.Timer + Waitting
'
' Do
' If slgEndTime <= VBA.Timer Then
' Exit Do
' End If
' VBA.DoEvents
' Loop
Sleep 50
If gobj_Comm.InBufferCount > 0 Then '判断有返回值
mvar_RXData = gobj_Comm.Input
' Debug.Print mvar_RXData(3)
'校验数据
If VerifyCRCData() = True Then
muenum_Status = lngNone
RCommand = True
Else
muenum_Status = lngDataErr
End If
End If
ErrorLine:
If Err.Number <> 0 Then
Err.Clear
mvar_RXData = ""
RCommand = False
End If
End Function
CRC16校验接收数据校验部分。利用查表得到
#8
朋友，这个怎么用啊，这段代码是不要贴到VB的模块里边阿，我上午弄进程序，总有问题。还有就是我看您的代码我不知道在什么地方我需要把我要CRC校验的数据加进去就是（010001010001090522110555021234EEEE05110609050000510162060003450200822000000000003050）
比如这个数据在什么地方加，怎么用，我看的不是很明白，麻烦您给说说吧。谢谢
比如这个数据在什么地方加，怎么用，我看的不是很明白，麻烦您给说说吧。谢谢
#9
放什么位置由你决定，一般来说我放在模块中。你需要把函数Private Function VerifyCRCData() As Boolean 改成Private Function VerifyCRCData(byval RecStr as byte) As Boolean RecStr 是你需要做校验的数据。还有把intIndex = VBA.LenB(mvar_RXData) - 1
该为IntIndex=vba.LenB(RecStr)-1
该为IntIndex=vba.LenB(RecStr)-1
#10
给你提供一个小工具
http://download.csdn.net/source/862973
http://download.csdn.net/source/862973
#11
放什么位置由你决定，一般来说我放在模块中。你需要把函数Private Function VerifyCRCData() As Boolean 改成Private Function VerifyCRCData(byval RecStr as byte) As Boolean RecStr 是你需要做校验的数据。还有把intIndex = VBA.LenB(mvar_RXData) - 1
该为IntIndex=vba.LenB(RecStr)-1
*1123你好，我把我的代码给你看看，你帮我看下我在什么地方调用这个CRC校验程序吧，然后怎么负值。
Private Sub Mscomm1_OnComm()
Dim inByte() As Byte, byt As Byte
Dim i As Integer
Dim value() As Byte
Dim w As Long
Dim flag As Boolean
Dim s As String, t As String
Dim l As Long, q As Long, e As Long, v As Long, u As Long, k As Long, n As Long, b As Long, c As Long
Select Case MSComm1.CommEvent
Case comEvReceive
inByte = MSComm1.Input
For i = 0 To UBound(inByte)
If Len(Hex(inByte(i))) = 1 Then
strData = strData & "0" & Hex(inByte(i))
Else
strData = strData & Hex(inByte(i))
End If
Next
Text1.Text = strData
Text17 = Len(strData) '上边是我接收数据的代码
s = strData
ReDim inByte(0 To Len(s) \ 2 - 1) As Byte
For w = 1 To Len(s) Step 2
inByte(w \ 2) = CByte("&H" & Mid(s, w, 2))
Next
flag = False
t = ""
For w = 0 To UBound(inByte)
If Not flag Then
If inByte(w) <> &H10 Then
t = t & Right("0" & Hex(inByte(w)), 2)
Else
flag = True
End If
Else
'01转1081，03转1083，10转1090
Select Case inByte(w)
Case &H81
byt = &H1
Case &H83
byt = &H3
Case &H90
byt = &H10
Case Else
MsgBox "错误的转义字符"
Exit Sub
End Select
t = t & Right("0" & Hex(byt), 2)
flag = False
End If
Next
Debug.Print "结果："; t '到这步是我出来的代码
Text18 = t
strdata1 = Mid(t, 3, 84)
Text19 = strdata1 'strdata1里边的数据就是我要进行CRC校验的数据
'是不应该从这一下就开始调用阿，怎么么调用，麻烦您能把我弄下代码吗？
该为IntIndex=vba.LenB(RecStr)-1
*1123你好，我把我的代码给你看看，你帮我看下我在什么地方调用这个CRC校验程序吧，然后怎么负值。
Private Sub Mscomm1_OnComm()
Dim inByte() As Byte, byt As Byte
Dim i As Integer
Dim value() As Byte
Dim w As Long
Dim flag As Boolean
Dim s As String, t As String
Dim l As Long, q As Long, e As Long, v As Long, u As Long, k As Long, n As Long, b As Long, c As Long
Select Case MSComm1.CommEvent
Case comEvReceive
inByte = MSComm1.Input
For i = 0 To UBound(inByte)
If Len(Hex(inByte(i))) = 1 Then
strData = strData & "0" & Hex(inByte(i))
Else
strData = strData & Hex(inByte(i))
End If
Next
Text1.Text = strData
Text17 = Len(strData) '上边是我接收数据的代码
s = strData
ReDim inByte(0 To Len(s) \ 2 - 1) As Byte
For w = 1 To Len(s) Step 2
inByte(w \ 2) = CByte("&H" & Mid(s, w, 2))
Next
flag = False
t = ""
For w = 0 To UBound(inByte)
If Not flag Then
If inByte(w) <> &H10 Then
t = t & Right("0" & Hex(inByte(w)), 2)
Else
flag = True
End If
Else
'01转1081，03转1083，10转1090
Select Case inByte(w)
Case &H81
byt = &H1
Case &H83
byt = &H3
Case &H90
byt = &H10
Case Else
MsgBox "错误的转义字符"
Exit Sub
End Select
t = t & Right("0" & Hex(byt), 2)
flag = False
End If
Next
Debug.Print "结果："; t '到这步是我出来的代码
Text18 = t
strdata1 = Mid(t, 3, 84)
Text19 = strdata1 'strdata1里边的数据就是我要进行CRC校验的数据
'是不应该从这一下就开始调用阿，怎么么调用，麻烦您能把我弄下代码吗？
#12
Debug.Print "结果："; t '到这步是我出来的代码
Text18 = t
strdata1 = Mid(t, 3, 84)
Text19 = strdata1
在后面调用
if VerifyCRCData(strdata1)=true then
msgbox "校验成功！"
else
msgbox "校验失败！"
end if
Text18 = t
strdata1 = Mid(t, 3, 84)
Text19 = strdata1
在后面调用
if VerifyCRCData(strdata1)=true then
msgbox "校验成功！"
else
msgbox "校验失败！"
end if
#13
Debug.Print "结果："; t '到这步是我出来的代码
Text18 = t
strdata1 = Mid(t, 3, 84)
Text19 = strdata1
在后面调用
if VerifyCRCData(strdata1)=true then
msgbox "校验成功！"
else
msgbox "校验失败！"
end if
你好，你说的在后面调用，是不这个if VerifyCRCData(strdata1)=true then 就是直接调用完以后的结果了。还有我想问您下，我给的这个数据是包含了CRC校验位的两个字节，如果您计算的时候包括CRC两个校验字节，那判断结果应该为0，如果没有判断，那计算结果应该判断得出的两个字节是否等于数据里边的CRC两个校验字节。您是哪种判断？
Text18 = t
strdata1 = Mid(t, 3, 84)
Text19 = strdata1
在后面调用
if VerifyCRCData(strdata1)=true then
msgbox "校验成功！"
else
msgbox "校验失败！"
end if
你好，你说的在后面调用，是不这个if VerifyCRCData(strdata1)=true then 就是直接调用完以后的结果了。还有我想问您下，我给的这个数据是包含了CRC校验位的两个字节，如果您计算的时候包括CRC两个校验字节，那判断结果应该为0，如果没有判断，那计算结果应该判断得出的两个字节是否等于数据里边的CRC两个校验字节。您是哪种判断？
#14
判断检验位是否相等，和你的表达方式不一样。你可以把那个VerifyCRCData函数做成你需要做的判断形势。校验的时候只校验数据，和校验位比较是否相等。
#15
就是您的这个程序，判断完的结果是不为0阿？
对了我刚才用您的程序是系统提示：错误的参数号或无效的属性赋值，为什么啊？
对了我刚才用您的程序是系统提示：错误的参数号或无效的属性赋值，为什么啊？
#16
我一直用这个CRC校验的。没有问题，可能代码有些地方需要你改正。50校验结果吗？
#17
（010001010001090522110555021234EEEE05110609050000510162060003450200822000000000003050）
这段数据里边是3050是CRC校验的字节。
我想问您下，用您的这段CRC校验计算的时候3050参与计算了吗，如果参与了，那就是判断结果是否为0。
如果这个3050没有参与CRC校验计算那得出的结果应该和3050一样。
我刚学，你写的代码很多看不懂，所以最好麻烦您能看看我的要求帮着把您的代码调试一下，看能运行吗。我在我的环境下运行时提示刚才的错误。
这段数据里边是3050是CRC校验的字节。
我想问您下，用您的这段CRC校验计算的时候3050参与计算了吗，如果参与了，那就是判断结果是否为0。
如果这个3050没有参与CRC校验计算那得出的结果应该和3050一样。
我刚学，你写的代码很多看不懂，所以最好麻烦您能看看我的要求帮着把您的代码调试一下，看能运行吗。我在我的环境下运行时提示刚才的错误。
#18
不参与计算的。我现在针对你的数据做下校验处理。
#19
校验的结果不一样。我校验出的数据是3690.
#20
我刚才自己算的结果还是3050。
我现在用的这个程序，可以成功调用，但是也是计算的结果不对，麻烦您能帮我看看这个计算有问题吗？
Public Function CRC_CCITT(data() As Byte) As String
Dim crc As Long
Dim i As Byte, j As Integer
Dim crch As String, crcl As String
crc = 0
For j = LBound(data) To UBound(data)
i = &H80
While (i <> 0)
If (crc And &H8000) <> 0 Then
crc = crc * 2
crc = crc Xor &H1021
Else
crc = crc * 2
End If
If (data(j) And i) <> 0 Then
crc = crc Xor &H1021
End If
i = i / 2
If crc > 65536 Then
crc = crc - 65536
End If
Wend
Next j
crch = Hex(Fix(crc / 256))
If Len(crch) = 1 Then crch = "0 " & crch
crcl = Hex(crc Mod 256)
If Len(crcl) = 1 Then crcl = "0 " & crcl
CRC_CCITT = crch & " " & crcl
End Function
我需要处理的数据存在这个里边strdata1，这个我是这么定义的dim strdata1 as string。用这个程序前是不得先把strdata1 转换成数组阿？
我是这么转数组的
Dim y() As Byte
y = strdata1
Dim f As Integer
f = UBound(y)
Dim g As Integer
For g = 0 To f Step 2
Debug.Print Hex(y(g))
Next g
最后的数组存在y中,不知道我这样操作对不对？
我现在用的这个程序，可以成功调用，但是也是计算的结果不对，麻烦您能帮我看看这个计算有问题吗？
Public Function CRC_CCITT(data() As Byte) As String
Dim crc As Long
Dim i As Byte, j As Integer
Dim crch As String, crcl As String
crc = 0
For j = LBound(data) To UBound(data)
i = &H80
While (i <> 0)
If (crc And &H8000) <> 0 Then
crc = crc * 2
crc = crc Xor &H1021
Else
crc = crc * 2
End If
If (data(j) And i) <> 0 Then
crc = crc Xor &H1021
End If
i = i / 2
If crc > 65536 Then
crc = crc - 65536
End If
Wend
Next j
crch = Hex(Fix(crc / 256))
If Len(crch) = 1 Then crch = "0 " & crch
crcl = Hex(crc Mod 256)
If Len(crcl) = 1 Then crcl = "0 " & crcl
CRC_CCITT = crch & " " & crcl
End Function
我需要处理的数据存在这个里边strdata1，这个我是这么定义的dim strdata1 as string。用这个程序前是不得先把strdata1 转换成数组阿？
我是这么转数组的
Dim y() As Byte
y = strdata1
Dim f As Integer
f = UBound(y)
Dim g As Integer
For g = 0 To f Step 2
Debug.Print Hex(y(g))
Next g
最后的数组存在y中,不知道我这样操作对不对？
#21
CRC得到的东西肯定不参与校验，如我之前所说
只算数据体的，也就是
开始符+数据体+二字节校验+结束符
只算数据体的，也就是
开始符+数据体+二字节校验+结束符
#22
CRC得到的东西肯定不参与校验，如我之前所说
只算数据体的，也就是
开始符+数据体+二字节校验+结束符
那应该是你的数据的格式把，我的数据格式是这样的。
我的是
数据标识 + 帧序号 + 版本号 + 数据段 + CRC校验
1 Byte 2 Bytes 1 Byte 36 Bytes 2 Bytes
如果按你说的校验的时候不带CRC校验码就应该是这样的。
数据标识 + 帧序号 + 版本号 + 数据段
1 Byte 2 Bytes 1 Byte 36 Bytes
如果是这样也可以，这样最后得出的结果应该是和CRC校验的两个字节一样。这样也可以。
只算数据体的，也就是
开始符+数据体+二字节校验+结束符
那应该是你的数据的格式把，我的数据格式是这样的。
我的是
数据标识 + 帧序号 + 版本号 + 数据段 + CRC校验
1 Byte 2 Bytes 1 Byte 36 Bytes 2 Bytes
如果按你说的校验的时候不带CRC校验码就应该是这样的。
数据标识 + 帧序号 + 版本号 + 数据段
1 Byte 2 Bytes 1 Byte 36 Bytes
如果是这样也可以，这样最后得出的结果应该是和CRC校验的两个字节一样。这样也可以。
#23
Public Function CRC_CCITT(data() As Byte) As String
Dim crc As Long
Dim i As Byte, j As Integer
Dim crch As String, crcl As String
crc = 0
For j = LBound(data) To UBound(data)
i = &H80
While (i <> 0)
If (crc And &H8000) <> 0 Then
crc = crc * 2
crc = crc Xor &H1021
Else
crc = crc * 2
End If
If (data(j) And i) <> 0 Then
crc = crc Xor &H1021
End If
i = i / 2
If crc > 65536 Then
crc = crc - 65536
End If
Wend
Next j
crch = Hex(Fix(crc / 256))
If Len(crch) = 1 Then crch = "0 " & crch
crcl = Hex(crc Mod 256)
If Len(crcl) = 1 Then crcl = "0 " & crcl
CRC_CCITT = crch & " " & crcl
End Function
我现在上边的这个CRC的CCITT算法，最后得出的结果是错的，是不是什么地方有错误阿，大家帮我看看吧。
Dim crc As Long
Dim i As Byte, j As Integer
Dim crch As String, crcl As String
crc = 0
For j = LBound(data) To UBound(data)
i = &H80
While (i <> 0)
If (crc And &H8000) <> 0 Then
crc = crc * 2
crc = crc Xor &H1021
Else
crc = crc * 2
End If
If (data(j) And i) <> 0 Then
crc = crc Xor &H1021
End If
i = i / 2
If crc > 65536 Then
crc = crc - 65536
End If
Wend
Next j
crch = Hex(Fix(crc / 256))
If Len(crch) = 1 Then crch = "0 " & crch
crcl = Hex(crc Mod 256)
If Len(crcl) = 1 Then crcl = "0 " & crcl
CRC_CCITT = crch & " " & crcl
End Function
我现在上边的这个CRC的CCITT算法，最后得出的结果是错的，是不是什么地方有错误阿，大家帮我看看吧。
#24
text1的内容为"010001010001090522110555021234EEEE05110609050000510162060003450200822000000000003050"
Dim byout() As Byte
Private Sub Command1_Click()
Dim i As Long
ReDim byout(1 To Len(Text1.Text) / 2)
For i = 1 To Len(Text1.Text) / 2
byout(i) = "&H" & Mid(Text1.Text, 2 * i - 1, 2)
Next
Text2.Text = Checkout_ccitt(1, UBound(byout))
End Sub
'计算byout(begnum)到byout(endnum) 的CRC-CCITT校验码(16位的x16+x12+x5+1)
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
For i = Begnum To Endnum
Tmp = Hex2Bin(Hex(crc)) 'crc的高四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
da = CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4)))
Tmp = Hex2Bin(Hex(crc)) 'crc向左移四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
crc = CLng("&H" & Bin2Hex(Right(Tmp, 12) & "0000"))
Tmp = Hex2Bin(Hex(byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)
Do Until Len(Tmp) = 8
Tmp = "0" & Tmp
Loop
crc = crc Xor CLng("&H" & Hex(Ccitt(Val(da) Xor CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4))))))
Tmp = Hex2Bin(Hex(crc)) 'crc的高四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
da = CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4)))
Tmp = Hex2Bin(Hex(crc)) 'crc向左移四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
crc = CLng("&H" & Bin2Hex(Right(Tmp, 12) & "0000"))
'crc = crc xor ccitt(da xor（byout(i) and &HOF）)
crc = crc Xor CLng("&H" & Hex(Ccitt(Val(da) Xor (byout(i) And 15))))
Next
Checkout_ccitt = ""
For i = Len(Hex(crc)) To 4 - 1
Checkout_ccitt = Checkout_ccitt & "0"
Next
Checkout_ccitt = Checkout_ccitt & Hex(crc)
End Function
Function Ccitt(ind As Integer)
Ccitt = Choose(ind + 1, &H0, &H1021, &H2042, &H3063, &H4084, &H50A5, &H60C6, _
&H70E7, &H8108, &H9129, &HA14A, &HB16B, &HC18C, &HD1AD, &HE1CE, &HF1EF)
End Function
Function Hex2Bin(HexValue As String) As String
Const BinIndexTable = "0000000100100011010001010110011110001001101010111100110111101111"
Dim n As Integer
Dim Tmp As String
Tmp = ""
For n = 1 To Len(HexValue)
Tmp = Tmp + Mid(BinIndexTable, _
(Val("&H" + Mid(HexValue, n, 1)) * 4 + 1), 4)
Next
Hex2Bin = Tmp
End Function
Function Bin2Hex(BinValue As String) As String
Dim Tmp As Integer, n As Integer
Do Until Len(BinValue) Mod 4 = 0
BinValue = "0" & BinValue
Loop
Bin2Hex = ""
For n = 1 To Len(BinValue) Step 4
Tmp = 0
If Mid(BinValue, n, 1) = "1" Then Tmp = 8
If Mid(BinValue, n + 1, 1) = "1" Then Tmp = Tmp + 4
If Mid(BinValue, n + 2, 1) = "1" Then Tmp = Tmp + 2
If Mid(BinValue, n + 3, 1) = "1" Then Tmp = Tmp + 1
Bin2Hex = Bin2Hex & Hex(Tmp)
Next
End Function
测试成功
Dim byout() As Byte
Private Sub Command1_Click()
Dim i As Long
ReDim byout(1 To Len(Text1.Text) / 2)
For i = 1 To Len(Text1.Text) / 2
byout(i) = "&H" & Mid(Text1.Text, 2 * i - 1, 2)
Next
Text2.Text = Checkout_ccitt(1, UBound(byout))
End Sub
'计算byout(begnum)到byout(endnum) 的CRC-CCITT校验码(16位的x16+x12+x5+1)
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
For i = Begnum To Endnum
Tmp = Hex2Bin(Hex(crc)) 'crc的高四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
da = CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4)))
Tmp = Hex2Bin(Hex(crc)) 'crc向左移四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
crc = CLng("&H" & Bin2Hex(Right(Tmp, 12) & "0000"))
Tmp = Hex2Bin(Hex(byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)
Do Until Len(Tmp) = 8
Tmp = "0" & Tmp
Loop
crc = crc Xor CLng("&H" & Hex(Ccitt(Val(da) Xor CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4))))))
Tmp = Hex2Bin(Hex(crc)) 'crc的高四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
da = CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4)))
Tmp = Hex2Bin(Hex(crc)) 'crc向左移四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
crc = CLng("&H" & Bin2Hex(Right(Tmp, 12) & "0000"))
'crc = crc xor ccitt(da xor（byout(i) and &HOF）)
crc = crc Xor CLng("&H" & Hex(Ccitt(Val(da) Xor (byout(i) And 15))))
Next
Checkout_ccitt = ""
For i = Len(Hex(crc)) To 4 - 1
Checkout_ccitt = Checkout_ccitt & "0"
Next
Checkout_ccitt = Checkout_ccitt & Hex(crc)
End Function
Function Ccitt(ind As Integer)
Ccitt = Choose(ind + 1, &H0, &H1021, &H2042, &H3063, &H4084, &H50A5, &H60C6, _
&H70E7, &H8108, &H9129, &HA14A, &HB16B, &HC18C, &HD1AD, &HE1CE, &HF1EF)
End Function
Function Hex2Bin(HexValue As String) As String
Const BinIndexTable = "0000000100100011010001010110011110001001101010111100110111101111"
Dim n As Integer
Dim Tmp As String
Tmp = ""
For n = 1 To Len(HexValue)
Tmp = Tmp + Mid(BinIndexTable, _
(Val("&H" + Mid(HexValue, n, 1)) * 4 + 1), 4)
Next
Hex2Bin = Tmp
End Function
Function Bin2Hex(BinValue As String) As String
Dim Tmp As Integer, n As Integer
Do Until Len(BinValue) Mod 4 = 0
BinValue = "0" & BinValue
Loop
Bin2Hex = ""
For n = 1 To Len(BinValue) Step 4
Tmp = 0
If Mid(BinValue, n, 1) = "1" Then Tmp = 8
If Mid(BinValue, n + 1, 1) = "1" Then Tmp = Tmp + 4
If Mid(BinValue, n + 2, 1) = "1" Then Tmp = Tmp + 2
If Mid(BinValue, n + 3, 1) = "1" Then Tmp = Tmp + 1
Bin2Hex = Bin2Hex & Hex(Tmp)
Next
End Function
测试成功
#25
alifriend您好:
我运行的时候系统提示“子程序或函数为定义”
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
这个系统标成黄色的了。
Tmp = Hex2Bin(Hex( byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)
Do Until Len(Tmp) = 8
Tmp = "0" & Tmp
Loop
这个红色是系统加了颜色的。
我把你的代码家进一个模块里了。这样对不？
我运行的时候系统提示“子程序或函数为定义”
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
这个系统标成黄色的了。
Tmp = Hex2Bin(Hex( byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)
Do Until Len(Tmp) = 8
Tmp = "0" & Tmp
Loop
这个红色是系统加了颜色的。
我把你的代码家进一个模块里了。这样对不？
#26
错了，只有这个
byout是加了深色的，没有后边这个（i）
#27
在窗体的通用处定义
Dim byout() As Byte
Dim byout() As Byte
#28
alifriend您好:
然后我又在你的这个里边
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
添加了这个
Dim byout() As Byte
然后再运行的时候系统提示我“下标越界”
然后系统把这句 Tmp = Hex2Bin(Hex(byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)给标成黄色的了。
然后我又在你的这个里边
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
添加了这个
Dim byout() As Byte
然后再运行的时候系统提示我“下标越界”
然后系统把这句 Tmp = Hex2Bin(Hex(byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)给标成黄色的了。
#29
在窗体的通用处定义
Dim byout() As Byte
这个我已经添加了，而且在调用的模块了也添加了。
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
Dim byout() As Byte
现在系统就提示我上边的错误，说是下标越界。
Dim byout() As Byte
这个我已经添加了，而且在调用的模块了也添加了。
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
Dim byout() As Byte
现在系统就提示我上边的错误，说是下标越界。
#30
请在窗体的通用处添加，不要在过程里添加！OMG……
#31
Dim byout() As Byte
这个代码我就是添加在了通用处了阿？
Private Sub Command1_Click()
Dim i As Long
ReDim byout(1 To Len(Text1.Text) / 2)
For i = 1 To Len(Text1.Text) / 2
byout(i) = "&H" & Mid(Text1.Text, 2 * i - 1, 2)
Next
Text2.Text = Checkout_ccitt(1, UBound(byout))
End Sub
上边的就是我现在用的代码阿，过程里没有啊！
这个代码我就是添加在了通用处了阿？
Private Sub Command1_Click()
Dim i As Long
ReDim byout(1 To Len(Text1.Text) / 2)
For i = 1 To Len(Text1.Text) / 2
byout(i) = "&H" & Mid(Text1.Text, 2 * i - 1, 2)
Next
Text2.Text = Checkout_ccitt(1, UBound(byout))
End Sub
上边的就是我现在用的代码阿，过程里没有啊！
#32
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
Dim byout() As Byte
红色这句不要！哪有一个变量定义两次的
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
Dim byout() As Byte
红色这句不要！哪有一个变量定义两次的
#33
我已经去了你标红色的那个了，现在有出现这个问题了。
我运行的时候系统提示“子程序或函数为定义”
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
这个系统标成黄色的了。
Tmp = Hex2Bin(Hex( byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)
Do Until Len(Tmp) = 8
Tmp = "0" & Tmp
Loop
这个红色是系统加了颜色的。
我运行的时候系统提示“子程序或函数为定义”
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
这个系统标成黄色的了。
Tmp = Hex2Bin(Hex( byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)
Do Until Len(Tmp) = 8
Tmp = "0" & Tmp
Loop
这个红色是系统加了颜色的。
#34
是Tmp = Hex2Bin(Hex(byout(i)))这一行吗
请再次确认Function Hex2Bin(HexValue As String) As String 这个函数有复制进去
请确认下面这行定义在通用处
Dim byout() As Byte
请再次确认Function Hex2Bin(HexValue As String) As String 这个函数有复制进去
请确认下面这行定义在通用处
Dim byout() As Byte
#35
您有QQ吗，我用截图给你看。这个我不会用。我的代码全是COPY你的进来的。
#36
这些代码我都放在VB的模块内了。
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
For i = Begnum To Endnum
Tmp = Hex2Bin(Hex(crc)) 'crc的高四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
da = CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4)))
Tmp = Hex2Bin(Hex(crc)) 'crc向左移四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
crc = CLng("&H" & Bin2Hex(Right(Tmp, 12) & "0000"))
Tmp = Hex2Bin(Hex(byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)
Do Until Len(Tmp) = 8
Tmp = "0" & Tmp
Loop
crc = crc Xor CLng("&H" & Hex(Ccitt(Val(da) Xor CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4))))))
Tmp = Hex2Bin(Hex(crc)) 'crc的高四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
da = CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4)))
Tmp = Hex2Bin(Hex(crc)) 'crc向左移四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
crc = CLng("&H" & Bin2Hex(Right(Tmp, 12) & "0000"))
'crc = crc xor ccitt(da xor（byout(i) and &HOF）)
crc = crc Xor CLng("&H" & Hex(Ccitt(Val(da) Xor (byout(i) And 15))))
Next
Checkout_ccitt = ""
For i = Len(Hex(crc)) To 4 - 1
Checkout_ccitt = Checkout_ccitt & "0"
Next
Checkout_ccitt = Checkout_ccitt & Hex(crc)
End Function
Function Ccitt(ind As Integer)
Ccitt = Choose(ind + 1, &H0, &H1021, &H2042, &H3063, &H4084, &H50A5, &H60C6, _
&H70E7, &H8108, &H9129, &HA14A, &HB16B, &HC18C, &HD1AD, &HE1CE, &HF1EF)
End Function
Function Hex2Bin(HexValue As String) As String
Const BinIndexTable = "0000000100100011010001010110011110001001101010111100110111101111"
Dim n As Integer
Dim Tmp As String
Tmp = ""
For n = 1 To Len(HexValue)
Tmp = Tmp + Mid(BinIndexTable, _
(Val("&H" + Mid(HexValue, n, 1)) * 4 + 1), 4)
Next
Hex2Bin = Tmp
End Function
Function Bin2Hex(BinValue As String) As String
Dim Tmp As Integer, n As Integer
Do Until Len(BinValue) Mod 4 = 0
BinValue = "0" & BinValue
Loop
Bin2Hex = ""
For n = 1 To Len(BinValue) Step 4
Tmp = 0
If Mid(BinValue, n, 1) = "1" Then Tmp = 8
If Mid(BinValue, n + 1, 1) = "1" Then Tmp = Tmp + 4
If Mid(BinValue, n + 2, 1) = "1" Then Tmp = Tmp + 2
If Mid(BinValue, n + 3, 1) = "1" Then Tmp = Tmp + 1
Bin2Hex = Bin2Hex & Hex(Tmp)
Next
End Function
下边的代码我都写在窗体下的代码区了
Dim byout() As Byte
Private Sub Command1_Click()
Dim i As Long
ReDim byout(1 To Len(Text1.Text) / 2)
For i = 1 To Len(Text1.Text) / 2
byout(i) = "&H" & Mid(Text1.Text, 2 * i - 1, 2)
Next
Text2.Text = Checkout_ccitt(1, UBound(byout))
End Sub
这就是全部了。
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
For i = Begnum To Endnum
Tmp = Hex2Bin(Hex(crc)) 'crc的高四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
da = CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4)))
Tmp = Hex2Bin(Hex(crc)) 'crc向左移四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
crc = CLng("&H" & Bin2Hex(Right(Tmp, 12) & "0000"))
Tmp = Hex2Bin(Hex(byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)
Do Until Len(Tmp) = 8
Tmp = "0" & Tmp
Loop
crc = crc Xor CLng("&H" & Hex(Ccitt(Val(da) Xor CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4))))))
Tmp = Hex2Bin(Hex(crc)) 'crc的高四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
da = CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4)))
Tmp = Hex2Bin(Hex(crc)) 'crc向左移四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
crc = CLng("&H" & Bin2Hex(Right(Tmp, 12) & "0000"))
'crc = crc xor ccitt(da xor（byout(i) and &HOF）)
crc = crc Xor CLng("&H" & Hex(Ccitt(Val(da) Xor (byout(i) And 15))))
Next
Checkout_ccitt = ""
For i = Len(Hex(crc)) To 4 - 1
Checkout_ccitt = Checkout_ccitt & "0"
Next
Checkout_ccitt = Checkout_ccitt & Hex(crc)
End Function
Function Ccitt(ind As Integer)
Ccitt = Choose(ind + 1, &H0, &H1021, &H2042, &H3063, &H4084, &H50A5, &H60C6, _
&H70E7, &H8108, &H9129, &HA14A, &HB16B, &HC18C, &HD1AD, &HE1CE, &HF1EF)
End Function
Function Hex2Bin(HexValue As String) As String
Const BinIndexTable = "0000000100100011010001010110011110001001101010111100110111101111"
Dim n As Integer
Dim Tmp As String
Tmp = ""
For n = 1 To Len(HexValue)
Tmp = Tmp + Mid(BinIndexTable, _
(Val("&H" + Mid(HexValue, n, 1)) * 4 + 1), 4)
Next
Hex2Bin = Tmp
End Function
Function Bin2Hex(BinValue As String) As String
Dim Tmp As Integer, n As Integer
Do Until Len(BinValue) Mod 4 = 0
BinValue = "0" & BinValue
Loop
Bin2Hex = ""
For n = 1 To Len(BinValue) Step 4
Tmp = 0
If Mid(BinValue, n, 1) = "1" Then Tmp = 8
If Mid(BinValue, n + 1, 1) = "1" Then Tmp = Tmp + 4
If Mid(BinValue, n + 2, 1) = "1" Then Tmp = Tmp + 2
If Mid(BinValue, n + 3, 1) = "1" Then Tmp = Tmp + 1
Bin2Hex = Bin2Hex & Hex(Tmp)
Next
End Function
下边的代码我都写在窗体下的代码区了
Dim byout() As Byte
Private Sub Command1_Click()
Dim i As Long
ReDim byout(1 To Len(Text1.Text) / 2)
For i = 1 To Len(Text1.Text) / 2
byout(i) = "&H" & Mid(Text1.Text, 2 * i - 1, 2)
Next
Text2.Text = Checkout_ccitt(1, UBound(byout))
End Sub
这就是全部了。
#37
把那些过程放在窗体里
#38
这样可以了但是，这样窗体里边的代码太多了，这个不能添加在一个模块里吗，用的时候再调用？
#39
把窗体里的Dim byout() As Byte 去掉
把Public byout() As Byte写在模块里
除了command_click外的那些过程和你一开始一样扔在模块里，OK
把Public byout() As Byte写在模块里
除了command_click外的那些过程和你一开始一样扔在模块里，OK
#40
ok了，好的谢谢你啊！
#41
用在超级终端Xmodem协议CRC16-CCITT里面计算结果是对的
太感谢alifriend，网上测试了很多VB程序，只有你的验证是对的
太感谢alifriend，网上测试了很多VB程序，只有你的验证是对的
#42
这个我也收藏一下.
以后做通讯时用得上.
以后做通讯时用得上.
#43
CONTINUE: 还是没有完全解决
有个问题请教alifriend 或大家
Text2.Text = Checkout_ccitt(1, UBound(byout))
得出的CRC16是text格式的，比如Text2最后的结果显示:70A0
如何把它转换成高低字节的Byte类型十六进制的CRC16Hi CRC16Lo 分别为70 A0 呀?
有个问题请教alifriend 或大家
Text2.Text = Checkout_ccitt(1, UBound(byout))
得出的CRC16是text格式的，比如Text2最后的结果显示:70A0
如何把它转换成高低字节的Byte类型十六进制的CRC16Hi CRC16Lo 分别为70 A0 呀?
#44
不错！
#45
非常感谢啊
#46
太感谢alifriend，CRC问题我在VS.NET里纠结了好几天，一直找不到能用的算法，今天参考alifriend的算法，终于成功了
#47
感谢alifriend大大,你的vb程式碼確認是ok的....
#1
CCITT的东西，以前我做过，晚上回家弄给你
#2
关注
#3
太好了，晚上我在线等你吧，谢谢你。
#4
自己顶顶。
#5
不过我们当时做的是去掉前面和后面的标识符，只算数据体的，也就是
开始符+数据体+二字节校验+结束符
开始符+数据体+二字节校验+结束符
#6
我的是
数据标识 + 帧序号 + 版本号 + 数据段 + CRC校验
1 Byte 2 Bytes 1 Byte 36 Bytes 2 Bytes
一共42个字节，
”010001010001090522110555021234EEEE05110609050000510162060003450200822000000000003050“
上边这段就是我提取完需要做CRC校验的数据，一共42个字节。
数据标识 + 帧序号 + 版本号 + 数据段 + CRC校验
1 Byte 2 Bytes 1 Byte 36 Bytes 2 Bytes
一共42个字节，
”010001010001090522110555021234EEEE05110609050000510162060003450200822000000000003050“
上边这段就是我提取完需要做CRC校验的数据，一共42个字节。
#7
'CRC低位字节值表
Private Function GetCRCLo(ByVal lngIndex As Long) As Integer
GetCRCLo = VBA.Choose(lngIndex + 1, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40)
End Function
'CRC高位字节值表
Private Function GetCRCHi(ByVal lngIndex As Long) As Integer
GetCRCHi = VBA.Choose(lngIndex + 1, _
&H0, &HC0, &HC1, &H1, &HC3, &H3, &H2, &HC2, &HC6, &H6, &H7, &HC7, &H5, &HC5, &HC4, &H4, _
&HCC, &HC, &HD, &HCD, &HF, &HCF, &HCE, &HE, &HA, &HCA, &HCB, &HB, &HC9, &H9, &H8, &HC8, _
&HD8, &H18, &H19, &HD9, &H1B, &HDB, &HDA, &H1A, &H1E, &HDE, &HDF, &H1F, &HDD, &H1D, &H1C, &HDC, _
&H14, &HD4, &HD5, &H15, &HD7, &H17, &H16, &HD6, &HD2, &H12, &H13, &HD3, &H11, &HD1, &HD0, _
&H10, &HF0, &H30, &H31, &HF1, &H33, &HF3, &HF2, &H32, &H36, &HF6, &HF7, &H37, &HF5, &H35, &H34, &HF4, _
&H3C, &HFC, &HFD, &H3D, &HFF, &H3F, &H3E, &HFE, &HFA, &H3A, &H3B, &HFB, &H39, &HF9, &HF8, &H38, _
&H28, &HE8, &HE9, &H29, &HEB, &H2B, &H2A, &HEA, &HEE, &H2E, &H2F, &HEF, &H2D, &HED, &HEC, &H2C, _
&HE4, &H24, &H25, &HE5, &H27, &HE7, &HE6, &H26, &H22, &HE2, &HE3, &H23, &HE1, &H21, &H20, &HE0, _
&HA0, &H60, &H61, &HA1, &H63, &HA3, &HA2, &H62, &H66, &HA6, &HA7, &H67, &HA5, &H65, &H64, &HA4, _
&H6C, &HAC, &HAD, &H6D, &HAF, &H6F, &H6E, &HAE, &HAA, &H6A, &H6B, &HAB, &H69, &HA9, &HA8, &H68, _
&H78, &HB8, &HB9, &H79, &HBB, &H7B, &H7A, &HBA, &HBE, &H7E, &H7F, &HBF, &H7D, &HBD, &HBC, &H7C, _
&HB4, &H74, &H75, &HB5, &H77, &HB7, &HB6, &H76, &H72, &HB2, &HB3, &H73, &HB1, &H71, &H70, &HB0, _
&H50, &H90, &H91, &H51, &H93, &H53, &H52, &H92, &H96, &H56, &H57, &H97, &H55, &H95, &H94, &H54, _
&H9C, &H5C, &H5D, &H9D, &H5F, &H9F, &H9E, &H5E, &H5A, &H9A, &H9B, &H5B, &H99, &H59, &H58, &H98, _
&H88, &H48, &H49, &H89, &H4B, &H8B, &H8A, &H4A, &H4E, &H8E, &H8F, &H4F, &H8D, &H4D, &H4C, &H8C, _
&H44, &H84, &H85, &H45, &H87, &H47, &H46, &H86, &H82, &H42, &H43, &H83, &H41, &H81, &H80, &H40)
End Function
'16码(8位)的校验
Private Function CRC16(ByRef data() As Byte) As String
Dim i As Integer
Dim iIndex As Long
Dim CRC16Hi As Integer '高位
Dim CRC16Lo As Integer '低位
Dim strTemp As String
CRC16Hi = 0
CRC16Lo = 0
'1 以低位值与所传的数据的每一位的十进制值异或(得出高低对照表的索引)
'2 以高位值与所得索引到低位对照表中找出低位值异或(得出低位值)
'3 以所得索引到高位对照表中找出高位值(得出高位值)
'4 循环
'5 将最终的高位与低位值分别转换成十六进制的值
'6 转换成字符串相加(得出CRC校验值)
For i = 0 To UBound(data)
iIndex = CRC16Lo Xor data(i)
CRC16Lo = CRC16Hi Xor GetCRCLo(iIndex) '低位处理
CRC16Hi = GetCRCHi(iIndex) '高位处理
Next i
'得到校验值
strTemp = CStr(Hex(CRC16Hi)) '高位
If VBA.Len(strTemp) = 1 Then
strTemp = "0" & strTemp
End If
CRC16 = strTemp '低位
strTemp = CStr(Hex(CRC16Lo))
If VBA.Len(strTemp) = 1 Then
strTemp = "0" & strTemp
End If
CRC16 = CRC16 & strTemp
End Function
'校验接受的值
Private Function VerifyCRCData() As Boolean
On Error GoTo ErrorLine:
Dim varVerifyCRC() As Byte
Dim varCRC As Variant
Dim intIndex As Integer
Dim SpecialCRC As Variant
Dim i As Integer
VerifyCRCData = False
intIndex = VBA.LenB(mvar_RXData) - 1
If Not (intIndex >= 8) Then
GoTo ErrorLine:
End If
If Not (mvar_RXData(0) = 226 And mvar_RXData(intIndex) = 221) Then
GoTo ErrorLine:
End If
varCRC = CStr(Hex(mvar_RXData(intIndex - 2))) & _
CStr(Hex(mvar_RXData(intIndex - 1)))
If Len(varCRC) <> 4 Then
varCRC = CStr(Format(Hex(mvar_RXData(intIndex - 2)), "00")) & _
CStr(Format(Hex(mvar_RXData(intIndex - 1)), "00"))
varCRC = ""
If Len(varCRC) <> 4 Then
SpecialCRC = Hex(mvar_RXData(intIndex - 2))
If Len(SpecialCRC) = 1 Then
varCRC = "0" & SpecialCRC
Else
varCRC = SpecialCRC
End If
SpecialCRC = Hex(mvar_RXData(intIndex - 1))
If Len(SpecialCRC) = 1 Then
varCRC = varCRC & "0" & SpecialCRC
Else
varCRC = varCRC & SpecialCRC
End If
End If
End If
ReDim varVerifyCRC(intIndex - 3) As Byte
For i = 0 To intIndex - 3
varVerifyCRC(i) = mvar_RXData(i)
Next i
If varCRC = CRC16(varVerifyCRC) Then
VerifyCRCData = True
End If
'VerifyCRCData = True
ErrorLine:
If Err.Number <> 0 Then
Err.Clear
End If
End Function
'接收数据
Private Function RCommand(ByVal Waitting As Single) As Boolean
On Error GoTo ErrorLine:
Dim slgEndTime As Single
RCommand = False
muenum_Status = lngCommErr
' slgEndTime = VBA.Timer + Waitting
'
' Do
' If slgEndTime <= VBA.Timer Then
' Exit Do
' End If
' VBA.DoEvents
' Loop
Sleep 50
If gobj_Comm.InBufferCount > 0 Then '判断有返回值
mvar_RXData = gobj_Comm.Input
' Debug.Print mvar_RXData(3)
'校验数据
If VerifyCRCData() = True Then
muenum_Status = lngNone
RCommand = True
Else
muenum_Status = lngDataErr
End If
End If
ErrorLine:
If Err.Number <> 0 Then
Err.Clear
mvar_RXData = ""
RCommand = False
End If
End Function
CRC16校验接收数据校验部分。利用查表得到
Private Function GetCRCLo(ByVal lngIndex As Long) As Integer
GetCRCLo = VBA.Choose(lngIndex + 1, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40)
End Function
'CRC高位字节值表
Private Function GetCRCHi(ByVal lngIndex As Long) As Integer
GetCRCHi = VBA.Choose(lngIndex + 1, _
&H0, &HC0, &HC1, &H1, &HC3, &H3, &H2, &HC2, &HC6, &H6, &H7, &HC7, &H5, &HC5, &HC4, &H4, _
&HCC, &HC, &HD, &HCD, &HF, &HCF, &HCE, &HE, &HA, &HCA, &HCB, &HB, &HC9, &H9, &H8, &HC8, _
&HD8, &H18, &H19, &HD9, &H1B, &HDB, &HDA, &H1A, &H1E, &HDE, &HDF, &H1F, &HDD, &H1D, &H1C, &HDC, _
&H14, &HD4, &HD5, &H15, &HD7, &H17, &H16, &HD6, &HD2, &H12, &H13, &HD3, &H11, &HD1, &HD0, _
&H10, &HF0, &H30, &H31, &HF1, &H33, &HF3, &HF2, &H32, &H36, &HF6, &HF7, &H37, &HF5, &H35, &H34, &HF4, _
&H3C, &HFC, &HFD, &H3D, &HFF, &H3F, &H3E, &HFE, &HFA, &H3A, &H3B, &HFB, &H39, &HF9, &HF8, &H38, _
&H28, &HE8, &HE9, &H29, &HEB, &H2B, &H2A, &HEA, &HEE, &H2E, &H2F, &HEF, &H2D, &HED, &HEC, &H2C, _
&HE4, &H24, &H25, &HE5, &H27, &HE7, &HE6, &H26, &H22, &HE2, &HE3, &H23, &HE1, &H21, &H20, &HE0, _
&HA0, &H60, &H61, &HA1, &H63, &HA3, &HA2, &H62, &H66, &HA6, &HA7, &H67, &HA5, &H65, &H64, &HA4, _
&H6C, &HAC, &HAD, &H6D, &HAF, &H6F, &H6E, &HAE, &HAA, &H6A, &H6B, &HAB, &H69, &HA9, &HA8, &H68, _
&H78, &HB8, &HB9, &H79, &HBB, &H7B, &H7A, &HBA, &HBE, &H7E, &H7F, &HBF, &H7D, &HBD, &HBC, &H7C, _
&HB4, &H74, &H75, &HB5, &H77, &HB7, &HB6, &H76, &H72, &HB2, &HB3, &H73, &HB1, &H71, &H70, &HB0, _
&H50, &H90, &H91, &H51, &H93, &H53, &H52, &H92, &H96, &H56, &H57, &H97, &H55, &H95, &H94, &H54, _
&H9C, &H5C, &H5D, &H9D, &H5F, &H9F, &H9E, &H5E, &H5A, &H9A, &H9B, &H5B, &H99, &H59, &H58, &H98, _
&H88, &H48, &H49, &H89, &H4B, &H8B, &H8A, &H4A, &H4E, &H8E, &H8F, &H4F, &H8D, &H4D, &H4C, &H8C, _
&H44, &H84, &H85, &H45, &H87, &H47, &H46, &H86, &H82, &H42, &H43, &H83, &H41, &H81, &H80, &H40)
End Function
'16码(8位)的校验
Private Function CRC16(ByRef data() As Byte) As String
Dim i As Integer
Dim iIndex As Long
Dim CRC16Hi As Integer '高位
Dim CRC16Lo As Integer '低位
Dim strTemp As String
CRC16Hi = 0
CRC16Lo = 0
'1 以低位值与所传的数据的每一位的十进制值异或(得出高低对照表的索引)
'2 以高位值与所得索引到低位对照表中找出低位值异或(得出低位值)
'3 以所得索引到高位对照表中找出高位值(得出高位值)
'4 循环
'5 将最终的高位与低位值分别转换成十六进制的值
'6 转换成字符串相加(得出CRC校验值)
For i = 0 To UBound(data)
iIndex = CRC16Lo Xor data(i)
CRC16Lo = CRC16Hi Xor GetCRCLo(iIndex) '低位处理
CRC16Hi = GetCRCHi(iIndex) '高位处理
Next i
'得到校验值
strTemp = CStr(Hex(CRC16Hi)) '高位
If VBA.Len(strTemp) = 1 Then
strTemp = "0" & strTemp
End If
CRC16 = strTemp '低位
strTemp = CStr(Hex(CRC16Lo))
If VBA.Len(strTemp) = 1 Then
strTemp = "0" & strTemp
End If
CRC16 = CRC16 & strTemp
End Function
'校验接受的值
Private Function VerifyCRCData() As Boolean
On Error GoTo ErrorLine:
Dim varVerifyCRC() As Byte
Dim varCRC As Variant
Dim intIndex As Integer
Dim SpecialCRC As Variant
Dim i As Integer
VerifyCRCData = False
intIndex = VBA.LenB(mvar_RXData) - 1
If Not (intIndex >= 8) Then
GoTo ErrorLine:
End If
If Not (mvar_RXData(0) = 226 And mvar_RXData(intIndex) = 221) Then
GoTo ErrorLine:
End If
varCRC = CStr(Hex(mvar_RXData(intIndex - 2))) & _
CStr(Hex(mvar_RXData(intIndex - 1)))
If Len(varCRC) <> 4 Then
varCRC = CStr(Format(Hex(mvar_RXData(intIndex - 2)), "00")) & _
CStr(Format(Hex(mvar_RXData(intIndex - 1)), "00"))
varCRC = ""
If Len(varCRC) <> 4 Then
SpecialCRC = Hex(mvar_RXData(intIndex - 2))
If Len(SpecialCRC) = 1 Then
varCRC = "0" & SpecialCRC
Else
varCRC = SpecialCRC
End If
SpecialCRC = Hex(mvar_RXData(intIndex - 1))
If Len(SpecialCRC) = 1 Then
varCRC = varCRC & "0" & SpecialCRC
Else
varCRC = varCRC & SpecialCRC
End If
End If
End If
ReDim varVerifyCRC(intIndex - 3) As Byte
For i = 0 To intIndex - 3
varVerifyCRC(i) = mvar_RXData(i)
Next i
If varCRC = CRC16(varVerifyCRC) Then
VerifyCRCData = True
End If
'VerifyCRCData = True
ErrorLine:
If Err.Number <> 0 Then
Err.Clear
End If
End Function
'接收数据
Private Function RCommand(ByVal Waitting As Single) As Boolean
On Error GoTo ErrorLine:
Dim slgEndTime As Single
RCommand = False
muenum_Status = lngCommErr
' slgEndTime = VBA.Timer + Waitting
'
' Do
' If slgEndTime <= VBA.Timer Then
' Exit Do
' End If
' VBA.DoEvents
' Loop
Sleep 50
If gobj_Comm.InBufferCount > 0 Then '判断有返回值
mvar_RXData = gobj_Comm.Input
' Debug.Print mvar_RXData(3)
'校验数据
If VerifyCRCData() = True Then
muenum_Status = lngNone
RCommand = True
Else
muenum_Status = lngDataErr
End If
End If
ErrorLine:
If Err.Number <> 0 Then
Err.Clear
mvar_RXData = ""
RCommand = False
End If
End Function
CRC16校验接收数据校验部分。利用查表得到
#8
朋友，这个怎么用啊，这段代码是不要贴到VB的模块里边阿，我上午弄进程序，总有问题。还有就是我看您的代码我不知道在什么地方我需要把我要CRC校验的数据加进去就是（010001010001090522110555021234EEEE05110609050000510162060003450200822000000000003050）
比如这个数据在什么地方加，怎么用，我看的不是很明白，麻烦您给说说吧。谢谢
比如这个数据在什么地方加，怎么用，我看的不是很明白，麻烦您给说说吧。谢谢
#9
放什么位置由你决定，一般来说我放在模块中。你需要把函数Private Function VerifyCRCData() As Boolean 改成Private Function VerifyCRCData(byval RecStr as byte) As Boolean RecStr 是你需要做校验的数据。还有把intIndex = VBA.LenB(mvar_RXData) - 1
该为IntIndex=vba.LenB(RecStr)-1
该为IntIndex=vba.LenB(RecStr)-1
#10
给你提供一个小工具
http://download.csdn.net/source/862973
http://download.csdn.net/source/862973
#11
放什么位置由你决定，一般来说我放在模块中。你需要把函数Private Function VerifyCRCData() As Boolean 改成Private Function VerifyCRCData(byval RecStr as byte) As Boolean RecStr 是你需要做校验的数据。还有把intIndex = VBA.LenB(mvar_RXData) - 1
该为IntIndex=vba.LenB(RecStr)-1
*1123你好，我把我的代码给你看看，你帮我看下我在什么地方调用这个CRC校验程序吧，然后怎么负值。
Private Sub Mscomm1_OnComm()
Dim inByte() As Byte, byt As Byte
Dim i As Integer
Dim value() As Byte
Dim w As Long
Dim flag As Boolean
Dim s As String, t As String
Dim l As Long, q As Long, e As Long, v As Long, u As Long, k As Long, n As Long, b As Long, c As Long
Select Case MSComm1.CommEvent
Case comEvReceive
inByte = MSComm1.Input
For i = 0 To UBound(inByte)
If Len(Hex(inByte(i))) = 1 Then
strData = strData & "0" & Hex(inByte(i))
Else
strData = strData & Hex(inByte(i))
End If
Next
Text1.Text = strData
Text17 = Len(strData) '上边是我接收数据的代码
s = strData
ReDim inByte(0 To Len(s) \ 2 - 1) As Byte
For w = 1 To Len(s) Step 2
inByte(w \ 2) = CByte("&H" & Mid(s, w, 2))
Next
flag = False
t = ""
For w = 0 To UBound(inByte)
If Not flag Then
If inByte(w) <> &H10 Then
t = t & Right("0" & Hex(inByte(w)), 2)
Else
flag = True
End If
Else
'01转1081，03转1083，10转1090
Select Case inByte(w)
Case &H81
byt = &H1
Case &H83
byt = &H3
Case &H90
byt = &H10
Case Else
MsgBox "错误的转义字符"
Exit Sub
End Select
t = t & Right("0" & Hex(byt), 2)
flag = False
End If
Next
Debug.Print "结果："; t '到这步是我出来的代码
Text18 = t
strdata1 = Mid(t, 3, 84)
Text19 = strdata1 'strdata1里边的数据就是我要进行CRC校验的数据
'是不应该从这一下就开始调用阿，怎么么调用，麻烦您能把我弄下代码吗？
该为IntIndex=vba.LenB(RecStr)-1
*1123你好，我把我的代码给你看看，你帮我看下我在什么地方调用这个CRC校验程序吧，然后怎么负值。
Private Sub Mscomm1_OnComm()
Dim inByte() As Byte, byt As Byte
Dim i As Integer
Dim value() As Byte
Dim w As Long
Dim flag As Boolean
Dim s As String, t As String
Dim l As Long, q As Long, e As Long, v As Long, u As Long, k As Long, n As Long, b As Long, c As Long
Select Case MSComm1.CommEvent
Case comEvReceive
inByte = MSComm1.Input
For i = 0 To UBound(inByte)
If Len(Hex(inByte(i))) = 1 Then
strData = strData & "0" & Hex(inByte(i))
Else
strData = strData & Hex(inByte(i))
End If
Next
Text1.Text = strData
Text17 = Len(strData) '上边是我接收数据的代码
s = strData
ReDim inByte(0 To Len(s) \ 2 - 1) As Byte
For w = 1 To Len(s) Step 2
inByte(w \ 2) = CByte("&H" & Mid(s, w, 2))
Next
flag = False
t = ""
For w = 0 To UBound(inByte)
If Not flag Then
If inByte(w) <> &H10 Then
t = t & Right("0" & Hex(inByte(w)), 2)
Else
flag = True
End If
Else
'01转1081，03转1083，10转1090
Select Case inByte(w)
Case &H81
byt = &H1
Case &H83
byt = &H3
Case &H90
byt = &H10
Case Else
MsgBox "错误的转义字符"
Exit Sub
End Select
t = t & Right("0" & Hex(byt), 2)
flag = False
End If
Next
Debug.Print "结果："; t '到这步是我出来的代码
Text18 = t
strdata1 = Mid(t, 3, 84)
Text19 = strdata1 'strdata1里边的数据就是我要进行CRC校验的数据
'是不应该从这一下就开始调用阿，怎么么调用，麻烦您能把我弄下代码吗？
#12
Debug.Print "结果："; t '到这步是我出来的代码
Text18 = t
strdata1 = Mid(t, 3, 84)
Text19 = strdata1
在后面调用
if VerifyCRCData(strdata1)=true then
msgbox "校验成功！"
else
msgbox "校验失败！"
end if
Text18 = t
strdata1 = Mid(t, 3, 84)
Text19 = strdata1
在后面调用
if VerifyCRCData(strdata1)=true then
msgbox "校验成功！"
else
msgbox "校验失败！"
end if
#13
Debug.Print "结果："; t '到这步是我出来的代码
Text18 = t
strdata1 = Mid(t, 3, 84)
Text19 = strdata1
在后面调用
if VerifyCRCData(strdata1)=true then
msgbox "校验成功！"
else
msgbox "校验失败！"
end if
你好，你说的在后面调用，是不这个if VerifyCRCData(strdata1)=true then 就是直接调用完以后的结果了。还有我想问您下，我给的这个数据是包含了CRC校验位的两个字节，如果您计算的时候包括CRC两个校验字节，那判断结果应该为0，如果没有判断，那计算结果应该判断得出的两个字节是否等于数据里边的CRC两个校验字节。您是哪种判断？
Text18 = t
strdata1 = Mid(t, 3, 84)
Text19 = strdata1
在后面调用
if VerifyCRCData(strdata1)=true then
msgbox "校验成功！"
else
msgbox "校验失败！"
end if
你好，你说的在后面调用，是不这个if VerifyCRCData(strdata1)=true then 就是直接调用完以后的结果了。还有我想问您下，我给的这个数据是包含了CRC校验位的两个字节，如果您计算的时候包括CRC两个校验字节，那判断结果应该为0，如果没有判断，那计算结果应该判断得出的两个字节是否等于数据里边的CRC两个校验字节。您是哪种判断？
#14
判断检验位是否相等，和你的表达方式不一样。你可以把那个VerifyCRCData函数做成你需要做的判断形势。校验的时候只校验数据，和校验位比较是否相等。
#15
就是您的这个程序，判断完的结果是不为0阿？
对了我刚才用您的程序是系统提示：错误的参数号或无效的属性赋值，为什么啊？
对了我刚才用您的程序是系统提示：错误的参数号或无效的属性赋值，为什么啊？
#16
我一直用这个CRC校验的。没有问题，可能代码有些地方需要你改正。50校验结果吗？
#17
（010001010001090522110555021234EEEE05110609050000510162060003450200822000000000003050）
这段数据里边是3050是CRC校验的字节。
我想问您下，用您的这段CRC校验计算的时候3050参与计算了吗，如果参与了，那就是判断结果是否为0。
如果这个3050没有参与CRC校验计算那得出的结果应该和3050一样。
我刚学，你写的代码很多看不懂，所以最好麻烦您能看看我的要求帮着把您的代码调试一下，看能运行吗。我在我的环境下运行时提示刚才的错误。
这段数据里边是3050是CRC校验的字节。
我想问您下，用您的这段CRC校验计算的时候3050参与计算了吗，如果参与了，那就是判断结果是否为0。
如果这个3050没有参与CRC校验计算那得出的结果应该和3050一样。
我刚学，你写的代码很多看不懂，所以最好麻烦您能看看我的要求帮着把您的代码调试一下，看能运行吗。我在我的环境下运行时提示刚才的错误。
#18
不参与计算的。我现在针对你的数据做下校验处理。
#19
校验的结果不一样。我校验出的数据是3690.
#20
我刚才自己算的结果还是3050。
我现在用的这个程序，可以成功调用，但是也是计算的结果不对，麻烦您能帮我看看这个计算有问题吗？
Public Function CRC_CCITT(data() As Byte) As String
Dim crc As Long
Dim i As Byte, j As Integer
Dim crch As String, crcl As String
crc = 0
For j = LBound(data) To UBound(data)
i = &H80
While (i <> 0)
If (crc And &H8000) <> 0 Then
crc = crc * 2
crc = crc Xor &H1021
Else
crc = crc * 2
End If
If (data(j) And i) <> 0 Then
crc = crc Xor &H1021
End If
i = i / 2
If crc > 65536 Then
crc = crc - 65536
End If
Wend
Next j
crch = Hex(Fix(crc / 256))
If Len(crch) = 1 Then crch = "0 " & crch
crcl = Hex(crc Mod 256)
If Len(crcl) = 1 Then crcl = "0 " & crcl
CRC_CCITT = crch & " " & crcl
End Function
我需要处理的数据存在这个里边strdata1，这个我是这么定义的dim strdata1 as string。用这个程序前是不得先把strdata1 转换成数组阿？
我是这么转数组的
Dim y() As Byte
y = strdata1
Dim f As Integer
f = UBound(y)
Dim g As Integer
For g = 0 To f Step 2
Debug.Print Hex(y(g))
Next g
最后的数组存在y中,不知道我这样操作对不对？
我现在用的这个程序，可以成功调用，但是也是计算的结果不对，麻烦您能帮我看看这个计算有问题吗？
Public Function CRC_CCITT(data() As Byte) As String
Dim crc As Long
Dim i As Byte, j As Integer
Dim crch As String, crcl As String
crc = 0
For j = LBound(data) To UBound(data)
i = &H80
While (i <> 0)
If (crc And &H8000) <> 0 Then
crc = crc * 2
crc = crc Xor &H1021
Else
crc = crc * 2
End If
If (data(j) And i) <> 0 Then
crc = crc Xor &H1021
End If
i = i / 2
If crc > 65536 Then
crc = crc - 65536
End If
Wend
Next j
crch = Hex(Fix(crc / 256))
If Len(crch) = 1 Then crch = "0 " & crch
crcl = Hex(crc Mod 256)
If Len(crcl) = 1 Then crcl = "0 " & crcl
CRC_CCITT = crch & " " & crcl
End Function
我需要处理的数据存在这个里边strdata1，这个我是这么定义的dim strdata1 as string。用这个程序前是不得先把strdata1 转换成数组阿？
我是这么转数组的
Dim y() As Byte
y = strdata1
Dim f As Integer
f = UBound(y)
Dim g As Integer
For g = 0 To f Step 2
Debug.Print Hex(y(g))
Next g
最后的数组存在y中,不知道我这样操作对不对？
#21
CRC得到的东西肯定不参与校验，如我之前所说
只算数据体的，也就是
开始符+数据体+二字节校验+结束符
只算数据体的，也就是
开始符+数据体+二字节校验+结束符
#22
CRC得到的东西肯定不参与校验，如我之前所说
只算数据体的，也就是
开始符+数据体+二字节校验+结束符
那应该是你的数据的格式把，我的数据格式是这样的。
我的是
数据标识 + 帧序号 + 版本号 + 数据段 + CRC校验
1 Byte 2 Bytes 1 Byte 36 Bytes 2 Bytes
如果按你说的校验的时候不带CRC校验码就应该是这样的。
数据标识 + 帧序号 + 版本号 + 数据段
1 Byte 2 Bytes 1 Byte 36 Bytes
如果是这样也可以，这样最后得出的结果应该是和CRC校验的两个字节一样。这样也可以。
只算数据体的，也就是
开始符+数据体+二字节校验+结束符
那应该是你的数据的格式把，我的数据格式是这样的。
我的是
数据标识 + 帧序号 + 版本号 + 数据段 + CRC校验
1 Byte 2 Bytes 1 Byte 36 Bytes 2 Bytes
如果按你说的校验的时候不带CRC校验码就应该是这样的。
数据标识 + 帧序号 + 版本号 + 数据段
1 Byte 2 Bytes 1 Byte 36 Bytes
如果是这样也可以，这样最后得出的结果应该是和CRC校验的两个字节一样。这样也可以。
#23
Public Function CRC_CCITT(data() As Byte) As String
Dim crc As Long
Dim i As Byte, j As Integer
Dim crch As String, crcl As String
crc = 0
For j = LBound(data) To UBound(data)
i = &H80
While (i <> 0)
If (crc And &H8000) <> 0 Then
crc = crc * 2
crc = crc Xor &H1021
Else
crc = crc * 2
End If
If (data(j) And i) <> 0 Then
crc = crc Xor &H1021
End If
i = i / 2
If crc > 65536 Then
crc = crc - 65536
End If
Wend
Next j
crch = Hex(Fix(crc / 256))
If Len(crch) = 1 Then crch = "0 " & crch
crcl = Hex(crc Mod 256)
If Len(crcl) = 1 Then crcl = "0 " & crcl
CRC_CCITT = crch & " " & crcl
End Function
我现在上边的这个CRC的CCITT算法，最后得出的结果是错的，是不是什么地方有错误阿，大家帮我看看吧。
Dim crc As Long
Dim i As Byte, j As Integer
Dim crch As String, crcl As String
crc = 0
For j = LBound(data) To UBound(data)
i = &H80
While (i <> 0)
If (crc And &H8000) <> 0 Then
crc = crc * 2
crc = crc Xor &H1021
Else
crc = crc * 2
End If
If (data(j) And i) <> 0 Then
crc = crc Xor &H1021
End If
i = i / 2
If crc > 65536 Then
crc = crc - 65536
End If
Wend
Next j
crch = Hex(Fix(crc / 256))
If Len(crch) = 1 Then crch = "0 " & crch
crcl = Hex(crc Mod 256)
If Len(crcl) = 1 Then crcl = "0 " & crcl
CRC_CCITT = crch & " " & crcl
End Function
我现在上边的这个CRC的CCITT算法，最后得出的结果是错的，是不是什么地方有错误阿，大家帮我看看吧。
#24
text1的内容为"010001010001090522110555021234EEEE05110609050000510162060003450200822000000000003050"
Dim byout() As Byte
Private Sub Command1_Click()
Dim i As Long
ReDim byout(1 To Len(Text1.Text) / 2)
For i = 1 To Len(Text1.Text) / 2
byout(i) = "&H" & Mid(Text1.Text, 2 * i - 1, 2)
Next
Text2.Text = Checkout_ccitt(1, UBound(byout))
End Sub
'计算byout(begnum)到byout(endnum) 的CRC-CCITT校验码(16位的x16+x12+x5+1)
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
For i = Begnum To Endnum
Tmp = Hex2Bin(Hex(crc)) 'crc的高四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
da = CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4)))
Tmp = Hex2Bin(Hex(crc)) 'crc向左移四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
crc = CLng("&H" & Bin2Hex(Right(Tmp, 12) & "0000"))
Tmp = Hex2Bin(Hex(byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)
Do Until Len(Tmp) = 8
Tmp = "0" & Tmp
Loop
crc = crc Xor CLng("&H" & Hex(Ccitt(Val(da) Xor CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4))))))
Tmp = Hex2Bin(Hex(crc)) 'crc的高四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
da = CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4)))
Tmp = Hex2Bin(Hex(crc)) 'crc向左移四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
crc = CLng("&H" & Bin2Hex(Right(Tmp, 12) & "0000"))
'crc = crc xor ccitt(da xor（byout(i) and &HOF）)
crc = crc Xor CLng("&H" & Hex(Ccitt(Val(da) Xor (byout(i) And 15))))
Next
Checkout_ccitt = ""
For i = Len(Hex(crc)) To 4 - 1
Checkout_ccitt = Checkout_ccitt & "0"
Next
Checkout_ccitt = Checkout_ccitt & Hex(crc)
End Function
Function Ccitt(ind As Integer)
Ccitt = Choose(ind + 1, &H0, &H1021, &H2042, &H3063, &H4084, &H50A5, &H60C6, _
&H70E7, &H8108, &H9129, &HA14A, &HB16B, &HC18C, &HD1AD, &HE1CE, &HF1EF)
End Function
Function Hex2Bin(HexValue As String) As String
Const BinIndexTable = "0000000100100011010001010110011110001001101010111100110111101111"
Dim n As Integer
Dim Tmp As String
Tmp = ""
For n = 1 To Len(HexValue)
Tmp = Tmp + Mid(BinIndexTable, _
(Val("&H" + Mid(HexValue, n, 1)) * 4 + 1), 4)
Next
Hex2Bin = Tmp
End Function
Function Bin2Hex(BinValue As String) As String
Dim Tmp As Integer, n As Integer
Do Until Len(BinValue) Mod 4 = 0
BinValue = "0" & BinValue
Loop
Bin2Hex = ""
For n = 1 To Len(BinValue) Step 4
Tmp = 0
If Mid(BinValue, n, 1) = "1" Then Tmp = 8
If Mid(BinValue, n + 1, 1) = "1" Then Tmp = Tmp + 4
If Mid(BinValue, n + 2, 1) = "1" Then Tmp = Tmp + 2
If Mid(BinValue, n + 3, 1) = "1" Then Tmp = Tmp + 1
Bin2Hex = Bin2Hex & Hex(Tmp)
Next
End Function
测试成功
Dim byout() As Byte
Private Sub Command1_Click()
Dim i As Long
ReDim byout(1 To Len(Text1.Text) / 2)
For i = 1 To Len(Text1.Text) / 2
byout(i) = "&H" & Mid(Text1.Text, 2 * i - 1, 2)
Next
Text2.Text = Checkout_ccitt(1, UBound(byout))
End Sub
'计算byout(begnum)到byout(endnum) 的CRC-CCITT校验码(16位的x16+x12+x5+1)
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
For i = Begnum To Endnum
Tmp = Hex2Bin(Hex(crc)) 'crc的高四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
da = CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4)))
Tmp = Hex2Bin(Hex(crc)) 'crc向左移四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
crc = CLng("&H" & Bin2Hex(Right(Tmp, 12) & "0000"))
Tmp = Hex2Bin(Hex(byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)
Do Until Len(Tmp) = 8
Tmp = "0" & Tmp
Loop
crc = crc Xor CLng("&H" & Hex(Ccitt(Val(da) Xor CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4))))))
Tmp = Hex2Bin(Hex(crc)) 'crc的高四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
da = CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4)))
Tmp = Hex2Bin(Hex(crc)) 'crc向左移四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
crc = CLng("&H" & Bin2Hex(Right(Tmp, 12) & "0000"))
'crc = crc xor ccitt(da xor（byout(i) and &HOF）)
crc = crc Xor CLng("&H" & Hex(Ccitt(Val(da) Xor (byout(i) And 15))))
Next
Checkout_ccitt = ""
For i = Len(Hex(crc)) To 4 - 1
Checkout_ccitt = Checkout_ccitt & "0"
Next
Checkout_ccitt = Checkout_ccitt & Hex(crc)
End Function
Function Ccitt(ind As Integer)
Ccitt = Choose(ind + 1, &H0, &H1021, &H2042, &H3063, &H4084, &H50A5, &H60C6, _
&H70E7, &H8108, &H9129, &HA14A, &HB16B, &HC18C, &HD1AD, &HE1CE, &HF1EF)
End Function
Function Hex2Bin(HexValue As String) As String
Const BinIndexTable = "0000000100100011010001010110011110001001101010111100110111101111"
Dim n As Integer
Dim Tmp As String
Tmp = ""
For n = 1 To Len(HexValue)
Tmp = Tmp + Mid(BinIndexTable, _
(Val("&H" + Mid(HexValue, n, 1)) * 4 + 1), 4)
Next
Hex2Bin = Tmp
End Function
Function Bin2Hex(BinValue As String) As String
Dim Tmp As Integer, n As Integer
Do Until Len(BinValue) Mod 4 = 0
BinValue = "0" & BinValue
Loop
Bin2Hex = ""
For n = 1 To Len(BinValue) Step 4
Tmp = 0
If Mid(BinValue, n, 1) = "1" Then Tmp = 8
If Mid(BinValue, n + 1, 1) = "1" Then Tmp = Tmp + 4
If Mid(BinValue, n + 2, 1) = "1" Then Tmp = Tmp + 2
If Mid(BinValue, n + 3, 1) = "1" Then Tmp = Tmp + 1
Bin2Hex = Bin2Hex & Hex(Tmp)
Next
End Function
测试成功
#25
alifriend您好:
我运行的时候系统提示“子程序或函数为定义”
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
这个系统标成黄色的了。
Tmp = Hex2Bin(Hex( byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)
Do Until Len(Tmp) = 8
Tmp = "0" & Tmp
Loop
这个红色是系统加了颜色的。
我把你的代码家进一个模块里了。这样对不？
我运行的时候系统提示“子程序或函数为定义”
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
这个系统标成黄色的了。
Tmp = Hex2Bin(Hex( byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)
Do Until Len(Tmp) = 8
Tmp = "0" & Tmp
Loop
这个红色是系统加了颜色的。
我把你的代码家进一个模块里了。这样对不？
#26
错了，只有这个
byout是加了深色的，没有后边这个（i）
#27
在窗体的通用处定义
Dim byout() As Byte
Dim byout() As Byte
#28
alifriend您好:
然后我又在你的这个里边
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
添加了这个
Dim byout() As Byte
然后再运行的时候系统提示我“下标越界”
然后系统把这句 Tmp = Hex2Bin(Hex(byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)给标成黄色的了。
然后我又在你的这个里边
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
添加了这个
Dim byout() As Byte
然后再运行的时候系统提示我“下标越界”
然后系统把这句 Tmp = Hex2Bin(Hex(byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)给标成黄色的了。
#29
在窗体的通用处定义
Dim byout() As Byte
这个我已经添加了，而且在调用的模块了也添加了。
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
Dim byout() As Byte
现在系统就提示我上边的错误，说是下标越界。
Dim byout() As Byte
这个我已经添加了，而且在调用的模块了也添加了。
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
Dim byout() As Byte
现在系统就提示我上边的错误，说是下标越界。
#30
请在窗体的通用处添加，不要在过程里添加！OMG……
#31
Dim byout() As Byte
这个代码我就是添加在了通用处了阿？
Private Sub Command1_Click()
Dim i As Long
ReDim byout(1 To Len(Text1.Text) / 2)
For i = 1 To Len(Text1.Text) / 2
byout(i) = "&H" & Mid(Text1.Text, 2 * i - 1, 2)
Next
Text2.Text = Checkout_ccitt(1, UBound(byout))
End Sub
上边的就是我现在用的代码阿，过程里没有啊！
这个代码我就是添加在了通用处了阿？
Private Sub Command1_Click()
Dim i As Long
ReDim byout(1 To Len(Text1.Text) / 2)
For i = 1 To Len(Text1.Text) / 2
byout(i) = "&H" & Mid(Text1.Text, 2 * i - 1, 2)
Next
Text2.Text = Checkout_ccitt(1, UBound(byout))
End Sub
上边的就是我现在用的代码阿，过程里没有啊！
#32
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
Dim byout() As Byte
红色这句不要！哪有一个变量定义两次的
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
Dim byout() As Byte
红色这句不要！哪有一个变量定义两次的
#33
我已经去了你标红色的那个了，现在有出现这个问题了。
我运行的时候系统提示“子程序或函数为定义”
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
这个系统标成黄色的了。
Tmp = Hex2Bin(Hex( byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)
Do Until Len(Tmp) = 8
Tmp = "0" & Tmp
Loop
这个红色是系统加了颜色的。
我运行的时候系统提示“子程序或函数为定义”
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
这个系统标成黄色的了。
Tmp = Hex2Bin(Hex( byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)
Do Until Len(Tmp) = 8
Tmp = "0" & Tmp
Loop
这个红色是系统加了颜色的。
#34
是Tmp = Hex2Bin(Hex(byout(i)))这一行吗
请再次确认Function Hex2Bin(HexValue As String) As String 这个函数有复制进去
请确认下面这行定义在通用处
Dim byout() As Byte
请再次确认Function Hex2Bin(HexValue As String) As String 这个函数有复制进去
请确认下面这行定义在通用处
Dim byout() As Byte
#35
您有QQ吗，我用截图给你看。这个我不会用。我的代码全是COPY你的进来的。
#36
这些代码我都放在VB的模块内了。
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
For i = Begnum To Endnum
Tmp = Hex2Bin(Hex(crc)) 'crc的高四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
da = CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4)))
Tmp = Hex2Bin(Hex(crc)) 'crc向左移四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
crc = CLng("&H" & Bin2Hex(Right(Tmp, 12) & "0000"))
Tmp = Hex2Bin(Hex(byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)
Do Until Len(Tmp) = 8
Tmp = "0" & Tmp
Loop
crc = crc Xor CLng("&H" & Hex(Ccitt(Val(da) Xor CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4))))))
Tmp = Hex2Bin(Hex(crc)) 'crc的高四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
da = CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4)))
Tmp = Hex2Bin(Hex(crc)) 'crc向左移四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
crc = CLng("&H" & Bin2Hex(Right(Tmp, 12) & "0000"))
'crc = crc xor ccitt(da xor（byout(i) and &HOF）)
crc = crc Xor CLng("&H" & Hex(Ccitt(Val(da) Xor (byout(i) And 15))))
Next
Checkout_ccitt = ""
For i = Len(Hex(crc)) To 4 - 1
Checkout_ccitt = Checkout_ccitt & "0"
Next
Checkout_ccitt = Checkout_ccitt & Hex(crc)
End Function
Function Ccitt(ind As Integer)
Ccitt = Choose(ind + 1, &H0, &H1021, &H2042, &H3063, &H4084, &H50A5, &H60C6, _
&H70E7, &H8108, &H9129, &HA14A, &HB16B, &HC18C, &HD1AD, &HE1CE, &HF1EF)
End Function
Function Hex2Bin(HexValue As String) As String
Const BinIndexTable = "0000000100100011010001010110011110001001101010111100110111101111"
Dim n As Integer
Dim Tmp As String
Tmp = ""
For n = 1 To Len(HexValue)
Tmp = Tmp + Mid(BinIndexTable, _
(Val("&H" + Mid(HexValue, n, 1)) * 4 + 1), 4)
Next
Hex2Bin = Tmp
End Function
Function Bin2Hex(BinValue As String) As String
Dim Tmp As Integer, n As Integer
Do Until Len(BinValue) Mod 4 = 0
BinValue = "0" & BinValue
Loop
Bin2Hex = ""
For n = 1 To Len(BinValue) Step 4
Tmp = 0
If Mid(BinValue, n, 1) = "1" Then Tmp = 8
If Mid(BinValue, n + 1, 1) = "1" Then Tmp = Tmp + 4
If Mid(BinValue, n + 2, 1) = "1" Then Tmp = Tmp + 2
If Mid(BinValue, n + 3, 1) = "1" Then Tmp = Tmp + 1
Bin2Hex = Bin2Hex & Hex(Tmp)
Next
End Function
下边的代码我都写在窗体下的代码区了
Dim byout() As Byte
Private Sub Command1_Click()
Dim i As Long
ReDim byout(1 To Len(Text1.Text) / 2)
For i = 1 To Len(Text1.Text) / 2
byout(i) = "&H" & Mid(Text1.Text, 2 * i - 1, 2)
Next
Text2.Text = Checkout_ccitt(1, UBound(byout))
End Sub
这就是全部了。
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
For i = Begnum To Endnum
Tmp = Hex2Bin(Hex(crc)) 'crc的高四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
da = CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4)))
Tmp = Hex2Bin(Hex(crc)) 'crc向左移四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
crc = CLng("&H" & Bin2Hex(Right(Tmp, 12) & "0000"))
Tmp = Hex2Bin(Hex(byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)
Do Until Len(Tmp) = 8
Tmp = "0" & Tmp
Loop
crc = crc Xor CLng("&H" & Hex(Ccitt(Val(da) Xor CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4))))))
Tmp = Hex2Bin(Hex(crc)) 'crc的高四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
da = CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4)))
Tmp = Hex2Bin(Hex(crc)) 'crc向左移四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
crc = CLng("&H" & Bin2Hex(Right(Tmp, 12) & "0000"))
'crc = crc xor ccitt(da xor（byout(i) and &HOF）)
crc = crc Xor CLng("&H" & Hex(Ccitt(Val(da) Xor (byout(i) And 15))))
Next
Checkout_ccitt = ""
For i = Len(Hex(crc)) To 4 - 1
Checkout_ccitt = Checkout_ccitt & "0"
Next
Checkout_ccitt = Checkout_ccitt & Hex(crc)
End Function
Function Ccitt(ind As Integer)
Ccitt = Choose(ind + 1, &H0, &H1021, &H2042, &H3063, &H4084, &H50A5, &H60C6, _
&H70E7, &H8108, &H9129, &HA14A, &HB16B, &HC18C, &HD1AD, &HE1CE, &HF1EF)
End Function
Function Hex2Bin(HexValue As String) As String
Const BinIndexTable = "0000000100100011010001010110011110001001101010111100110111101111"
Dim n As Integer
Dim Tmp As String
Tmp = ""
For n = 1 To Len(HexValue)
Tmp = Tmp + Mid(BinIndexTable, _
(Val("&H" + Mid(HexValue, n, 1)) * 4 + 1), 4)
Next
Hex2Bin = Tmp
End Function
Function Bin2Hex(BinValue As String) As String
Dim Tmp As Integer, n As Integer
Do Until Len(BinValue) Mod 4 = 0
BinValue = "0" & BinValue
Loop
Bin2Hex = ""
For n = 1 To Len(BinValue) Step 4
Tmp = 0
If Mid(BinValue, n, 1) = "1" Then Tmp = 8
If Mid(BinValue, n + 1, 1) = "1" Then Tmp = Tmp + 4
If Mid(BinValue, n + 2, 1) = "1" Then Tmp = Tmp + 2
If Mid(BinValue, n + 3, 1) = "1" Then Tmp = Tmp + 1
Bin2Hex = Bin2Hex & Hex(Tmp)
Next
End Function
下边的代码我都写在窗体下的代码区了
Dim byout() As Byte
Private Sub Command1_Click()
Dim i As Long
ReDim byout(1 To Len(Text1.Text) / 2)
For i = 1 To Len(Text1.Text) / 2
byout(i) = "&H" & Mid(Text1.Text, 2 * i - 1, 2)
Next
Text2.Text = Checkout_ccitt(1, UBound(byout))
End Sub
这就是全部了。
#37
把那些过程放在窗体里
#38
这样可以了但是，这样窗体里边的代码太多了，这个不能添加在一个模块里吗，用的时候再调用？
#39
把窗体里的Dim byout() As Byte 去掉
把Public byout() As Byte写在模块里
除了command_click外的那些过程和你一开始一样扔在模块里，OK
把Public byout() As Byte写在模块里
除了command_click外的那些过程和你一开始一样扔在模块里，OK
#40
ok了，好的谢谢你啊！
#41
用在超级终端Xmodem协议CRC16-CCITT里面计算结果是对的
太感谢alifriend，网上测试了很多VB程序，只有你的验证是对的
太感谢alifriend，网上测试了很多VB程序，只有你的验证是对的
#42
这个我也收藏一下.
以后做通讯时用得上.
以后做通讯时用得上.
#43
CONTINUE: 还是没有完全解决
有个问题请教alifriend 或大家
Text2.Text = Checkout_ccitt(1, UBound(byout))
得出的CRC16是text格式的，比如Text2最后的结果显示:70A0
如何把它转换成高低字节的Byte类型十六进制的CRC16Hi CRC16Lo 分别为70 A0 呀?
有个问题请教alifriend 或大家
Text2.Text = Checkout_ccitt(1, UBound(byout))
得出的CRC16是text格式的，比如Text2最后的结果显示:70A0
如何把它转换成高低字节的Byte类型十六进制的CRC16Hi CRC16Lo 分别为70 A0 呀?
#44
不错！
#45
非常感谢啊
#46
太感谢alifriend，CRC问题我在VS.NET里纠结了好几天，一直找不到能用的算法，今天参考alifriend的算法，终于成功了
#47
感谢alifriend大大,你的vb程式碼確認是ok的....