下面是運(yùn)行界面，采集的模塊的地址為75，是一個溫濕度采集模塊。有3個寄存器，顯示的數(shù)據(jù)上是溫度，濕度，露點(diǎn)溫度。

        
modbus

Private Sub Command1_Click() '設(shè)置按鈕
        Dim bisend() As Byte
        Dim crc
        Dim btLoCRC As Byte, btHiCRC As Byte
        Dim Data As Integer
    If MSComm1.PortOpen = True Then
       If Combo5.ListIndex = 0 Then
         ReDim bisend(7) '重新定義數(shù)組長度
         bisend(0) = "&h" + Hex(Val(Text1.Text))   '地址碼
         bisend(1) = "&h" + Hex(3)  '功能碼   讀寄存器
         bisend(2) = "&h" + Hex(0) '起始地址高位
         bisend(3) = "&h" + Hex(0)  '起始地址低位
         bisend(4) = "&h" + Hex(0)  '寄存器個數(shù)高位
         bisend(5) = "&h" + Hex(Combo6.ListIndex + 1) '寄存器個數(shù)低位
         crc = CRC16(bisend, 6, btLoCRC, btHiCRC)
         bisend(6) = "&h" + Hex(btLoCRC)  'CRC高位
         bisend(7) = "&h" + Hex(btHiCRC) 'CRC低位
         '發(fā)送數(shù)據(jù)
         MSComm1.Output = bisend
       Else
        ReDim bisend(10) '一次只能寫一個寄存器
        bisend(0) = "&h" + Hex(Val(Text1.Text))   '地址碼
        bisend(1) = "&h" + Hex(16)  '功能碼  寫寄存器
        bisend(2) = "&h" + Hex(0)  '起始地址高位
        bisend(3) = "&h" + Hex(0) '起始地址低位
        bisend(4) = "&h" + Hex(0)     '寄存器個數(shù)高位
        bisend(5) = "&h" + Hex(1)     '寄存器個數(shù)低位
        bisend(6) = "&h" + Hex(2)    '字節(jié)數(shù)
        Data = Val(Trim(Text3.Text))
        bisend(7) = "&h" + Hex(Data \ 256) '要寫入寄存器的值的高字節(jié)
        bisend(8) = "&h" + Hex(Data Mod 256) '要寫入寄存器的值的低字節(jié)
        crc = CRC16(bisend, 9, btLoCRC, btHiCRC)
        bisend(9) = "&h" + Hex(btLoCRC) 'CRC高位
        bisend(10) = "&h" + Hex(btHiCRC) 'CRC低位
        MSComm1.Output = bisend
       End If
   Else
     MsgBox "串口沒有打開"
  End If
End Sub

Private Sub Command2_Click() '實(shí)時采集按鈕
Timer1.Enabled = Not Timer1.Enabled  '進(jìn)行狀態(tài)切換
End Sub

Private Sub Command3_Click()
'初始化，并打開串口
With MSComm1
     If .PortOpen = False Then
     .CommPort = Combo7.ListIndex + 1  '打開串口1
     .Settings = Combo1.Text + "," + Combo2.Text + "," + Combo3.Text + Combo4.Text
     .bbbbbMode = 1
     .bbbbbLen = 50                '一次性從接收緩沖區(qū)中讀取所有數(shù)據(jù)(8個字節(jié)為一組??！)
     .InBufferCount = 0                                 '清空接收緩沖區(qū)
     .OutBufferCount = 0                               '清空發(fā)送緩沖區(qū)
     .RThreshold = 5 + (Combo6.ListIndex + 1) * 2
     .InBufferSize = 1024
     .OutBufferSize = 1024
    
     .PortOpen = True
    Else
     MsgBox "串口已經(jīng)打開"
    End If
End With

End Sub

Private Sub Command4_Click() '關(guān)閉串口按鈕
If MSComm1.PortOpen = True Then
   MSComm1.PortOpen = False
End If
End Sub

Private Sub bbbb_Load()
Dim i As Integer
 
'波特率設(shè)置

Combo1.AddItem "4800", 0
Combo1.AddItem "9600", 1
Combo1.AddItem "115200", 2

'校驗(yàn)位設(shè)置

Combo2.AddItem "N", 0
Combo2.AddItem "E", 1
Combo2.AddItem "O", 2

'數(shù)據(jù)位設(shè)置

Combo3.AddItem "7", 0
Combo3.AddItem "8", 1

'停止位設(shè)置

Combo4.AddItem "1", 0
Combo4.AddItem "2", 1

'功能碼選擇

Combo5.AddItem "讀寄存器03", 0
Combo5.AddItem "寫寄存器16", 1

'寄存器個數(shù)設(shè)置
 Combo6.AddItem "1", 0
 Combo6.AddItem "2", 1
 Combo6.AddItem "3", 2
 Combo6.AddItem "4", 3
  Combo6.AddItem "5", 4
 Combo6.AddItem "6", 5
 Combo6.AddItem "7", 6
 Combo6.AddItem "8", 7
 Combo6.AddItem "9", 8
 Combo6.AddItem "10", 9
  Combo6.AddItem "11", 10
 Combo6.AddItem "12", 11
 Combo6.AddItem "13", 12
 Combo6.AddItem "14", 13
  Combo6.AddItem "15", 14
 Combo6.AddItem "16", 15
 Combo6.AddItem "17", 16
 Combo6.AddItem "18", 17
 Combo6.AddItem "19", 18
 Combo6.AddItem "20", 19
  Combo6.AddItem "21", 20
 Combo6.AddItem "22", 21
 '串口選擇
 
 Combo7.AddItem "串口1", 0
 Combo7.AddItem "串口2", 1
 Combo7.AddItem "串口3", 2
 Combo7.AddItem "串口4", 3
 
'初始賦值

Combo1.ListIndex = 1
Combo2.ListIndex = 1
Combo3.ListIndex = 1
Combo4.ListIndex = 0
Combo5.ListIndex = 0
Combo6.ListIndex = 2
Combo7.ListIndex = 0
'初始化串口
End Sub

Private Sub bbbb_Unload(Cancel As Integer)
If MSComm1.PortOpen = True Then
   MSComm1.PortOpen = False
End If
End Sub

Private Sub MSComm1_OnComm()
Dim INByte() As Byte
Dim Buf As bbbbbb
Dim btLoCRC As Byte, btHiCRC As Byte
Dim Data As Integer
If MSComm1.CommEvent = comEvReceive Then       '接收到數(shù)據(jù)以后
  INByte = MSComm1.bbbbb
    If INByte(1) = 3 Then '讀寄存器
       'CRC校驗(yàn)
      crc = CRC16(INByte, UBound(INByte) - LBound(INByte) - 1, btLoCRC, btHiCRC)
      If INByte(UBound(INByte) - 1) = btLoCRC And INByte(UBound(INByte)) = btHiCRC Then
                   '校驗(yàn)正確
       '////////////////////////////////////
        For i = 3 To UBound(INByte) - 2 Step 2
        Data = "&h" + Hex(INByte(i)) + Hex(INByte(i + 1))
      ' Buf = Buf + Hex(INByte(i)) + Chr(32)
        Buf = Buf + Str(Data)    '轉(zhuǎn)換為十進(jìn)制顯示
        Next i
        List1.AddItem Buf
       End If
    End If
  MSComm1.InBufferCount = 0  '請緩存
 
End If
End Sub

Private Sub Timer1_Timer()
'定時發(fā)送命令
 Dim tbisend(7) As Byte
 Dim crc                 '定時1s
 Dim btLoCRC As Byte, btHiCRC As Byte
 Dim Buf As bbbbbb
      If MSComm1.PortOpen = True Then
         tbisend(0) = "&h" + Hex(Val(Text1.Text)) '地址碼
         tbisend(1) = "&h" + Hex(3)  '功能碼   讀寄存器
         tbisend(2) = "&h" + Hex(0)  '起始地址高位
         tbisend(3) = "&h" + Hex(0)  '起始地址低位
         tbisend(4) = "&h" + Hex(0)  '寄存器個數(shù)高位
         tbisend(5) = "&h" + Hex(Combo6.ListIndex + 1) '寄存器個數(shù)低位
         crc = CRC16(tbisend, 6, btLoCRC, btHiCRC)
         tbisend(6) = "&h" + Hex(btLoCRC) 'CRC高位
         tbisend(7) = "&h" + Hex(btHiCRC) 'CRC低位
         '發(fā)送數(shù)據(jù)
         MSComm1.Output = tbisend
      End If
End Sub

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

Function CRC16(Data() As Byte, no As Integer, CRC16Lo As Byte, CRC16Hi As Byte) As bbbbbb
   
      Dim CL As Byte, CH As Byte                '多項(xiàng)式碼&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 no - 1

        CRC16Lo = CRC16Lo Xor Data(i) '每一個數(shù)據(jù)與CRC寄存器進(jìn)行異或

        For Flag = 0 To 7

          SaveHi = CRC16Hi

          SaveLo = CRC16Lo

          CRC16Hi = CRC16Hi \ 2            '高位右移一位

          CRC16Lo = CRC16Lo \ 2            '低位右移一位

          If ((SaveHi And &H1) = &H1) Then '如果高位字節(jié)最后一位為1

            CRC16Lo = CRC16Lo Or &H80      '則低位字節(jié)右移后前面補(bǔ)1

          End If                           '否則自動補(bǔ)0

          If ((SaveLo And &H1) = &H1) Then '如果LSB為1，則與多項(xiàng)式碼進(jìn)行異或

            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

'CRC低位字節(jié)值表
Function GetCRCLo(ind As Long) As Byte
 
 GetCRCLo = Choose(ind + 1, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, _
                            &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, &HC1, &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, &H81, &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高位字節(jié)值表
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, &O33, &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