form1.frm

crc快速校验程序,对于新手很快就能看懂的,结合实际读一读友好处!

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H00C0FFFF&
   Caption         =   "Modbus RTU CRC校验"
   ClientHeight    =   2520
   ClientLeft      =   60
   ClientTop       =   645
   ClientWidth     =   5400
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   2520
   ScaleWidth      =   5400
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command3 
      Caption         =   "清   除"
      Height          =   375
      Left            =   2160
      TabIndex        =   15
      Top             =   1800
      Width           =   975
   End
   Begin VB.CommandButton Command2 
      Caption         =   "退  出"
      Height          =   375
      Left            =   3840
      TabIndex        =   14
      Top             =   1800
      Width           =   975
   End
   Begin VB.TextBox Text9 
      Appearance      =   0  'Flat
      ForeColor       =   &H000000FF&
      Height          =   270
      Left            =   4440
      TabIndex        =   13
      Top             =   1200
      Width           =   735
   End
   Begin VB.TextBox Text8 
      Appearance      =   0  'Flat
      ForeColor       =   &H000000FF&
      Height          =   270
      Left            =   2760
      TabIndex        =   12
      Top             =   1185
      Width           =   735
   End
   Begin VB.TextBox Text7 
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   1080
      TabIndex        =   11
      Top             =   1200
      Width           =   735
   End
   Begin VB.TextBox Text6 
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   4440
      TabIndex        =   9
      Top             =   600
      Width           =   735
   End
   Begin VB.TextBox Text5 
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   3600
      TabIndex        =   8
      Top             =   600
      Width           =   735
   End
   Begin VB.TextBox Text4 
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   2760
      TabIndex        =   7
      Top             =   600
      Width           =   735
   End
   Begin VB.TextBox Text3 
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   1920
      TabIndex        =   6
      Top             =   600
      Width           =   735
   End
   Begin VB.TextBox Text2 
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   1080
      TabIndex        =   5
      Top             =   600
      Width           =   735
   End
   Begin VB.TextBox Text1 
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   240
      TabIndex        =   1
      Text            =   "01"
      Top             =   600
      Width           =   735
   End
   Begin VB.CommandButton Command1 
      Caption         =   "生  成"
      Height          =   375
      Left            =   480
      TabIndex        =   0
      Top             =   1800
      Width           =   975
   End
   Begin VB.Label Label2 
      BackColor       =   &H00C0FFFF&
      Caption         =   "地址"
      ForeColor       =   &H00FF0000&
      Height          =   255
      Left            =   240
      TabIndex        =   10
      Top             =   240
      Width           =   615
   End
   Begin VB.Label Label4 
      BackColor       =   &H00C0FFFF&
      Caption         =   "校验低位"
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   1920
      TabIndex        =   4
      Top             =   1260
      Width           =   735
   End
   Begin VB.Label Label3 
      BackColor       =   &H00C0FFFF&
      Caption         =   "校验高位"
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   3600
      TabIndex        =   3
      Top             =   1260
      Width           =   735
   End
   Begin VB.Label Label5 
      BackColor       =   &H00C0FFFF&
      Caption         =   "生成结果"
      Height          =   255
      Left            =   240
      TabIndex        =   2
      Top             =   1260
      Width           =   735
   End
   Begin VB.Menu About 
      Caption         =   "关于"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub About_Click()
frmAbout.Show
End Sub

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

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Command3_Click()              '清除信息
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""

End Sub

Private Sub Text1_LostFocus()
    If (Text1.Text < 0) Then
        Text1.Text = O
    End If
    
If (Text1.Text > 255) Then
        Text1.Text = 255
    End If
End Sub