VB Modbus Rtu 读

1）    模块文件：modCRC，其中包含了CRC校验的函数。


'data     待校验的数组名称
'no       数组中元素个数
'btLoCRC  算出的CRC高字节
'btHiCRC  算出的CRC低字节


Public Function CalCRC16Fast(data() As Byte, no As Integer, btLoCRC As Byte, btHiCRC As Byte) As String


      Dim CL As Byte, CH As Byte                '多项式码&HA001
      Dim SaveHi As Byte, SaveLo As Byte
      Dim i As Integer
      Dim Flag As Integer


      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 '如果LSB为1，则与多项式码进行异或
            btLoCRC = btLoCRC Xor CH
            btHiCRC = btHiCRC Xor CL
          End If


        Next Flag


      Next i


      Dim ReturnData(1) As Byte
      ReturnData(0) = btHiCRC              'CRC高位
      ReturnData(1) = btLoCRC              'CRC低位
      
      CalCRC16Fast = ReturnData


    End Function


Public Function CalCRC16Tbl(data() As Byte, no As Integer, btLoCRC As Byte, btHiCRC As Byte) As String


      Dim btLoCRC As Byte
      Dim btHiCRC As Byte


      btLoCRC = &HFF
      btHiCRC = &HFF


      Dim i As Integer
      Dim iIndex As Long


      For i = 0 To (no - 1)


        iIndex = btHiCRC Xor data(i)
        btHiCRC = btLoCRC Xor GetCRCLo(iIndex)        '低位处理
        btLoCRC = GetCRCHi(iIndex)                    '高位处理


      Next i


      Dim ReturnData(1) As Byte


      ReturnData(0) = btHiCRC        'CRC高位
      ReturnData(1) = btLoCRC        'CRC低位
      
      CalCRC16Tbl = ReturnData


End Function




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


      GetCRCLo = Choose(Ind + 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高位字节值表
Function GetCRCHi(Ind As Long) As Byte


      GetCRCHi = Choose(Ind + 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




2）窗体：FORM1，上面放置的控件如下：
Begin VB.Form frmCom 
   Caption         =   "Form1"
   ClientHeight    =   8235
   ClientLeft      =   3885
   ClientTop       =   2250
   ClientWidth     =   6810
   LinkTopic       =   "Form1"
   ScaleHeight     =   8235
   ScaleWidth      =   6810
   Begin VB.TextBox  txtReceive   ‘注：放置接收上来的IB0数据
      Height          =   495
      Left            =   1200
      TabIndex        =   2
      Top             =   2280
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "读取IB0"
      Height          =   495
      Left            =   2760
      TabIndex        =   1
      Top             =   2280
      Width           =   1695
   End
   Begin VB.CommandButton cmdSDO 
      Caption         =   "置位Q1.1"
      Height          =   495
      Left            =   2160
      TabIndex        =   0
      Top             =   3720
      Width           =   1575
   End
   Begin MSCommLib.MSComm ComK3 
      Left            =   480
      Top             =   1080
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
End


① Form_Load事件，在此主要是实现了打开并初始化串口
Private Sub Form_Load()


    With ComK3
        .CommPort = 1
        .Settings = "19200,N,8,1"
        .InputMode = comInputModeBinary  '二进制收发
        .InBufferSize = 512
        .OutBufferSize = 512
        If (Not .PortOpen) Then .PortOpen = True        
    End With


End Sub


② Form_UnLoad事件，在此主要是关闭串口


Private Sub Form_Unload(Cancel As Integer)


    If (ComK3.PortOpen) Then
        ComK3.PortOpen = False
    End If
    
End Sub


③ “置位Q1.1”按钮单击事件


'设置Q1.1为1 
Private Sub cmdSDO_Click()
    Dim btSend(8) As Byte
    btSend(0) = &H1  '目标站号
    btSend(1) = &H5  '功能码
    btSend(2) = &H0  'Q1.1地址（0009）高字节
    btSend(3) = &H9  'Q1.1地址（0009）低字节
    btSend(4) = &HFF '强制值高字节
    btSend(5) = &H0  '强制值低字节


    Dim crc
    Dim btCRCHi As Byte, btCRCLo As Byte
    crc = CalCRC16Fast(btSend, 6, btCRCLo, btCRCHi)
    
    btSend(6) = btCRCHi
    btSend(7) = btCRCLo
    
    ComK3.Output = CVar(btSend)
    
End Sub


④ “读取IB0”按钮单击事件
'查表知I0.0的modbus地址为0000，从I0.0开始读取连续8位
Private Sub Command1_Click()
    
    '发请求
    Dim btSend(8) As Byte
    btSend(0) = &H1  '目标站号
    btSend(1) = &H2  '功能码
    btSend(2) = &H0  'I0.0地址（0000）高字节
    btSend(3) = &H0  'i0.0地址（0000）低字节
    btSend(4) = &H0  '读取个数高字节
    btSend(5) = &H8  '读取个数低字节
    
    Dim crc
    Dim btCRCHi As Byte, btCRCLo As Byte
    crc = CalCRC16Fast(btSend, 6, btCRCLo, btCRCHi)
    
    btSend(6) = btCRCHi
    btSend(7) = btCRCLo


    ComK3.Output = CVar(btSend)
   
   '注意下面编写的接收过程很简单，要编写实际应用的监控程序来说需要更完善
   Dim btReceive As Variant
   With ComK3
      Do
          DoEvents
      Loop Until .InBufferCount = 6
      
      .InputLen = 6
      btReceive = .Input
      If btReceive(1) = &H2 Then '若正确，返回帧的第2个字节为功能码.实际上，此处应首先进行CRC校验
         txtReceive.Text = Hex$(btReceive(3))
      End If
   End With
End Sub