Modbus 通讯协议编程

Modbus 通讯协议编程

本人最近为了实现电脑与Delta VFD-M变频器通讯，特意用VB6.0编了一个Modbus协议通讯软件，不过这只是一个测试版，但Modbus的ASCii协议和RTU协议都已经实现。现在将源程序上贴，希望可以帮助到有需要的朋友，谢谢！(我发现图片贴不上去） 另外，假如你觉得有更好的想法，欢迎E-mail指教。 附：VB6源程序

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) & \ombo2.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(\ 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)) & \ MSComm1.Settings = \ 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)) & \ MSComm1.Settings = \ 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)) & \ MSComm1.Settings = \ 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 (\

Next

Combo1.ListIndex = 0

Combo2.AddItem \ Combo2.AddItem \ Combo2.AddItem \ Combo2.ListIndex = 2

Combo3.AddItem \ Combo3.AddItem \ Combo3.AddItem \ Combo3.AddItem \ Combo3.AddItem \ Combo3.AddItem \ Combo3.AddItem \ Combo3.AddItem \ Combo3.AddItem \ Combo3.AddItem \ Combo3.AddItem \ Combo3.ListIndex = 5

Combo4.AddItem \ Combo4.AddItem \ Combo4.AddItem \ Combo4.ListIndex = 0

Combo5.AddItem \ Combo5.AddItem \ Combo5.ListIndex = 0

For d = 0 To 254

Combo6.AddItem d Next

Combo6.ListIndex = 1

Text1.Text = \ Text2.Text = \ Text3.Text = \ Text4.Text = \ Text5.Text = \ Text6.Text = \ Text7.Text = \ Text8.Text = \

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 & \ 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发送协议

本文来源：https://www.bwwdw.com/article/mcef.html