VB 实现485物联网环境数据采集上位机EXE

齐玉林

已于 2022-02-16 09:50:30 修改

阅读量2.4k

点赞数 5

分类专栏： vb 文章标签：物联网

于 2021-07-07 20:34:00 首次发布

本文链接：https://blog.csdn.net/qilin001cs/article/details/118556540

版权

vb 专栏收录该内容

2 篇文章 1 订阅

订阅专栏

本文介绍了一款使用VB编写的上位机软件，能够读取config.txt配置文件，支持多条485命令的发送与解析规则。软件具备串口选择、波特率设置功能，并能实时显示通信日志，动态发送配置中的命令。在接收到数据后，程序会根据解析规则转换并显示16进制数据的10进制值。

摘要由CSDN通过智能技术生成

用了1天写了个上位机软件，VB语言的代码编写设计和可视化开发也非常好！

该上位机，支持config.txt 文件配置，可以配置，多条发送的485命令和解析规则

A001 为编号，0.1 为缩放值，010300000006C5C8为发送的命令，01030CXXXX00...这个为解析规则，其中XXXX对应的解析值，会把16进制值转换为10进制 * 缩放值！

一.界面效果

二. VB代码

Option Explicit

Private CONF(100) As String
Private showLog As Integer

Dim labels(100) As Object
Dim names(100) As String
Dim timer_index As Integer
    
Private Sub GetAvailablePorts()
    Dim i As Integer
    Dim blnNoPort As Boolean
    With Combo1
        .Clear
        '尝试打开COM1到COM16
        For i = 1 To 16
             MSComm1.CommPort = i
            '打开错误陷阱
            On Error Resume Next
            MSComm1.PortOpen = True
            '如果串口被成功打开，则这个串口存在
            If Err.Number = 0 Then
                Combo1.AddItem "COM" & i
                
                .ItemData(.NewIndex) = i
            End If
            Err.Clear
            ' 关闭已打开的串口
            If MSComm1.PortOpen Then MSComm1.PortOpen = False
            ' 关闭错误陷阱
            On Error GoTo 0
        Next
        blnNoPort = .ListCount = 0
    End With
     
    If blnNoPort Then
        MsgBox "未找到通信端口", vbYes, "提示"
    End If
End Sub




Private Sub Command1_Click()
    Dim btn_text As String
    Dim com1 As String
    Dim com2 As String
    Dim com3 As Integer
    Dim botelv As String
    
    btn_text = Command1.Caption
    com1 = Combo1.Text
    botelv = Combo2.Text
    
    ' 连接操作
    If btn_text = "连接" Then
             
        If com1 <> "" Then
          If botelv <> "" Then
              
              com2 = Replace(com1, "COM", "")
              com3 = Val(com2)
              Text1.Text = Text1.Text & "连接串口：" & com3 & ",波特率：" & botelv & vbNewLine
              
              MSComm1.CommPort = com3
              MSComm1.Settings = botelv & ",n,8,1"
              
              MSComm1.PortOpen = True
               
              Command1.Caption = "断开"
              
          Else
             MsgBox "请选择波特率", vbYes, "提示"
          End If
          
        Else
          MsgBox "请选择端口", vbYes, "提示"
        End If
    
    End If
    
    ' 断开操作
    If btn_text = "断开" Then
           
         MSComm1.PortOpen = False
         Command1.Caption = "连接"
         
    End If
     
End Sub


Private Sub Command2_Click()


    Dim botelv As String
    botelv = Combo3.Text
    
     If botelv <> "" Then
        
        
        If MSComm1.PortOpen Then
           
            Dim cmd As String
            cmd = "0103112233"
            ' 发送命令
            
            MSComm1.Output = HexToByte(cmd)
            
            Text1.Text = Text1.Text & "设置波特率：" & cmd & vbNewLine
            
            MsgBox "设置成功", vbYes, "提示"
        
        Else
            
            MsgBox "未连接端口", vbYes, "提示"
          
        End If
        
     Else
     
        MsgBox "请选择波特率", vbYes, "提示"
     
     End If
     
End Sub

Private Sub Command3_Click()
    
    If showLog = 0 Then
        Text1.Visible = True
        Command3.Caption = "隐藏日志"
        showLog = 1
    Else
        Text1.Text = ""
        Text1.Visible = False
        Command3.Caption = "显示日志"
        showLog = 0
    End If
    
End Sub

Private Sub Command4_Click()
    
    GetAvailablePorts
    
End Sub

Private Sub Form_Load()
    ' 变量初始化
    Dim s As String
    Dim si As Integer
    Dim count As Integer
    Dim arr() As String
    
    si = 0
    showLog = 0
    timer_index = 0
    
    ' 串口初始化
    GetAvailablePorts
    
    Combo2.AddItem "9600"
    Combo2.AddItem "4800"
    Combo2.AddItem "2400"
    
    Combo3.AddItem "9600"
    Combo3.AddItem "4800"
    Combo3.AddItem "2400"
    
    ' 读取配置文件，为发送的命令
    Text1.Text = Text1.Text & "获取配置:" & vbNewLine
    
    Open App.Path & "\config.txt" For Input As #1
    'Open "C:\Users\86182\Desktop\wlw\config.txt" For Input As #1
    Do While Not EOF(1)
        Line Input #1, s
        ' 读取一行 s 并初始化内容
        CONF(si) = s
        ' 初始化参数
        arr = Split(s, ",")
        addOne arr(1), "--", si
        Text1.Text = Text1.Text & s & vbNewLine
        si = si + 1
    Loop
    Close #1     '关闭
    
    
   ' 获取 CONF 的长度
   count = si
   Text1.Text = Text1.Text & "初始化完成，共:" & count & "项数据" & vbNewLine
    
End Sub

' 创建一个位置
Private Sub addOne(ByVal name As String, ByVal num As String, ByVal i As Integer)
    Dim c As Integer
    Dim r As Integer
    
    r = i / 10
    c = i Mod 6
    If c < 0 Then
        c = 0
    End If
    
    Set labels(i) = Controls.Add("VB.Label", "Label_" & i)
    labels(i).Caption = vbNewLine & num & vbNewLine & vbNewLine & name
    labels(i).Top = (r * 1600) + 640
    labels(i).Left = (c * 2600) + 200
    labels(i).Width = 2200
    labels(i).FontSize = 13
    labels(i).Alignment = 2
    labels(i).Height = 1300
    labels(i).Visible = True
    names(i) = name
    
End Sub

' 串口收到数据
Private Sub MSComm1_OnComm()

    Dim BytesReceived() As Byte
    Dim buffer As String
    Dim HData As String
    Dim i As Integer
    Dim ii As Integer
    
    Dim one As String
    Dim one_arr() As String
    Dim one_i As Integer
    
   
    
    Select Case MSComm1.CommEvent
       Case comEvReceive
        Text1.Text = Text1.Text & Format(Now, "hh:mm:ss") & "---有接收---" & vbNewLine
        
        MSComm1.InputLen = 0
        buffer = MSComm1.Input '接收数据至字符串中
        BytesReceived() = buffer '将数据转入Byte数组中
        For i = 0 To UBound(BytesReceived) '显示结果以十六进制显示
        If Len(hex(BytesReceived(i))) = 1 Then
        HData = HData & "0" & hex(BytesReceived(i))
        Else
        HData = HData & hex(BytesReceived(i))
        End If
        
        MSComm1.OutBufferCount = 0 '清除发送缓冲区
        MSComm1.InBufferCount = 0 '清除接收缓冲区
      Next
      
      ' 对HData进行解析，并展示内容
      Text1.Text = Text1.Text & Format(Now, "hh:mm:ss") & " <- " & HData & vbNewLine
      ' 开始解析
      For ii = 0 To UBound(CONF)
        one = CONF(ii)
        If (one <> "") Then
            one_arr = Split(one, ",")
            Dim unit As String
            Dim suo As String
            Dim jie As String
            
            unit = one_arr(3)
            suo = one_arr(2)
            jie = one_arr(5)
            
             Text1.Text = Text1.Text & Format(Now, "hh:mm:ss") & "------" & ii & "------" & vbNewLine
            ' 解析内容
             Text1.Text = Text1.Text & Format(Now, "hh:mm:ss") & " 1.解析：" & one_arr(1) & suo & unit & jie & vbNewLine
            
            ' 判断 HData 和 jie的前3位是否一致
            If Len(HData) > 6 Then
                If Len(jie) > 6 Then
                    Text1.Text = Text1.Text & Format(Now, "hh:mm:ss") & " 2.符合条件，收到数据 >6, 解析规则 >6" & vbNewLine
                    '判断
                    Dim HData6 As String
                    Dim jie6 As String
                    HData6 = Left(HData, 6)
                    jie6 = Left(jie, 6)
                    Text1.Text = Text1.Text & Format(Now, "hh:mm:ss") & " 3.数据 6：" & HData6 & "= 解析规则 6：" & jie6 & vbNewLine
                    ' 验证通过
                    If HData6 = jie6 Then
                        
                         '获取占位符的位置
                         Dim s  As Integer
                         Dim e As Integer
                         Dim sData As String
                         
                         s = InStr(jie, "X")
                         e = InStrRev(jie, "X")
                         Text1.Text = Text1.Text & Format(Now, "hh:mm:ss") & " 4.可以解析，位置：" & s & "-" & e & vbNewLine
                         
                         If Len(HData) > e Then
                            ' 数据的长度合适
                            sData = Mid(HData, s, (e - s) + 1)
                            Text1.Text = Text1.Text & Format(Now, "hh:mm:ss") & " 5.截取值：" & sData & vbNewLine
                            
                            ' 对截取的值进行数据处理
                            Dim myval As Long
                            myval = Val("&H" & sData)
                            
                            ' 小数处理
                            Dim myxs As Double
                            myxs = myval * Val(suo)
                            Text1.Text = Text1.Text & Format(Now, "hh:mm:ss") & " 6.数字：" & myval & " 数值：" & myxs & " 名称：" & names(ii) & vbNewLine
                            
                            ' 显示内容
                            labels(ii).Caption = vbNewLine & myxs & " " & unit & vbNewLine & vbNewLine & names(ii)
                            
                            Text1.SelStart = Len(Text1.Text)
                            
                         End If
                         
                         
                    End If
                End If
            End If
           
        End If
        
      Next ii
      
    End Select
End Sub

'数据转换
Private Function HexToByte(str As String) As Byte()
    Dim rst() As Byte
    Dim i As Long, j As Long
    i = Len(str)
    j = i \ 2 - 1
    ReDim rst(j)
    For i = 0 To j
        rst(i) = CByte("&H" & Mid$(str, i + i + 1, 2))
    Next
    HexToByte = rst()
End Function



Private Sub Timer1_Timer()
    
    Dim one As String
    Dim one_arr() As String
    Dim cmd As String
    Dim hex As String
    '获取配置项
    one = CONF(timer_index)
    If one <> "" Then
      ' 串口已打开
      If MSComm1.PortOpen Then
        
        one_arr = Split(one, ",")
        cmd = one_arr(4)
        Text1.Text = Text1.Text & Format(Now, "hh:mm:ss") & " -> " & cmd & vbNewLine
        Text1.SelStart = Len(Text1.Text)
        ' 发送命令
        MSComm1.Output = HexToByte(cmd)
          
      End If
      
    Else
     ' 重置为0
      timer_index = 0
      
    End If
    '获取下个配置
    timer_index = timer_index + 1
    
End Sub

三项目 Vbs 源码，百度网盘：

链接：https://pan.baidu.com/s/1J4f3oy96JKC5-xoKOEKEeA

感谢您的支持，写的文章如对您有所帮助，开源不易，请您打赏，谢谢啦~