设为首页收藏本站
开启辅助访问 切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

热门： 51单片机 | 24小时必答区 | 单片机教程 | 单片机DIY制作 | STM32 | Cortex M3 | 模数电子 | 电子DIY制作 | 音响/功放 | 拆机乐园 | Arduino | 嵌入式OS | 程序设计

搜索
»论坛 › 电子技术分类讨论区 › 程序设计/上位机 › Modbus_RTU_VB源码
返回列表 发新帖
查看: 6417|回复: 8
收起左侧

Modbus_RTU_VB源码

[复制链接]
ID:424917 发表于 2018-11-12 11:29 | 显示全部楼层 |阅读模式
Modbus_RTU_VB源码
0.png

参数值：
0.png

进程说明：
/******20061026
实现故障监控，errorflag=1_故障
/******20061026


/******20061102
完成提示，优化界面
/******20061102

/******20061111-12
优化串行发送接收
/******20061111-12

/******20061114
优化串行发送接收,字符间隔精确，T1.5=4ms
/******20061114

/******20061114
监视两台，监视地址固定。读参数地址可变
/******20061114


/******20061114
监视两台，监视地址固定。读参数地址可变
/******20061114


/******20061117
发现功能码03、06返回参数处理出错
例如：收回十六进制0708处理成十进制为120
十六进制0708 →→78→→十进制120
修正后：
十六进制0708 →→708→→十进制1800
/******200611117

vb源程序如下:
  1. Private Function Hexsent(ByVal smf_code As String, ByVal sdata_saddr As String, ByVal sdata_num As String, ByVal intGetDataLen As Integer, ByVal intdisnum As Integer, ByVal Hexsent_String As String) As Integer
  2.     Dim hexchrlen%, Hexchr As String, hexcyc%, hexmid As Byte
  3.     Dim hexchrgroup() As Byte, hexchrgrouprgt() As Byte
  4.     Dim j%
  5.     Dim dfMinus, dfFreq, dfTim As Double
  6.    
  7.     Dim msn1, msn2 As String
  8. '接收的数据
  9.     Dim bytReceiveArray() As Byte
  10.    
  11. '接收的变体数据
  12.     Dim VarReceiveData As String
  13.     Dim b As Variant
  14.     Dim i As Long, ii As Long, num_flag0&, num_flag1&, m As Long
  15.     On Error Resume Next
  16.    
  17.    
  18.     hexchrlen = Len(Hexsent_String)
  19.    
  20. '检查参数值是否合适
  21.     For hexcyc = 1 To hexchrlen
  22.         Hexchr = Mid(Hexsent_String, hexcyc, 1)
  23.         If InStr("0123456789ABCDEFabcdef", Hexchr) = 0 Then
  24.             MsgBox "无效的数值，请重新输入", , "错误信息"
  25.             Exit Function
  26.         End If
  27.     Next
  28.    
  29. '将参数值分成两个、两个
  30.     ReDim hexchrgroup(1 To hexchrlen \ 2) As Byte
  31.     For hexcyc = 1 To hexchrlen Step 2
  32.         i = i + 1
  33.         Hexchr = Mid(Hexsent_String, hexcyc, 2)
  34.         hexmid = Val("&H" & CStr(Hexchr))
  35.         hexchrgroup(i) = hexmid
  36.     Next
  37.                
  38. ''主站开始的空闲时间T3.5''主站开始的空闲时间T3.5''主站开始的空闲时间T3.5'主站开始的空闲时间T3.5
  39.     If FstHexSent = 1 Then
  40.         FstHexSent = 0
  41.         Call timedelays(T3_5)
  42.         idle = 1
  43.     ElseIf idle = 0 Then
  44.     Do
  45.     If GetQueueStatus(QS_ALLINPUT) Then DoEvents     '如果正在发送或接收数据则等待到发送或接收完成
  46.     Loop Until idle = 1
  47.     End If

  49. '查询一个从机
  50.      If Mid(Hexsent_String, 1, 2) > 0 And idle = 1 Then
  51.         idle = 0
  52.         retry_num = 3
  53.         replytimeoutflag = 0
  54.         MSComm1.InBufferCount = 0
  55.         hexchrgrouprgt = hexchrgroup
  56.         MSComm1.Output = hexchrgrouprgt
  57.    
  58.         
  59. '是否发送完毕
  60.         Do Until MSComm1.OutBufferCount = 0
  61.             If GetQueueStatus(QS_ALLINPUT) Then DoEvents
  62.         Loop
  63.         Call timedelays(T3_5)
  64.         QueryPerformanceCounter overreptim
  65.         idle = 1
  66. Wait_reply:
  67.         Do
  68.             If MSComm1.InBufferCount And idle = 1 Then
  69.                 idle = 0
  70.                 VarReceiveData = MSComm1.Input
  71.                 bytReceiveArray = VarReceiveData
  72.                 If Mid(Hexsent_String, 1, 2) = Tran(Hex(Val(bytReceiveArray(0))), 16) Then            '地址校验
  73.                     Unexpection_sl = 0
  74.                     GoTo Datareceive
  75.                 Else
  76.                     idle = 1
  77.                     Unexpection_sl = 1
  78.                     GoTo Wait_reply
  79.                 End If
  80.             Else
  81.                 QueryPerformanceFrequency f
  82.                 QueryPerformanceCounter l
  83.                 dfTim = (l.lowpart - overreptim.lowpart) / f.lowpart
  84.             End If
  85.         Loop Until dfTim > 2
  86.         
  87.         replytimeoutflag = 1
  88.         GoTo processing_error
  89.         
  90. Datareceive:
  91.         VarReceiveData = VarReceiveData & MSComm1.Input
  92.         QueryPerformanceCounter k
  93.         Do
  94.             If MSComm1.InBufferCount Then
  95.                 GoTo Datareceive
  96.             Else
  97.                 QueryPerformanceCounter l
  98.                 dfTim = (l.lowpart - k.lowpart) / f.lowpart
  99.             End If
  100.         Loop Until dfTim > 0.001 '判断T1.5超时
  101.         '帧控制(CRC校验)
  102.         bytReceiveArray = VarReceiveData
  103.         msn = bytReceiveArray
  104.       
  105.         i = LenB(msn)
  106.         ii = i
  107.         msn = ""
  108.         Text6text = ""
  109.         For j = 0 To i - 1
  110.             m = Tran(Hex(Val(bytReceiveArray(j))), 16)
  111.             If m <= 16 Then
  112.                Text6text = Text6text & "0" & Hex(Val(bytReceiveArray(j))) & " "
  113.                msn = msn & "0" & Hex(Val(bytReceiveArray(j)))
  114.             Else
  115.                Text6text = Text6text & Hex(Val(bytReceiveArray(j))) & " "
  116.                msn = msn & Hex(Val(bytReceiveArray(j)))
  117.         
  118.             End If
  119.         Next j
  120.         msn1 = Right$(msn, 4)
  121.         msn2 = Mid(msn, 1, (i - 2) * 2)
  122.         msn2 = RTUcheckString(msn2)
  123.         msn2 = Mid(msn2, (i - 1) * 2 - 1, 4)
  124.         i = StrComp(msn1, msn2, 1)
  125.         If i = 0 Then
  126.             Frameok_flag = 1
  127.         Else
  128.             Frameok_flag = 0
  129.             GoTo processing_error
  130.         End If
  131.         
  132.         'T3.5超时判断
  133.         Do
  134.             QueryPerformanceCounter l
  135.             dfTim = (l.lowpart - k.lowpart) / f.lowpart
  136.         Loop Until dfTim > T3_5
  137.         
  138.         If Frameok_flag = 0 Then
  139.             GoTo processing_error
  140.         Else
  141.             GoTo process_reply
  142.         End If
  143. processing_error: ''''''''''''''''''''''''''''''''''处理到这里了|||||||||||||||||||||||||||||||||
  144.                      If RESTART = 1 Then
  145.                         '7'If replytimeoutflag = 1 Then
  146.                         '7'   Hexsent = 1
  147.                         '7'   replytimeoutflag = 0
  148.                         '7'   idle = 1
  149.                         '7'   ERR = ERR + 1
  150.                         '7'Else
  151.                            Hexsent = 0
  152.                            RESTART = 0
  153.                         '7'End If
  154.                      
  155.                      ElseIf replytimeoutflag = 1 Then
  156.                         Hexsent = 1
  157.                         replytimeoutflag = 0
  158.                         idle = 1
  159.                         ERR = ERR + 1
  160.                      ElseIf Frameok_flag = 0 Then
  161.                         Hexsent = 2
  162.                         idle = 1
  163.                         ERR = ERR + 1
  164.                      End If
  165.                      Exit Function
  166.                      
  167.                 ''''''2'''     retry_num = retry_num - 1
  168.                 ''''''2'''     If retry_num >= 0 Then
  169.                 ''''''2'''        GoTo retry
  170.                 ''''''2'''     Else
  171.                 ''''''2'''        idle = 1
  172.                 ''''''2'''        Exit Function
  173.                 ''''''2'''     End If
复制代码

所有资料51hei提供下载:
Modbus_RTU_VB源码 _Modbus_RTU_VB源码.rar (4.27 MB, 下载次数: 160)
回复

使用道具 举报

ID:224365 发表于 2019-1-15 16:36 | 显示全部楼层
需要这个资料看一看
回复

使用道具 举报

ID:82988 发表于 2019-1-16 22:35 | 显示全部楼层
谢谢楼主分享
回复

使用道具 举报

ID:89841 发表于 2019-6-24 09:06 | 显示全部楼层

谢谢楼主分享
回复

使用道具 举报

ID:57896 发表于 2019-6-27 22:31 | 显示全部楼层
楼主你好！我用VB6.0打开提示“未注册”，怎么回事？
回复

使用道具 举报

ID:89841 发表于 2019-9-30 10:17 | 显示全部楼层
谢谢学习学习
回复

使用道具 举报

ID:522147 发表于 2019-11-7 15:51 | 显示全部楼层
谢谢学习学习，共同进步
回复

使用道具 举报

ID:522147 发表于 2020-4-10 15:40 | 显示全部楼层
学习学习，共同进步
回复

使用道具 举报

ID:774313 发表于 2020-6-9 19:33 | 显示全部楼层
需要这个资料
回复

使用道具 举报

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

本版积分规则

手机版|小黑屋|51黑电子论坛 |51黑电子论坛6群 QQ 管理员QQ:125739409;技术交流QQ群281945664

Powered by 单片机教程网

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