--------------------------------- CRC16 位校验和 CRC8位校验的算法------------------------------------------ Public Function CRC16(X As Variant, m As Integer) 'X为要校验的字节， 为要校验的X的字节长度 Dim Hi16, Lo16 As Variant Hi16 = Array(&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) Lo16 = Array(&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) '============================================================== Dim Sr() As Byte On Error Resume Next Ch = &HFF: Cl = &HFF Sr = X For i = 1 To m jj = Ch Xor Sr(i) Ch = Cl Xor Hi16(jj) Cl = Lo16(jj) Next i End Function -------------------------------------------------------------------------------------------------------------------------------- ******************************************************************************************************************************** -------------------------------------------------------------------------------------------------------------------------------- Public Function Crc8(X As Variant) Dim Hi8 As Variant Dim Sr() As Byte dim i as integer Hi8 = Array(&H0, &H7, &HE, &H9, &H1C, &H1B, &H12, &H15, &H38, &H3F, &H36, &H31, &H24, &H23, &H2A, &H2D, _ &H70, &H77, &H7E, &H79, &H6C, &H6B, &H62, &H65, &H48, &H4F, &H46, &H41, &H54, &H53, &H5A, &H5D, _ &HE0, &HE7, &HEE, &HE9, &HFC, &HFB, &HF2, &HF5, &HD8, &HDF, &HD6, &HD1, &HC4, &HC3, &HCA, &HCD, _ &H90, &H97, &H9E, &H99, &H8C, &H8B, &H82, &H85, &HA8, &HAF, &HA6, &HA1, &HB4, &HB3, &HBA, &HBD, _ &HC7, &HC0, &HC9, &HCE, &HDB, &HDC, &HD5, &HD2, &HFF, &HF8, &HF1, &HF6, &HE3, &HE4, &HED, &HEA, _ &HB7, &HB0, &HB9, &HBE, &HAB, &HAC, &HA5, &HA2, &H8F, &H88, &H81, &H86, &H93, &H94, &H9D, &H9A, _ &H27, &H20, &H29, &H2E, &H3B, &H3C, &H35, &H32, &H1F, &H18, &H11, &H16, &H3, &H4, &HD, &HA, _ &H57, &H50, &H59, &H5E, &H4B, &H4C, &H45, &H42, &H6F, &H68, &H61, &H66, &H73, &H74, &H7D, &H7A, _ &H89, &H8E, &H87, &H80, &H95, &H92, &H9B, &H9C, &HB1, &HB6, &HBF, &HB8, &HAD, &HAA, &HA3, &HA4, _ &HF9, &HFE, &HF7, &HF0, &HE5, &HE2, &HEB, &HEC, &HC1, &HC6, &HCF, &HC8, &HDD, &HDA, &HD3, &HD4, _ &H69, &H6E, &H67, &H60, &H75, &H72, &H7B, &H7C, &H51, &H56, &H5F, &H58, &H4D, &H4A, &H43, &H44, _ &H19, &H1E, &H17, &H10, &H5, &H2, &HB, &HC, &H21, &H26, &H2F, &H28, &H3D, &H3A, &H33, &H34, _ &H4E, &H49, &H40, &H47, &H52, &H55, &H5C, &H5B, &H76, &H71, &H78, &H7F, &H6A, &H6D, &H64, &H63, _ &H3E, &H39, &H30, &H37, &H22, &H25, &H2C, &H2B, &H6, &H1, &H8, &HF, &H1A, &H1D, &H14, &H13, _ &HAE, &HA9, &HA0, &HA7, &HB2, &HB5, &HBC, &HBB, &H96, &H91, &H98, &H9F, &H8A, &H8D, &H84, &H83, _ &HDE, &HD9, &HD0, &HD7, &HC2, &HC5, &HCC, &HCB, &HE6, &HE1, &HE8, &HEF, &HFA, &HFD, &HF4, &HF3) Sr = X On Error Resume Next i=len(sr) ch8(0)=&H0 for i=1 to n jj=ch8(0) xor sr(i) chr8(0)=hi8(jj) next i ch8(0)=Not ch8(0) end function ' ***---------下面为 CDT协议的举例-----------*** If CdtYk = 1 Then Ch8(0) = &H0 For i = 7 To 11 jj2 = Ch8(0) Xor Sr(i) Ch8(0) = Hi8(jj2) Next i Ch8(0) = Not Ch8(0) Ch8(1) = &H0 For i = 13 To 17 jj2 = Ch8(1) Xor Sr(i) Ch8(1) = Hi8(jj2) Next i Ch8(1) = Not Ch8(1) If SetTime = True Then Ch8(2) = &H0 For i = 19 To 23 jj2 = Ch8(2) Xor Sr(i) Ch8(2) = Hi8(jj2) Next i Ch8(2) = Not Ch8(2) End If Exit Function End If Ch8(0) = &H0 'Debug.Print "************" For i = 6 To 10 jj2 = Ch8(0) Xor Sr(i) Ch8(0) = Hi8(jj2) Next i Ch8(0) = Not Ch8(0) If Ch8(0) <> Sr(11) Then CrcCh8 = False Frmmain.StatusBar1.Panels(3).Text = "CRC检验错误!" CommNow.InBufferCount = 0 CommNow.RThreshold = 6 Exit Function End If 'Debug.Print "===========" 'Debug.Print Ch8(0) Select Case Sr(8) Case 3 ' Debug.Print "************" For j = 0 To 2 Ch8(j + 1) = &H0 For i = 12 + j * 6 To 16 + j * 6 jj2 = Ch8(j + 1) Xor Sr(i) Ch8(j + 1) = Hi8(jj2) ' Debug.Print Sr(i); Next i Ch8(j + 1) = Not Ch8(j + 1) If Ch8(j + 1) <> Sr(17 + j * 6) Then CrcCh8 = False Frmmain.StatusBar1.Panels(3).Text = "CRC检验错误!" CommNow.InBufferCount = 0 CommNow.RThreshold = 6 Exit Function End If ' Debug.Print Ch8(j + 1) Next j Case 10 For j = 0 To 9 Ch8(j + 1) = &H0 For i = 12 + j * 6 To 16 + j * 6 jj2 = Ch8(j + 1) Xor Sr(i) Ch8(j + 1) = Hi8(jj2) ' Debug.Print Sr(i); Next i Ch8(j + 1) = Not Ch8(j + 1) If Ch8(j + 1) <> Sr(17 + j * 6) Then CrcCh8 = False Frmmain.StatusBar1.Panels(3).Text = "CRC检验错误!" CommNow.InBufferCount = 0 CommNow.RThreshold = 6 Exit Function End If 'Debug.Print Ch8(j + 1) Next Case 13 For j = 0 To 12 Ch8(j + 1) = &H0 For i = 12 + j * 6 To 16 + j * 6 jj2 = Ch8(j + 1) Xor Sr(i) Ch8(j + 1) = Hi8(jj2) ' Debug.Print Sr(i); Next i Ch8(j + 1) = Not Ch8(j + 1) If Ch8(j + 1) <> Sr(17 + j * 6) Then CrcCh8 = False Frmmain.StatusBar1.Panels(3).Text = "CRC检验错误!" CommNow.InBufferCount = 0 CommNow.RThreshold = 6 Exit Function End If ' Debug.Print Ch8(j + 1) Next j Case 28 For j = 0 To 27 Ch8(j + 1) = &H0 For i = 12 + j * 6 To 16 + j * 6 jj2 = Ch8(j + 1) Xor Sr(i) Ch8(j + 1) = Hi8(jj2) ' Debug.Print Sr(i); Next i Ch8(j + 1) = Not Ch8(j + 1) If Ch8(j + 1) <> Sr(17 + j * 6) Then CrcCh8 = False Frmmain.StatusBar1.Panels(3).Text = "CRC检验错误!" CommNow.InBufferCount = 0 CommNow.RThreshold = 6 Exit Function End If ' Debug.Print Ch8(j + 1) Next j Case Else End Select CrcCh8 = True End Function