Public Class Form1
    Public data1 As String '待校验的数组名称
    Public Number1 As Long
    Public data2 As String
    Public Number2 As Long
    'no 数组 中元素个数
    'btLoCRC 算出的 CRC高字节
    'btHiCRC 算出的 CRC低字节


    Dim Choose11() As Byte = New Byte() {&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}

    Dim Choose22() As Byte = New Byte() {&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}

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

    End Sub

    Public Function CalCRC16Fast(data() As Byte, no As Integer, btLoCRC As Byte, btHiCRC As Byte) As String
        Dim CL As Byte
        Dim CH As Byte '多项式码 &HAO01
        Dim SaveHi As Byte
        Dim SaveLo As Byte
        Dim i As Integer
        Dim Flag As Integer
        Dim Rlt(2) As Byte
        Dim RltS As String

        btHiCRC = &HFF
        btLoCRC = &HFF
        CL = &H1
        CH = &HA0
        For i = 0 To (no - 1)
            btHiCRC = btHiCRC Xor data(i) '每一个数据 与 CRC寄存器
            For Flag = 0 To 7
                SaveHi = btLoCRC
                SaveLo = btHiCRC
                btLoCRC = btLoCRC \ 2 '高位右移一位
                btHiCRC = btHiCRC \ 2 '低位右移一位
                If ((SaveHi And &H1) = &H1) Then '如果高位字 节最 后一位 为 1
                    btHiCRC = btHiCRC Or &H80 '则低 位字 节右移后前面补 1
                End If '否则 自动补 0
                If ((SaveLo And &H1) = &H1) Then '如果 kSB为 1,则与 多项式码进 行异或
                    btLoCRC = btLoCRC Xor CH
                    btHiCRC = btHiCRC Xor CL
                End If
            Next flag
        Next i


        RltS = HexToString(btHiCRC)
        RltS = RltS + HexToString(btLoCRC)

        Return RltS

    End Function
    Function HexToString(tmp As Byte) As String
        Dim a1 As Integer
        Dim a2 As Integer
        Dim s1 As String
        If (tmp > 16) Then
            a1 = Int(tmp / 16)
        Else
            a1 = 0
        End If
        a2 = tmp Mod 16

        s1 = NumToString(a1) + NumToString(a2)

        Return s1
    End Function
    Function NumToString(a1 As Integer) As String
        Dim s1 As String
        Select Case (a1)
            Case 15
                s1 = "F"
            Case 14
                s1 = "E"
            Case 13
                s1 = "D"
            Case 12
                s1 = "C"
            Case 11
                s1 = "B"
            Case 10
                s1 = "A"
            Case 9
                s1 = Str(a1)
            Case 8
                s1 = Str(a1)
            Case 7
                s1 = Str(a1)
            Case 6
                s1 = Str(a1)
            Case 5
                s1 = Str(a1)
            Case 4
                s1 = Str(a1)
            Case 3
                s1 = Str(a1)
            Case 2
                s1 = Str(a1)
            Case 1
                s1 = Str(a1)
            Case 0
                s1 = Str(a1)
        End Select
        Return s1
    End Function

    'CRC低位字节值表
    Function GetCRCLo(Ind As Long) As Byte

        Return Choose11(Ind + 1)
    End Function
    Private Function GetCRCHi(iIndex As Long) As Byte
        Return Choose22(iIndex + 1)
    End Function

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim btSend(8) As Byte
        Dim tmp As String
        Dim Itmp As Integer

        tmp = Microsoft.VisualBasic.Left(TextBox1.Text, 2)
        Itmp = Int(tmp)
        btSend(0) = CByte(Itmp) '目标站号
        tmp = Microsoft.VisualBasic.Mid(TextBox1.Text, 3, 2)
        Itmp = Int(tmp)
        btSend(1) = CByte(Itmp) '功能码
        tmp = Microsoft.VisualBasic.Mid(TextBox1.Text, 5, 2)
        Itmp = Int(tmp)
        btSend(2) = CByte(Itmp) 'Q1.1地址 (0009)高字节
        tmp = Microsoft.VisualBasic.Mid(TextBox1.Text, 7, 2)
        Itmp = Int(tmp)
        btSend(3) = CByte(Itmp) 'Q1.1地址 (0009)低字节
        tmp = Microsoft.VisualBasic.Mid(TextBox1.Text, 9, 2)
        Itmp = Int(tmp)
        btSend(4) = CByte(Itmp) '强制值高字节
        tmp = Microsoft.VisualBasic.Mid(TextBox1.Text, 11, 2)
        Itmp = Int(tmp)
        btSend(5) = CByte(Itmp) '强制值低字节

        Dim crc
        Dim btCRCHi As Byte, btCRCLo As Byte
        crc = CalCRC16Fast(btSend, 6, btCRCLo, btCRCHi)
        btSend(6) = btCRCHi
        btSend(7) = btCRCLo          
        TextBox8.Text = crc
    End Sub

End Class
 

 

 

 

 

    文章標籤

    程式語言

    全站熱搜

    ㄚ 嬤 發表在 痞客邦 留言(20) 人氣()