📄 vb-modbus.txt

📁 用VB编写的MODBUS通信协议经典的主站程序
💻 TXT
字号:
Option Explicit
Private Text1text As String
Private RTUCRC As String
'串口选择
Private Sub Combo1_Click()
              MSComm1.CommPort = Combo1.ListIndex + 1
End Sub
'数据位改变
Private Sub Combo2_Click()
        Call setting
End Sub
'波特率改变
Private Sub Combo3_Click()
        Call setting
End Sub
'奇偶校验改变
Private Sub Combo4_Click()
        Call setting
End Sub
'停止位改变
Private Sub Combo5_Click()
        Call setting
End Sub
Private Sub setting()
         MSComm1.Settings = CStr(Combo3.Text) & "," & CStr(Combo4.Text) & "," & 
CStr(Combo2.Text) _
                                          & "," & CStr(Combo5.Text)
End Sub
'打开关闭串口
Private Sub Command1_Click()
        On Error Resume Next
        If MSComm1.PortOpen = False Then
            MSComm1.PortOpen = True
        Else
               MSComm1.PortOpen = False
        End If
        
        If MSComm1.PortOpen Then                                '打开关闭按钮显
示文字及combo1使能
             Command1.Caption = "关闭串口"
             Combo1.Enabled = False
        Else
              Command1.Caption = "打开串口"
              Combo1.Enabled = True
        End If
        
          If Err 
Then                                                          '打开串口失败，则
显示出错信息
               MsgBox Error$, 48, "错误信息"
                Exit Sub
           End If
End Sub
'10转16进制
Private Sub Command2_Click(Index As Integer)
     On Error Resume Next
         Text4.Text = Hex(Text3.Text)
           If Err 
Then                                                          ''则显示出错信息
               MsgBox Error$, 48, "错误信息"
                Exit Sub
           End If
End Sub
'16转10进制
Private Sub Command3_Click()
         Dim a As Long
         a = Val("&H" & CStr(Text4.Text))
         Text3.Text = a
End Sub
'手动串口发送
Private Sub Command4_Click()
         If MSComm1.PortOpen = False Then
                  MsgBox "请先打开串口", , "错误信息"
                  Exit Sub
          End If
          Call sentsub
End Sub
'清除接收窗
Private Sub Command5_Click()
          Text2.Text = ""
End Sub
Private Sub Command6_Click()
        Unload Me
End Sub
Private Sub Command7_Click()
        On Error Resume Next
          Dim STP As String
           STP = CStr(Chr(2)) & "010001" & CStr(Chr(3)) & "25"
           MSComm1.Settings = "9600,N,7,2"
           MSComm1.PortOpen = True
           MSComm1.Output = STP
           MSComm1.PortOpen = False
           If Err 
Then                                                          '打开串口失败，则
显示出错信息
               MsgBox Error$, 48, "错误信息"
                Exit Sub
           End If
End Sub
Private Sub Command8_Click()
        On Error Resume Next
        Dim FWD As String
           FWD = CStr(Chr(2)) & "010101" & CStr(Chr(3)) & "26"
           MSComm1.Settings = "9600,N,7,2"
           MSComm1.PortOpen = True
           MSComm1.Output = FWD
           MSComm1.PortOpen = False
           If Err 
Then                                                          '打开串口失败，则
显示出错信息
               MsgBox Error$, 48, "错误信息"
                Exit Sub
           End If
End Sub
Private Sub Command9_Click()
        On Error Resume Next
           Dim REV As String
           REV = CStr(Chr(2)) & "010201" & CStr(Chr(3)) & "27"
           MSComm1.Settings = "9600,N,7,2"
           MSComm1.PortOpen = True
           MSComm1.Output = REV
           MSComm1.PortOpen = False
           If Err 
Then                                                          '打开串口失败，则
显示出错信息
               MsgBox Error$, 48, "错误信息"
                Exit Sub
           End If
End Sub
'窗口加载
Private Sub Form_Load()
         Dim d%
            For d = 1 To 16
                   Combo1.AddItem ("COM" & CStr(d))
            Next
                   Combo1.ListIndex = 0
                   
            Combo2.AddItem "6"
            Combo2.AddItem "7"
            Combo2.AddItem "8"
            Combo2.ListIndex = 2
            
            Combo3.AddItem "110"
            Combo3.AddItem "330"
            Combo3.AddItem "1200"
            Combo3.AddItem "2400"
            Combo3.AddItem "4800"
            Combo3.AddItem "9600"
            Combo3.AddItem "19200"
            Combo3.AddItem "38400"
            Combo3.AddItem "56000"
            Combo3.AddItem "57600"
            Combo3.AddItem "115200"
            Combo3.ListIndex = 5
            
            Combo4.AddItem "n"
            Combo4.AddItem "o"
            Combo4.AddItem "e"
            Combo4.ListIndex = 0
            
            Combo5.AddItem "1"
            Combo5.AddItem "2"
            Combo5.ListIndex = 0
            
            For d = 0 To 254
                Combo6.AddItem d
            Next
                Combo6.ListIndex = 1
            
         Text1.Text = "010601001770"
         Text2.Text = ""
         Text3.Text = ""
         Text4.Text = ""
         Text5.Text = "1000"
         Text6.Text = "06"
         Text7.Text = "0"
         Text8.Text = "1"
         
         Option1.value = True
         Option3.value = True
         Option7.value = True
         Option9.value = True
         
         If MSComm1.PortOpen = False Then
                Command1.Caption = "打开串口"
         Else
                Command1.Caption = "关闭串口"
         End If
End Sub
'串口接收程序
Private Sub MSComm1_OnComm()
        Dim Hexchr As String, hexstring As String, i As Integer, j As Integer, 
hexdisp As String
        If Option8.value Then
             hexstring = 
MSComm1.Input                                                                   
 '十六进制显示
            i = Len(hexstring)
             For j = 1 To i
                 Hexchr = Mid(hexstring, j, 1)
                 If Hex(Asc(Hexchr)) < 16 Then
                    Text2.Text = Text2.Text & "0" & Hex(Asc(Hexchr)) & " "
                 Else
                    Text2.Text = Text2.Text & Hex(Asc(Hexchr)) & " "
                End If
            Next j
            Text2.Text = Text2.Text & CStr(Chr(13)) & CStr(Chr(10))
        Else
            Text2.Text = Text2.Text & MSComm1.Input & CStr(Chr(13)) & CStr(Chr
(10))   'ASCII码显示
        End If
End Sub
'手动发送选择
Private Sub Option1_Click()
         If Option1.value = True Then
              Timer1.Enabled = False
              Command4.Enabled = True
        Else
              Timer1.Enabled = True
              Command4.Enabled = False
        End If
End Sub
'Delta ASCII发送协议
Private Sub Option10_Click()
        Combo6.Enabled = True
       Text6.Enabled = True
       Text7.Enabled = True
       Text8.Enabled = True
       Label10.Enabled = True
       Label11.Enabled = True
       Label12.Enabled = True
       Label13.Enabled = True
       Option6.Enabled = False
       Option7.Enabled = False
       Option11.value = True
       Combo2.ListIndex = 1
       Combo5.ListIndex = 1
       Text1.Enabled = False
       Label14.Enabled = False
       Frame7.Visible = True
End Sub

'自动发送选择
Private Sub Option2_Click()
         If Option2.value = True Then
              Timer1.Enabled = True
              Command4.Enabled = False
        Else
              Timer1.Enabled = False
              Command4.Enabled = True
        End If
End Sub
Private Sub Option3_Click()               'Non选项
       Combo6.Enabled = False
       Text6.Enabled = False
       Text7.Enabled = False
       Text8.Enabled = False
       Label10.Enabled = False
       Label11.Enabled = False
       Label12.Enabled = False
       Label13.Enabled = False
       Option6.Enabled = True
       Option7.Enabled = True
       Combo2.ListIndex = 2
       Combo5.ListIndex = 0
       Text1.Enabled = True
       Label14.Enabled = True
       Frame7.Visible = False
End Sub
Private Sub Option4_Click()               'ASCII选项
       Combo6.Enabled = True
       Text6.Enabled = True
       Text7.Enabled = True
       Text8.Enabled = True
       Label10.Enabled = True
       Label11.Enabled = True
       Label12.Enabled = True
       Label13.Enabled = True
       Option6.Enabled = False
       Option7.Enabled = False
       Combo2.ListIndex = 1
       Combo5.ListIndex = 1
       Text1.Enabled = False
       Label14.Enabled = False
       Frame7.Visible = False
End Sub
Private Sub Option5_Click()               'RTU选项
       Combo6.Enabled = True
       Text6.Enabled = True
       Text7.Enabled = True
       Text8.Enabled = True
       Label10.Enabled = True
       Label11.Enabled = True
       Label12.Enabled = True
       Label13.Enabled = True
       Option6.Enabled = False
       Option7.Enabled = False
       Combo2.ListIndex = 2
       Combo5.ListIndex = 1
       Text1.Enabled = False
       Label14.Enabled = False
       Frame7.Visible = False
End Sub



继续--> [zxq96011] 2005-10-29 12:29:48
发送时间间隔调整输入
Private Sub Text5_Change()
        Dim number As String
        Dim num As Integer
        Dim numcyc As Integer
        num = Len(Text5.Text)
        For numcyc = 1 To num
            number = Mid(Text5.Text, numcyc, 1)
            Select Case InStr("0123456789", number)
            Case 0
               MsgBox "输入时间间隔错误，请重新输入", , "错误信息"
               Exit Sub
            End Select
        Next
         Timer1.Interval = Text5.Text
End Sub
💿 文件大小 3 K
👤 上传用户 fq335288450
📂 所属分类单片机开发
🏷️ 相关标签

#MODBUS #编写 #主站 #程序
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -