设为首页收藏本站
切换到宽版

紫外工控论坛

 找回密码
 立即注册

扫一扫，访问微社区

QQ登录

只需一步，快速开始

搜索
紫外工控论坛»论坛 › 分类讨论区 › 高级语言与上位机 › VB_MODBUS实现源码
返回列表 发新帖
查看: 3611|回复: 5

[VB/VB.NET] VB_MODBUS实现源码

[复制链接]
冰糖 发表于 2010-12-7 20:39:23 | 显示全部楼层 |阅读模式

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要 登录 才可以下载或查看，没有帐号？立即注册

x
  1. Dim ts_i As Integer
  2. Dim ts_str As String
  3. If (intCount <> 0) Then
  4.     ts_str = "receive:"
  5.     For ts_i = 0 To UBound(r_input)
  6.         ts_str = ts_str + CStr(Hex(r_input(ts_i))) + " "
  7.     Next ts_i
  8.     frm_main.Txt_msg.Text = ts_str + Chr(13) + Chr(10) + frm_main.Txt_msg.Text
  9. Else
  10.     ts_str = "no receive:"
  11.     frm_main.Txt_msg.Text = ts_str + Chr(13) + Chr(10) + frm_main.Txt_msg.Text
  12. End If


  15. End Function



  19. Public Function writewords(ByVal slv_id As Byte, ByVal addr As Long, ByVal lenth As Byte, ByRef lng_data() As Long, ByVal int_time As Integer) As Integer
  20.     Dim ret As Integer
  21.     Dim lenth1 As Integer
  22.     Dim lenth2 As Integer
  23.     Dim addr1 As Integer
  24.     Dim addr2 As Integer
  25.     Dim lng_data1() As Long
  26.      Dim lng_data2() As Long
  27.     Dim i As Integer
  28.     If (lenth > 100) Then
  29.         ReDim lng_data1(99)
  30.         ReDim lng_data2(lenth - 100 - 1)
  31.         For i = 0 To 99
  32.             lng_data1(i) = lng_data(i)
  33.         Next i
  34.         For i = 100 To lenth - 1
  35.             lng_data2(i - 100) = lng_data(i)
  36.         Next i
  37.         addr1 = addr
  38.         addr2 = addr + 100
  39.         lenth1 = 100
  40.         lenth2 = lenth - 100
  41.         ret = writewords1(slv_id, addr1, lenth1, lng_data1, int_time)
  42.         If (ret <> 0) Then
  43.             writewords = ret
  44.             Exit Function
  45.         End If
  46.         ret = writewords1(slv_id, addr2, lenth2, lng_data2, int_time)
  47.         If (ret <> 0) Then
  48.             writewords = ret
  49.             Exit Function
  50.         End If
  51.     Else
  52.         writewords = writewords1(slv_id, addr, lenth, lng_data, int_time)
  53.     End If
  54. End Function

  56. Public Function writewords1(ByVal slv_id As Byte, ByVal addr As Long, ByVal lenth As Byte, ByRef lng_data() As Long, ByVal int_time As Integer)
  57.     'On Error GoTo wrong
  58.     Dim lngStartTimer As Long
  59.     Dim lnginval As Long
  60.     Dim bln_cx As Boolean
  61.     Dim byt_data() As Byte
  62.     Dim r_input() As Byte
  63.     Dim CRC() As Byte
  64.     Dim i As Integer
  65.     ReDim byt_data(lenth * 2 - 1) As Byte
  66.     For i = 0 To lenth - 1
  67.         byt_data(2 * i) = lng_data(i) \ 256
  68.         byt_data(2 * i + 1) = lng_data(i) Mod 256
  69.     Next i
  70.     'Do Until bln_busy = False Or (Abs(timeGetTime - lng_time > 200))
  71.     '    DoEvents
  72.     '    DoEvents
  73.     '    DoEvents
  74.     '    DoEvents
  75.     '    DoEvents
  76.     'Loop

  78.     'bln_busy = True
  79.     frm_main.com_modbus.InBufferCount = 0
  80.     If (lenth > 1) Then
  81.         tran_modbus_order slv_id, 16, addr, byt_data
  82.     Else
  83.         tran_modbus_order slv_id, 6, addr, byt_data
  84.     End If
  85.     lngStartTimer = timeGetTime
  86.     bln_success = False
  87.     Dim intCount As Integer
  88.     Do Until Abs(timeGetTime - lngStartTimer) > int_time Or bln_success
  89.         DoEvents
  90.         DoEvents
  91.         DoEvents
  92.         DoEvents
  93.         DoEvents
  94.         DoEvents
  95.         intCount = frm_main.com_modbus.InBufferCount
  96.         If intCount = 8 Then
  97.             bln_success = True
  98.             frm_main.com_modbus.InputLen = 0
  99.             r_input = frm_main.com_modbus.Input
  100.             frm_main.com_modbus.InBufferCount = 0
  101.         End If
  102.     Loop
  103.    
  104.     If bln_success And intCount = 8 Then
  105.         CRC = CRC16(r_input)
  106.         If CRC(0) = r_input(UBound(r_input) - 1) And CRC(1) = r_input(UBound(r_input)) Then
  107.             writewords1 = 0      '通讯成功
  108.         Else
  109.             writewords1 = 2     '通讯错误
  110.         End If
  111.     ElseIf intCount <> 0 Then
  112.         writewords1 = 2          '通讯错误
  113.     Else
  114.         writewords1 = 1          '通讯失败
  115.     End If
复制代码
游客，如果您要查看本帖隐藏内容请回复
回复

使用道具 举报

 楼主| 冰糖 发表于 2010-12-7 20:40:05 | 显示全部楼层
  1. '读浮点数
  2. Public Function readsgls(ByVal slv_id As Byte, ByVal addr As Long, ByVal lenth As Byte, ByVal int_time As Integer, ByRef ret_val() As Single) As Integer
  3.     Dim lenth1 As Integer
  4.     Dim lenth2 As Integer
  5.     Dim ret_val1() As Single
  6.     Dim ret_val2() As Single
  7.     Dim addr1 As Long
  8.     Dim addr2 As Long
  9.     Dim ret As Integer
  10.     If (lenth > 50) Then
  11.         lenth1 = 50
  12.         lenth2 = lenth - lenth1
  13.         addr1 = addr
  14.         addr2 = addr + 100
  15.         ret = readsgls1(slv_id, addr1, lenth1, int_time, ret_val1)
  16.         If (ret <> 0) Then
  17.             readsgls = ret
  18.             Exit Function
  19.         End If
  20.         ret = readsgls1(slv_id, addr2, lenth2, int_time, ret_val2)
  21.         If (ret <> 0) Then
  22.             readsgls = ret
  23.             Exit Function
  24.         End If
  25.         ReDim ret_val(lenth - 1) As Single
  26.         Dim i As Integer
  27.         For i = 0 To 49
  28.             ret_val(i) = ret_val1(i)
  29.         Next i
  30.         For i = 50 To lenth - 1
  31.             ret_val(i) = ret_val2(i - 50)
  32.         Next i
  33.         readsgls = ret
  34.     Else
  35.         readsgls = readsgls1(slv_id, addr, lenth, int_time, ret_val())
  36.     End If
  37. End Function


  40. Public Function readsgls1(ByVal slv_id As Byte, ByVal addr As Long, ByVal lenth As Byte, ByVal int_time As Integer, ByRef ret_val() As Single) As Integer
  41. 'On Error GoTo wrong
  42. Dim i As Integer
  43. Dim lngStartTimer As Long
  44. Dim byt_data(0) As Byte
  45. Dim ret_byte() As Byte
  46. Dim r_input() As Byte
  47. Dim CRC() As Byte
  48. Dim intCount As Integer
  49. byt_data(0) = lenth * 2
  50. 'Do Until bln_busy = False Or (Abs(timeGetTime - lng_time > 200))
  51. '    DoEvents
  52. '    DoEvents
  53. '    DoEvents
  54. '    DoEvents
  55. '    DoEvents
  56. 'Loop
  57. 'bln_busy = True
  58. frm_main.com_modbus.InBufferCount = 0
  59. tran_modbus_order slv_id, 3, addr, byt_data
  60. lngStartTimer = timeGetTime
  61. bln_success = False
  62. Do Until Abs(timeGetTime - lngStartTimer) > int_time Or bln_success
  63.     DoEvents
  64.     DoEvents
  65.     DoEvents
  66.     DoEvents
  67.     DoEvents
  68.     intCount = frm_main.com_modbus.InBufferCount
  69.     If intCount = CInt(byt_data(0) * 2 + 5) Then
  70.         bln_success = True
  71.         frm_main.com_modbus.InputLen = 0
  72.         r_input = frm_main.com_modbus.Input
  73.         frm_main.com_modbus.InBufferCount = 0
  74.     End If
  75. Loop
  76. 'frm_main.Label2.Caption = timeGetTime - lngStartTimer + CLng(frm_main.Label2.Caption)
  77. If bln_success And intCount = CInt(byt_data(0) * 2 + 5) Then
  78.     CRC = CRC16(r_input)
  79.     If CRC(0) = r_input(UBound(r_input) - 1) And CRC(1) = r_input(UBound(r_input)) Then
  80.         ret_byte = r_input
  81.         ReDim ret_val(lenth - 1) As Single
  82.         Dim byt(3) As Byte
  83.         For i = 0 To lenth - 1
  84.             byt(0) = ret_byte(i * 4 + 4)
  85.             byt(1) = ret_byte(i * 4 + 3)
  86.             byt(2) = ret_byte(i * 4 + 6)
  87.             byt(3) = ret_byte(i * 4 + 5)
  88.             ret_val(i) = bytTosgl(byt)
  89.         Next i
  90.         readsgls1 = 0
  91.     Else
  92.         readsgls1 = 2
  93.     End If
  94. ElseIf intCount <> 0 Then
  95.     readsgls1 = 2
  96. Else
  97.     readsgls1 = 1
  98. End If
  99. 'bln_busy = False
  100. Dim ts_i As Integer
  101. Dim ts_str As String
  102. If (intCount <> 0) Then
  103.     ts_str = "receive:"
  104.     For ts_i = 0 To UBound(r_input)
  105.         ts_str = ts_str + CStr(Hex(r_input(ts_i))) + " "
  106.     Next ts_i
  107.     frm_main.Txt_msg.Text = ts_str + Chr(13) + Chr(10) + frm_main.Txt_msg.Text
  108. Else
  109.     ts_str = "no receive:"
  110.     frm_main.Txt_msg.Text = ts_str + Chr(13) + Chr(10) + frm_main.Txt_msg.Text
  111. End If

  113. End Function
复制代码
回复 支持 反对

使用道具 举报

 楼主| 冰糖 发表于 2010-12-7 20:40:28 | 显示全部楼层
  1. '写浮点数
  2. Public Function writesgls(ByVal slv_id As Byte, ByVal addr As Long, ByVal lenth As Byte, ByRef sgl_data() As Single, ByVal int_time As Integer) As Integer
  3.     Dim addr1 As Integer
  4.     Dim addr2 As Integer
  5.     Dim lenth1 As Integer
  6.     Dim lenth2 As Integer
  7.     Dim sgl_data1() As Single
  8.     Dim sgl_data2() As Single
  9.     Dim i As Integer
  10.     Dim ret As Integer
  11.     If lenth > 50 Then
  12.         ReDim sgl_data1(49) As Single
  13.         ReDim sgl_data2(lenth - 51)
  14.         lenth1 = 50
  15.         lenth2 = lenth - lenth1
  16.         addr1 = addr
  17.         addr2 = addr + 100
  18.         For i = 0 To 49
  19.             sgl_data1(i) = sgl_data(i)
  20.         Next i
  21.         For i = 50 To lenth - 1
  22.             sgl_data2(i - 50) = sgl_data(i)
  23.         Next i
  24.         ret = writesgls1(slv_id, addr1, lenth1, sgl_data1, int_time)
  25.         If (ret <> 0) Then
  26.             writesgls = ret
  27.             Exit Function
  28.         End If
  29.         ret = writesgls1(slv_id, addr2, lenth2, sgl_data2, int_time)
  30.         If (ret <> 0) Then
  31.             writesgls = ret
  32.             Exit Function
  33.         End If
  34.     Else
  35.         writesgls = writesgls1(slv_id, addr, lenth, sgl_data(), int_time)
  36.     End If
  37. End Function


  40. Public Function writesgls1(ByVal slv_id As Byte, ByVal addr As Long, ByVal lenth As Byte, ByRef sgl_data() As Single, ByVal int_time As Integer) As Integer
  41. Dim lngStartTimer As Long
  42. Dim CRC() As Byte
  43. Dim byt_data() As Byte
  44. Dim r_input() As Byte
  45. Dim i As Integer
  46. Dim byt(3) As Byte
  47. ReDim byt_data(lenth * 4 - 1) As Byte
  48. For i = 0 To lenth - 1
  49.     sglTobyt sgl_data(i), byt
  50.     byt_data(4 * i) = byt(1)
  51.     byt_data(4 * i + 1) = byt(0)
  52.     byt_data(4 * i + 2) = byt(3)
  53.     byt_data(4 * i + 3) = byt(2)
  54. Next i
  55. 'Do Until bln_busy = False Or (Abs(timeGetTime - lng_time > 200))
  56. '    DoEvents
  57. 'Loop
  58. 'bln_busy = True
  59. frm_main.com_modbus.InBufferCount = 0
  60. tran_modbus_order slv_id, 16, addr, byt_data
  61. lngStartTimer = timeGetTime
  62. bln_success = False
  63. Static intCount As Integer
  64. Do Until Abs(timeGetTime - lngStartTimer) > int_time Or bln_success
  65.     DoEvents
  66.     intCount = frm_main.com_modbus.InBufferCount
  67.     If intCount = 8 Then
  68.         bln_success = True
  69.         frm_main.com_modbus.InputLen = 0
  70.         r_input = frm_main.com_modbus.Input
  71.         frm_main.com_modbus.InBufferCount = 0
  72.     End If
  73. Loop

  75. If bln_success And intCount = 8 Then
  76.     CRC = CRC16(r_input)
  77.     If CRC(0) = r_input(UBound(r_input) - 1) And CRC(1) = r_input(UBound(r_input)) Then
  78.         writesgls1 = 0
  79.     Else
  80.         writesgls1 = 2
  81.     End If
  82. ElseIf intCount <> 0 Then
  83.     writesgls1 = 2
  84. Else
  85.     writesgls1 = 1
  86. End If

  88. Dim ts_i As Integer
  89. Dim ts_str As String
  90. If (intCount <> 0) Then
  91.     ts_str = "receive:"
  92.     For ts_i = 0 To UBound(r_input)
  93.         ts_str = ts_str + CStr(Hex(r_input(ts_i))) + " "
  94.     Next ts_i
  95.     frm_main.Txt_msg.Text = ts_str + Chr(13) + Chr(10) + frm_main.Txt_msg.Text
  96. Else
  97.     ts_str = "no receive:"
  98.     frm_main.Txt_msg.Text = ts_str + Chr(13) + Chr(10) + frm_main.Txt_msg.Text
  99. End If

  101. 'bln_busy = False
  102. End Function
复制代码
回复 支持 反对

使用道具 举报

su_3344 发表于 2011-4-21 23:04:06 | 显示全部楼层
到代码很辛苦，我需要一个vb.net的modbus 例程
回复 支持 反对

使用道具 举报

ss283031771 发表于 2011-4-22 06:47:13 | 显示全部楼层
真是好东西，感谢分享
回复 支持 反对

使用道具 举报

winare 发表于 2011-10-17 13:20:41 | 显示全部楼层
no demo????????????
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则


--------------------------------------------------------------------------------------------------------------------
本站是工控技术交流站点,论坛内容均为网络收集或会员所发表,并不代表本站立场,会员拥有该内容的所有权力及责任!
本站内容如有侵犯您的版权，请按下面方式联系本站管理员，我们将及时删除处理
管理员:冰糖 QQ:5483695(请直击主题), Mail:admin#ziwai.net(#改成@) 其它非本人.
拒绝任何人以任何形式在本论坛发表与中华人民共和国法律相抵触的言论!

QQ|Archiver|手机版|小黑屋|紫外工控论坛. ( 苏ICP备11032118号-1 )

GMT+8, 2024-4-29 17:39 , Processed in 0.453128 second(s), 17 queries .

Powered by Discuz! X3.4 Licensed

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表