VB实现modbus通信-专业自动化论坛-中国工控网论坛

VB实现modbus通信点击：4196 | 回复：28

精华：5帖
求助：8帖
帖子：141帖 | 5451回
年度积分：0
历史总积分：21609
注册：2006年4月16日

发表于：2011-09-21 21:35:03

楼主

对于初学modbus；通过VB来测试modbus通信；有一点帮助；如果要原代码的话，可以留下邮箱，我给你传过去！

1 Private Sub Command1_Click() ‘设置按钮
2 Dim bisend() As Byte
3 Dim crc
4 Dim btLoCRC As Byte, btHiCRC As Byte
5 Dim Data As Integer
6 If MSComm1.PortOpen = True Then
7 If Combo5.ListIndex = 0 Then
8 ReDim bisend(7) ‘重新定义数组长度
9 bisend(0) = "&h" + Hex(Val(Text1.Text)) ‘地址码
10 bisend(1) = "&h" + Hex(3) ‘功能码读寄存器
11 bisend(2) = "&h" + Hex(0) ‘起始地址高位
12 bisend(3) = "&h" + Hex(0) ‘起始地址低位
13 bisend(4) = "&h" + Hex(0) ‘寄存器个数高位
14 bisend(5) = "&h" + Hex(Combo6.ListIndex + 1) ‘寄存器个数低位
15 crc = CRC16(bisend, 6, btLoCRC, btHiCRC)
16 bisend(6) = "&h" + Hex(btLoCRC) ‘CRC高位
17 bisend(7) = "&h" + Hex(btHiCRC) ‘CRC低位
18 ‘发送数据
19 MSComm1.Output = bisend
20 Else
21 ReDim bisend(10) ‘一次只能写一个寄存器
22 bisend(0) = "&h" + Hex(Val(Text1.Text)) ‘地址码
23 bisend(1) = "&h" + Hex(16) ‘功能码写寄存器
24 bisend(2) = "&h" + Hex(0) ‘起始地址高位
25 bisend(3) = "&h" + Hex(0) ‘起始地址低位
26 bisend(4) = "&h" + Hex(0) ‘寄存器个数高位
27 bisend(5) = "&h" + Hex(1) ‘寄存器个数低位
28 bisend(6) = "&h" + Hex(2) ‘字节数
29 Data = Val(Trim(Text3.Text))
30 bisend(7) = "&h" + Hex(Data \ 256) ‘要写入寄存器的值的高字节
31 bisend(8) = "&h" + Hex(Data Mod 256) ‘要写入寄存器的值的低字节
32 crc = CRC16(bisend, 9, btLoCRC, btHiCRC)
33 bisend(9) = "&h" + Hex(btLoCRC) ‘CRC高位
34 bisend(10) = "&h" + Hex(btHiCRC) ‘CRC低位
35 MSComm1.Output = bisend
36 End If
37 Else
38 MsgBox "串口没有打开"
39 End If
40 End Sub
41 Private Sub Command2_Click() ‘实时采集按钮
42 Timer1.Enabled = Not Timer1.Enabled ‘进行状态切换
43 End Sub
44 Private Sub Command3_Click()
45 ‘初始化，并打开串口
46 With MSComm1
47 If .PortOpen = False Then
48 .CommPort = Combo7.ListIndex + 1 ‘打开串口1
49 .Settings = Combo1.Text + "," + Combo2.Text + "," + Combo3.Text + Combo4.Text
50 .InputMode = 1
51 .InputLen = 50 ‘一次性从接收缓冲区中读取所有数据(8个字节为一组！！)
52 .InBufferC = 0 ‘清空接收缓冲区
53 .OutBufferCt = 0 ‘清空发送缓冲区
54 .RThreshold = 5 + (Combo6.ListIndex + 1) * 2
55 .InBufferSize = 1024
56 .OutBufferSize = 1024
57
58 .PortOpen = True
59 Else
60 MsgBox "串口已经打开"
61 End If
62 End With
63 End Sub
64 Private Sub Command4_Click() ‘关闭串口按钮
65 If MSComm1.PortOpen = True Then
66 MSComm1.PortOpen = False
67 End If
68 End Sub
69 Private Sub Form_Load()
70 Dim i As Integer
71
72 ‘波特率设置
73 Combo1.AddItem "4800", 0
74 Combo1.AddItem "9600", 1
75 Combo1.AddItem "115200", 2
76 ‘校验位设置
77 Combo2.AddItem "N", 0
78 Combo2.AddItem "E", 1
79 Combo2.AddItem "O", 2
80 ‘数据位设置
81 Combo3.AddItem "7", 0
82 Combo3.AddItem "8", 1
83 ‘停止位设置
84 Combo4.AddItem "1", 0
85 Combo4.AddItem "2", 1
86 ‘功能码选择
87 Combo5.AddItem "读寄存器03", 0
88 Combo5.AddItem "写寄存器16", 1
89 ‘寄存器个数设置
90 Combo6.AddItem "1", 0
91 Combo6.AddItem "2", 1
92 Combo6.AddItem "3", 2
93 Combo6.AddItem "4", 3
94 Combo6.AddItem "5", 4
95 Combo6.AddItem "6", 5
96 Combo6.AddItem "7", 6
97 Combo6.AddIt

分享到：

邀请回答

回复楼主

Heaven_lijia

精华：0帖
求助：0帖
帖子：0帖 | 1回
年度积分：0
历史总积分：11
注册：2012年9月22日

发表于：2012-09-22 14:22:11

21楼

楼主你好，最近在学习。希望你能发给我一份，非常感谢~~

631419240@qq.com

回复引用举报

silence2008

精华：0帖
求助：0帖
帖子：0帖 | 3回
年度积分：0
历史总积分：33
注册：2010年1月11日

发表于：2012-10-06 12:36:21

22楼

wang_7470322@live.cn谢谢了能发我一个学习一下

回复引用举报

bhdxzgp

精华：5帖
求助：8帖
帖子：141帖 | 5451回
年度积分：0
历史总积分：21609
注册：2006年4月16日

发表于：2012-10-06 14:06:50

23楼

‘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

Public Function ToDec(ByVal Str As String) As Integer
Dim tVal As Integer

    tVal = 0
   ｓｅｌｅｃｔCase (Mid(Str, 1, 1))
        Case "0":
                    tVal = 0
        Case "1":
                    tVal = 16
        Case "2":
                    tVal = 32
        Case "3":
                    tVal = 48
        Case "4":
                    tVal = 64
        Case "5":
                    tVal = 80
        Case "6":
                    tVal = 96
        Case "7":
                    tVal = 112
        Case "8":
                    tVal = 128
        Case "9":
                    tVal = 144
        Case "A":
                    tVal = 160
        Case "B":
                    tVal = 176
        Case "C":
                    tVal = 192
        Case "D":
                    tVal = 208
        Case "E":
                    tVal = 224
        Case "F":
                    tVal = 240
    End Select

   ｓｅｌｅｃｔCase (Mid(Str, 2, 1))
        Case "0":
                    tVal = tVal + 0
        Case "1":
                    tVal = tVal + 1
        Case "2":
                    tVal = tVal + 2
        Case "3":
                    tVal = tVal + 3
        Case "4":
                    tVal = tVal + 4
        Case "5":
                    tVal = tVal + 5
        Case "6":
                    tVal = tVal + 6
        Case "7":
                    tVal = tVal + 7
        Case "8":
                    tVal = tVal + 8
        Case "9":
                    tVal = tVal + 9
        Case "A":
                    tVal = tVal + 10
        Case "B":
                    tVal = tVal + 11
        Case "C":
                    tVal = tVal + 12
        Case "D":
                    tVal = tVal + 13
        Case "E":
                    tVal = tVal + 14
        Case "F":
                    tVal = tVal + 15
    End Select

ToDec = tVal
End Function

‘ 用途：将十进制转化为十六进制
‘ 输入：Dec(十进制数)
‘ 输入数据类型：Long
‘ 输出：DEC_to_HEX(十六进制数)
‘ 输出数据类型：String
‘ 输入的最大数为2147483647,输出最大数为7FFFFFFF
Public Function DEC_to_HEX(Dec As Integer) As String
    Dim a As String
    DEC_to_HEX = ""
    Do While Dec > 0
        a = CStr(Dec Mod 16)
       ｓｅｌｅｃｔCase a
            Case "10": a = "A"
            Case "11": a = "B"
            Case "12": a = "C"
            Case "13": a = "D"
            Case "14": a = "E"
            Case "15": a = "F"
        End Select
        DEC_to_HEX = a & DEC_to_HEX
        Dec = Dec \ 16
    Loop
End Function

回复引用举报

bhdxzgp

精华：5帖
求助：8帖
帖子：141帖 | 5451回
年度积分：0
历史总积分：21609
注册：2006年4月16日

发表于：2012-10-06 14:10:29

24楼

meiyanhong2005@yahoo.com.cn,jxzysheng@163.com ,wjy770218@gmail.com,349129791@qq.com ,465002969@qq.com ,1260887872@qq.com,631419240@qq.com,wang_7470322@live.cn,

以上已经传送到邮箱里面请查收！！！

回复引用举报

AutoCtrl888