VB CRC校验问题 在线等

Question

”010001010001090522110555021234EEEE05110609050000510162060003450200822000000000003050“
如果我想对上面这段数据进行CRC校验，CRC运算的方法是：校验方程为：G(x)=x16+x12+x5+1   初始值为：0我现在要判断我要对例如上面的这段数据进行CRC校验计算，如果计算完的结果为0，就说明我接收到的数据是没有错误的，如果CRC校验计算完结果不为0就说明我接收到的数据里边有错误了，这个我就需要重新接收对方给我发的下一个数据了。
（如果有说的不清楚地地方请问我，如果需要贴上我的代码也请说）谢谢大家帮忙。

Answer 1

CCITT的东西，以前我做过，晚上回家弄给你

Answer 2

我的是
数据标识 + 帧序号 +  版本号  +  数据段 +   CRC校验
1 Byte   2 Bytes 1 Byte    36 Bytes   2 Bytes
一共42个字节，    
”010001010001090522110555021234EEEE05110609050000510162060003450200822000000000003050“
上边这段就是我提取完需要做CRC校验的数据，一共42个字节。

Answer 3

'CRC低位字节值表
Private Function GetCRCLo(ByVal lngIndex As Long) As IntegerGetCRCLo = 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 IntegerGetCRCHi = 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 LongDim 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校验接收数据校验部分。利用查表得到

Answer 4

朋友，这个怎么用啊，这段代码是不要贴到VB的模块里边阿，我上午弄进程序，总有问题。还有就是我看您的代码我不知道在什么地方我需要把我要CRC校验的数据加进去就是（010001010001090522110555021234EEEE05110609050000510162060003450200822000000000003050）
比如这个数据在什么地方加，怎么用，我看的不是很明白，麻烦您给说说吧。谢谢

Answer 5

放什么位置由你决定，一般来说我放在模块中。你需要把函数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

Answer 6

给你提供一个小工具
http://download.csdn.net/source/862973

Answer 7

放什么位置由你决定，一般来说我放在模块中。你需要把函数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 
chenyun1123你好，我把我的代码给你看看，你帮我看下我在什么地方调用这个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校验的数据
                                                 '是不应该从这一下就开始调用阿，怎么么调用，麻烦您能把我弄下代码吗？

Answer 8

Debug.Print "结果："; t                    '到这步是我出来的代码 
        Text18 = t 
        strdata1 = Mid(t, 3, 84) 
        Text19 = strdata1   
在后面调用
if VerifyCRCData(strdata1)=true then
    msgbox "校验成功！"
else
    msgbox "校验失败！"
end if 

Answer 9

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两个校验字节。您是哪种判断？ 

Answer 10

判断检验位是否相等，和你的表达方式不一样。你可以把那个VerifyCRCData函数做成你需要做的判断形势。校验的时候只校验数据，和校验位比较是否相等。

Answer 11

我一直用这个CRC校验的。没有问题，可能代码有些地方需要你改正。50校验结果吗？

Answer 12

（010001010001090522110555021234EEEE05110609050000510162060003450200822000000000003050）
这段数据里边是3050是CRC校验的字节。
我想问您下，用您的这段CRC校验计算的时候3050参与计算了吗，如果参与了，那就是判断结果是否为0。 
如果这个3050没有参与CRC校验计算那得出的结果应该和3050一样。
我刚学，你写的代码很多看不懂，所以最好麻烦您能看看我的要求帮着把您的代码调试一下，看能运行吗。我在我的环境下运行时提示刚才的错误。

Answer 13

我刚才自己算的结果还是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中,不知道我这样操作对不对？

Answer 14

CRC得到的东西肯定不参与校验，如我之前所说
只算数据体的，也就是
开始符+数据体+二字节校验+结束符

Answer 15

CRC得到的东西肯定不参与校验，如我之前所说 
只算数据体的，也就是 
开始符+数据体+二字节校验+结束符那应该是你的数据的格式把，我的数据格式是这样的。
我的是 
数据标识 + 帧序号 +  版本号  +  数据段 +  CRC校验 
1 Byte   2 Bytes  1 Byte    36 Bytes  2 Bytes 
如果按你说的校验的时候不带CRC校验码就应该是这样的。
数据标识 + 帧序号 +  版本号  +  数据段 
1 Byte   2 Bytes  1 Byte    36 Bytes
如果是这样也可以，这样最后得出的结果应该是和CRC校验的两个字节一样。这样也可以。

Answer 16

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算法，最后得出的结果是错的，是不是什么地方有错误阿，大家帮我看看吧。

Answer 17

text1的内容为"010001010001090522110555021234EEEE05110609050000510162060003450200822000000000003050"Dim byout() As BytePrivate 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 FunctionFunction 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测试成功

Answer 18

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
这个红色是系统加了颜色的。
我把你的代码家进一个模块里了。这样对不？

Answer 19

错了，只有这个byout是加了深色的，没有后边这个（i）

Answer 20

在窗体的通用处定义
Dim byout() As Byte 

Answer 21

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)向右移四位)给标成黄色的了。

Answer 22

在窗体的通用处定义 
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 
现在系统就提示我上边的错误，说是下标越界。

Answer 23

请在窗体的通用处添加，不要在过程里添加！OMG……

Answer 24

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
上边的就是我现在用的代码阿，过程里没有啊！

Answer 25

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 
红色这句不要！哪有一个变量定义两次的

Answer 26

我已经去了你标红色的那个了，现在有出现这个问题了。
我运行的时候系统提示“子程序或函数为定义” 
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 
这个红色是系统加了颜色的。

Answer 27

是Tmp = Hex2Bin(Hex(byout(i)))这一行吗
请再次确认Function Hex2Bin(HexValue As String) As String 这个函数有复制进去
请确认下面这行定义在通用处
Dim byout() As Byte

Answer 28

您有QQ吗，我用截图给你看。这个我不会用。我的代码全是COPY你的进来的。

Answer 29

这些代码我都放在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 FunctionFunction 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
这就是全部了。

Answer 30

把窗体里的Dim byout() As Byte 去掉
把Public byout() As Byte写在模块里
除了command_click外的那些过程和你一开始一样扔在模块里，OK

Answer 31

  用在超级终端Xmodem协议CRC16-CCITT里面计算结果是对的
  太感谢alifriend，网上测试了很多VB程序，只有你的验证是对的
 

Answer 32

  CONTINUE:  还是没有完全解决  有个问题请教alifriend 或大家   Text2.Text = Checkout_ccitt(1, UBound(byout))   得出的CRC16是text格式的，比如Text2最后的结果显示:70A0
   
    如何把它转换成高低字节的Byte类型十六进制的CRC16Hi CRC16Lo 分别为70 A0 呀?

Answer 33

太感谢alifriend，CRC问题我在VS.NET里纠结了好几天，一直找不到能用的算法，今天参考alifriend的算法，终于成功了

Answer 34

感谢alifriend大大,你的vb程式碼確認是ok的....