MODBUS 通讯协议编程VB源代码
Modbus 通讯协议编程(VB源代码)
最近，本人为了实现电脑与Delta V FD-M变频器通讯，特意用VB6.0编了一个Modbus协议通讯软件。
这只是一个测试版，但Modbus的ASCII协议和RTU协议都已经实现。
现在将源程序上传，希望可以帮助到有需要的朋友，谢谢！另外，假如你觉得有更好的想法，欢迎指教。
如果对本程序有任何意见和建议，也可以一起讨论，共同进步。
大家多多支持俺啊。
附：VB6源程序Option ExplicitPrivate Text1text As StringPrivate RTUCRC As String'串口选择Private Sub Combo1_Click()mPort = Combo1.ListIndex + 1End Sub'数据位改变< span style="color: #008000;">Private Sub Combo2_Click()Call settingEnd Sub'波特率改变< span style="color: #008000;">Private Sub Combo3_Click()Call settingEnd Sub'奇偶校验改变< span style="color: #008000;">Private Sub Combo4_Click()Call settingEnd Sub'停止位改变< span style="color: #008000;">Private Sub Combo5_Click()Call settingPrivate Sub setting()MSComm1.Settings = CStr(Combo3.Text) & ","& CStr(Combo4.Text) & ","& CStr(C ombo2.Text) _& ","& CStr(Combo5.Text)End Sub'打开关闭串口< span style="color: #008000;">Private Sub Command1_Click()On Error Resume NextIf MSComm1.PortOpen = False ThenMSComm1.PortOpen = TrueElseMSComm1.PortOpen = FalseEnd IfIf MSComm1.PortOpen Then'打开关闭按钮显示文字及combo1使能Command1.Caption = "关闭串口"Combo1.Enabled = FalseElseCommand1.Caption = "打开串口"Combo1.Enabled = TrueEnd IfIf Err Then'打开串口失败，则显示出错信息MsgBox Error$, 48, "错误信息"Exit SubEnd IfEnd Sub'10转16进制< span style="color: #008000;">Private Sub Command2_Click(Index As Integer)On Error Resume NextText4.Text = Hex(Text3.Text)If Err Then''则显示出错信息< span style="color: #008000;">MsgBox Error$, 48, "错误信息"Exit SubEnd If'16转10进制< span style="color: #008000;">Private Sub Command3_Click()Dim a As Longa = Val("&H"& CStr(Text4.Text))Text3.Text = aEnd Sub'手动串口发送< span style="color: #008000;">Private Sub Command4_Click()If MSComm1.PortOpen = False ThenMsgBox"请先打开串口< span style="color: #800000;">", , "错误信息" Exit SubEnd IfCall sentsubEnd Sub'清除接收窗< span style="color: #008000;">Private Sub Command5_Click()Text2.Text = ""End SubPrivate Sub Command6_Click()Unload MeEnd SubPrivate Sub Command7_Click()On Error Resume NextDim STP As StringSTP = CStr(Chr(2)) & "010001"& CStr(Chr(3)) & "25"MSComm1.Settings = "9600,N,7,2"MSComm1.PortOpen = TrueMSComm1.Output = STPMSComm1.PortOpen = FalseIf Err Then'打开串口失败，则显示出错信息MsgBox Error$, 48, "错误信息"Exit SubEnd IfEnd SubPrivate Sub Command8_Click()On Error Resume NextDim FWD As StringFWD = CStr(Chr(2)) & "010101"& CStr(Chr(3)) & "26" MSComm1.Settings = "9600,N,7,2"MSComm1.PortOpen = TrueMSComm1.Output = FWDMSComm1.PortOpen = FalseIf Err Then'打开串口失败，则显示出错信息MsgBox Error$, 48, "错误信息"Exit SubEnd IfEnd SubPrivate Sub Command9_Click()On Error Resume NextDim REV As StringREV = CStr(Chr(2)) & "010201"& CStr(Chr(3)) & "27" MSComm1.Settings = "9600,N,7,2"MSComm1.PortOpen = TrueMSComm1.Output = REVMSComm1.PortOpen = FalseIf Err Then'打开串口失败，则显示出错信息MsgBox Error$, 48, "错误信息"Exit SubEnd IfEnd Sub'窗口加载Private Sub Form_Load()Dim d%For d = 1To16Combo1.AddItem ("COM"& CStr(d))NextCombo1.ListIndex = 0Combo2.AddItem "6"Combo2.AddItem "7"Combo2.AddItem "8"Combo2.ListIndex = 2Combo3.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 = 5Combo4.AddItem "n" Combo4.AddItem "o" Combo4.AddItem "e" Combo4.ListIndex = 0Combo5.AddItem "1" Combo5.AddItem "2" Combo5.ListIndex = 0For d = 0To254Combo6.AddItem dNextCombo6.ListIndex = 1Text1.Text = "010*********" Text2.Text = ""Text3.Text = ""Text4.Text = ""Text5.Text = "1000"Text6.Text = "06"Text7.Text = "0"Text8.Text = "1"Option1.value = TrueOption3.value = TrueOption7.value = TrueOption9.value = TrueIf MSComm1.PortOpen = False ThenCommand1.Caption = "打开串口"ElseCommand1.Caption = "关闭串口"End IfEnd Sub'串口接收程序< span style="color: #008000;">Private Sub MSComm1_OnComm()Dim Hexchr As String, hexstring As String, i As Integer, j As Integer, hexdisp As Str ingIf Option8.value Thenhexstring = MSComm1.Input '十六进制显示< span style="color: #008000;">i = Len(hexstring)For j = 1To iHexchr = Mid(hexstring, j, 1)If Hex(Asc(Hexchr)) < 16ThenText2.Text = Text2.Text & "0"& Hex(Asc(Hexchr)) & " "ElseText2.Text = Text2.Text & Hex(Asc(Hexchr)) & " "End IfNext jText2.Text = Text2.Text & CStr(Chr(13)) & CStr(Chr(10))ElseText2.Text = Text2.Text & MSComm1.Input & CStr(Chr(13)) & CStr(Chr(10)) 'ASCII 码显示< span style="color: #008000;">End IfEnd Sub'手动发送选择< span style="color: #008000;">Private Sub Option1_Click()If Option1.value = True ThenTimer1.Enabled = FalseCommand4.Enabled = TrueElseTimer1.Enabled = TrueCommand4.Enabled = FalseEnd IfEnd Sub'Delta ASCII发送协议Private Sub Option10_Click()Combo6.Enabled = TrueText6.Enabled = TrueText7.Enabled = TrueText8.Enabled = TrueLabel10.Enabled = TrueLabel11.Enabled = TrueLabel12.Enabled = TrueLabel13.Enabled = TrueOption6.Enabled = FalseOption7.Enabled = FalseOption11.value = TrueCombo2.ListIndex = 1Combo5.ListIndex = 1Text1.Enabled = FalseLabel14.Enabled = FalseFrame7.Visible = TrueEnd Sub'自动发送选择< span style="color: #008000;"> Private Sub Option2_Click()If Option2.value = True ThenTimer1.Enabled = TrueCommand4.Enabled = FalseElseTimer1.Enabled = FalseCommand4.Enabled = TrueEnd IfEnd SubPrivate Sub Option3_Click() 'Non选项< span style="color: #008000;"> Combo6.Enabled = FalseText6.Enabled = FalseText7.Enabled = FalseText8.Enabled = FalseLabel10.Enabled = FalseLabel11.Enabled = FalseLabel12.Enabled = FalseLabel13.Enabled = FalseOption6.Enabled = TrueOption7.Enabled = TrueCombo2.ListIndex = 2Combo5.ListIndex = 0Text1.Enabled = TrueLabel14.Enabled = TrueFrame7.Visible = FalseEnd SubPrivate Sub Option4_Click() 'ASCII选项< span style="color: #008000;"> Combo6.Enabled = TrueText6.Enabled = TrueText7.Enabled = TrueText8.Enabled = TrueLabel10.Enabled = TrueLabel11.Enabled = TrueLabel12.Enabled = TrueLabel13.Enabled = TrueOption6.Enabled = FalseOption7.Enabled = FalseCombo2.ListIndex = 1Combo5.ListIndex = 1Text1.Enabled = FalseLabel14.Enabled = FalseFrame7.Visible = FalseEnd SubPrivate Sub Option5_Click() 'RTU选项< span style="color: #008000;"> Combo6.Enabled = TrueText6.Enabled = TrueText7.Enabled = TrueText8.Enabled = TrueLabel10.Enabled = TrueLabel11.Enabled = TrueLabel12.Enabled = TrueLabel13.Enabled = TrueOption6.Enabled = FalseOption7.Enabled = FalseCombo2.ListIndex = 2Combo5.ListIndex = 1Text1.Enabled = FalseLabel14.Enabled = FalseFrame7.Visible = FalseEnd Sub'发送时间间隔调整输入< span style="color: #008000;">Private Sub Text5_Change()Dim number As StringDim num As IntegerDim numcyc As Integernum = Len(Text5.Text)For numcyc = 1To numnumber = Mid(Text5.Text, numcyc, 1)Select Case InStr("0123456789", number)Case0MsgBox"输入时间间隔错误，请重新输入", , "错误信息"Exit SubEnd SelectNextTimer1.Interval = Text5.TextEnd Sub'自动发送定时器< span style="color: #008000;">Private Sub Timer1_Timer()If MSComm1.PortOpen ThenCall sentsubEnd IfEnd Sub'状态刷新定时器< span style="color: #008000;">Private Sub Timer2_Timer()StatusBar1.Panels(1).Text = "串口选择：< span style="color: #800000;">" & CStr(Comb o1.Text)StatusBar1.Panels(2).Text = "串口设置：< span style="color: #800000;">" & CStr(MSC omm1.Settings)StatusBar1.Panels(3).Text = "串口状态：< span style="color: #800000;">" & CStr(MSC omm1.PortOpen)End Sub'串口发送子程序Private Sub sentsub()Dim optioncase%If Option3.value Then optioncase = 1If Option4.value Then optioncase = 2If Option5.value Then optioncase = 3If Option10.value Then optioncase = 4Select Case optioncaseCase1If Option6.value ThenText1text = Text1.TextCall HexsentElseText1text = Text1.TextCall ASCIIsentEnd IfCase2Call incorporate '将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串Call ASCIIcheckCall ASCIIsentCase3Call incorporate '将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串Call RTUcheckCall HexsentCase4Call incorporate1 '将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串Call deltaASCIICall ASCIIsentEnd SelectEnd Sub'十六进制发送< span style="color: #008000;">Private Sub Hexsent()Dim hexchrlen%, Hexchr As String, hexcyc%, hexmid As Byte, hexmiddle As String Dim hexchrgroup() As Byte, i As Integerhexchrlen = Len(Text1text)For hexcyc = 1To hexchrlen '检查Text1文本框内数值是否合适Hexchr = Mid(Text1text, hexcyc, 1)If InStr("0123456789ABCDEFabcdef", Hexchr) = 0ThenMsgBox"无效的数值，请重新输入< span style="color: #800000;">", , "错误信息" Exit SubEnd IfNextReDim hexchrgroup(1To hexchrlen \ 2) As ByteFor hexcyc = 1To hexchrlen Step2'将文本框内数值分成两个、两个i = i + 1Hexchr = Mid(Text1text, hexcyc, 2)hexmid = Val("&H"& CStr(Hexchr))hexchrgroup(i) = hexmid'MSComm1.Output = CStr(hexmid)NextMSComm1.Output = hexchrgroupEnd Sub'ASC码发送< span style="color: #008000;">Private Sub ASCIIsent()MSComm1.Output = Text1textEnd Sub'ASC校验,此段程序计算出LRC校验值，并加上字头和字尾Private Sub ASCIIcheck()Dim a%, b%, chrnum%, Lrcbyte As StringDim checksum%, char%, AscLrc%, Lrc%chrnum = Len(Text1text)For a = 1To chrnum Step2char= Val("&H"& CStr(Mid(Text1text, a, 2))) '两个两个的取字符< span style="color: #008000;">checksum = checksum + char'全部加起来< span style="color: #008000;">NextAscLrc = checksum Mod&H100 '取255的余数< span style="color: #008000;">Lrc = (&HFF - AscLrc) + 1'取二次补If Lrc < 16Then'此段程序是判断Hex(lrc)是否是一位数，Lrcbyte = "0"+ CStr(Hex(Lrc)) '如果是的话，前面加0；否则不加零ElseLrcbyte = CStr(Hex(Lrc))End IfText1text = CStr(Chr(58)) & CStr(Text1text) & Lrcbyte & CStr(Chr(13)) & CStr(Chr(1 0))End Sub'DeltaASCII校验,此段程序计算出LRC校验值，并加上字头和字尾Private Sub deltaASCII()Dim a%, b%, chrnum%, Lrcbyte As StringDim checksum%, char%, Lrc%chrnum = Len(Text1text)For a = 1To chrnumchar= Asc(Mid(Text1text, a, 1)) '两个两个的取字符< span style="color: #008000;"> checksum = checksum + char'全部加起来< span style="color: #008000;">NextLrc = (checksum + &H3) Mod&H100 '取255的余数< span style="color: #008000;"> If Lrc < 16Then'此段程序是判断Hex(lrc)是否是一位数，Lrcbyte = "0"+ CStr(Hex(Lrc)) '如果是的话，前面加0；否则不加零ElseLrcbyte = CStr(Hex(Lrc))End IfText1text = CStr(Chr(2)) & CStr(Text1text) & CStr(Chr(3)) & LrcbyteEnd Sub'RTU校验< span style="color: #008000;">Private Sub RTUcheck()Dim CRC() As ByteDim d(5) As ByteDim string1 As StringDim j As Integer, chrlength As Integer, temp As Stringstring1 = Text1textchrlength = Len(string1)For j = 0To chrlength / 2- 1temp = Mid(string1, j * 2+ 1, 2)d(j) = Val("&H"& temp)NextRTUCRC = CRC16(d) '调用CRC16计算函数, CRC(0)为高位, CRC(1)为低位Text1text = Text1text & RTUCRCEnd SubPrivate Sub incorporate() '将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串Dim wholechar As String, wc%, wcyc%, wchar As StringDim SID As String, Cmd As String, InfoAdd As String, data As StringDim SIDnum%, Cmdnum%, InfoAddNum%, Datanum%On Error Resume Nextwholechar = CStr(Combo6.Text) & CStr(Text6.Text) & CStr(Text7.Text) & CStr(Text8.T ext)wc = Len(wholechar)For wcyc = 1To wcwchar = Mid(wholechar, wcyc, 1)If InStr("0123456789", wchar) = 0ThenMsgBox"输入错误，请重新输入< span style="color: #800000;">", , "错误提示"Exit SubEnd IfNextSIDnum = Len(CStr(Hex(Combo6.Text)))Select Case SIDnumExit SubCase1SID = "0"& CStr(Hex(Combo6.Text)) Case2SID = CStr(Hex(Combo6.Text))End SelectCmdnum = Len(CStr(Hex(Text6.Text))) Select Case CmdnumCase0Exit SubCase1Cmd = "0"& CStr(Hex(Text6.Text)) Case1Cmd = CStr(Hex(Text6.Text))End SelectInfoAddNum = Len(CStr(Hex(Text7.Text))) Select Case InfoAddNumCase0Exit SubCase1InfoAdd = "000"& CStr(Hex(Text7.Text)) Case2InfoAdd = "00"& CStr(Hex(Text7.Text)) Case3InfoAdd = "0"& CStr(Hex(Text7.Text)) Case4InfoAdd = CStr(Hex(Text7.Text))End SelectDatanum = Len(CStr(Hex(Text8.Text))) Select Case DatanumCase0Exit Subdata = "000"& CStr(Hex(Text8.Text))Case2data = "00"& CStr(Hex(Text8.Text))Case3data = "0"& CStr(Hex(Text8.Text))Case4data = CStr(Hex(Text8.Text))End SelectIf Err Then'显示出错信息< span style="color: #008000;">MsgBox Error$, 48, "错误信息"Exit SubEnd IfText1text = CStr(SID) & CStr(Cmd) & CStr(InfoAdd) & CStr(data)End SubPrivate Sub incorporate1() '将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串Dim wholechar As String, wc%, wcyc%, wchar As StringDim SID As String, Cmd As String, InfoAdd As String, data As StringDim SIDnum%, Cmdnum%, InfoAddNum%, Datanum%On Error Resume Nextwholechar = CStr(Combo6.Text) & CStr(Text7.Text) & CStr(Text8.Text)wc = Len(wholechar)For wcyc = 1To wcwchar = Mid(wholechar, wcyc, 1)If InStr("0123456789", wchar) = 0ThenMsgBox"输入错误，请重新输入< span style="color: #800000;">", , "错误提示"Exit SubEnd IfNextSIDnum = Len(CStr(Hex(Combo6.Text)))Select Case SIDnumCase0Case1SID = "0"& CStr(Hex(Combo6.Text)) Case2SID = CStr(Hex(Combo6.Text))End Select'Cmdnum = Len(CStr(Hex(Text6.Text)))'Select Case Cmdnum'Case 0' Exit Sub'Case 1' Cmd = "0" & CStr(Hex(Text6.Text))'Case 1' Cmd = CStr(Hex(Text6.Text))'End SelectInfoAddNum = Len(CStr(Hex(Text7.Text))) Select Case InfoAddNumCase0Exit SubCase1InfoAdd = "0"& CStr(Hex(Text7.Text)) Case2InfoAdd = CStr(Hex(Text7.Text))End SelectDatanum = Len(CStr(Hex(Text8.Text))) Select Case DatanumCase0Exit SubCase1data = "000"& CStr(Hex(Text8.Text)) Case2data = "00"& CStr(Hex(Text8.Text)) Case3data = "0"& CStr(Hex(Text8.Text))Case4data = CStr(Hex(Text8.Text))End SelectIf Err Then'显示出错信息< span style="color: #008000;">MsgBox Error$, 48, "错误信息"Exit SubEnd IfIf Option11.value ThenCmd = "08"Text1text = CStr(SID) & CStr(Cmd) & CStr(InfoAdd)ElseCmd = "07"Text1text = CStr(SID) & CStr(Cmd) & CStr(InfoAdd) & CStr(data)End IfEnd SubPrivate Function CRC16(data() As Byte) As StringDim CRC16Lo As Byte, CRC16Hi As Byte'CRC寄存器< span style="color: #00800 0;">Dim CL As Byte, CH As Byte'多项式码&HA001Dim CRCLo As String, CRCHi As StringDim SaveHi As Byte, SaveLo As ByteDim i As IntegerDim Flag As IntegerCRC16Lo = &HFFCRC16Hi = &HFFCL = &H1CH = &HA0For i = 0To UBound(data)CRC16Lo = CRC16Lo Xor data(i) '每一个数据与CRC寄存器进行异或For Flag = 0To7SaveHi = CRC16HiSaveLo = CRC16LoCRC16Hi = CRC16Hi \ 2'高位右移一位< span style="color: #008000;">CRC16Lo = CRC16Lo \ 2'低位右移一位< span style="color: #008000;">If((SaveHi And&H1) = &H1) Then'如果高位字节最后一位为1< span style="color: #008000;">CRC16Lo = CRC16Lo Or&H80 '则低位字节右移后前面补1< span style="color: #008 000;">End If'否则自动补0< span style="color: #008000;">If((SaveLo And&H1) = &H1) Then'如果LSB为1，则与多项式码进行异或CRC16Hi = CRC16Hi Xor CHCRC16Lo = CRC16Lo Xor CLEnd IfNext FlagNext iIf Len(Hex(CRC16Hi)) = 1ThenCRCHi = "0"+ Hex(CRC16Hi)ElseCRCHi = Hex(CRC16Hi)End IfIf Len(Hex(CRC16Lo)) = 1ThenCRCLo = "0"+ Hex(CRC16Lo)ElseCRCLo = Hex(CRC16Lo)End IfCRC16 = CRCLo + CRCHiEnd Function。
用VB实现ModbusTCPIP的通讯
Schneider-施耐德LEC使用技巧文集［第7讲］――如何用VB实现Twido的Modbus TCP/IP 的通讯提供:Sch neider-施耐德电气(中国)投资有限公司xx浏览次数：1070Twido系列PLC支持TCPModbus的通讯，尤其是TWDLCAE40DR提供了内置的以太网接口，能实现下图所示的结构；通过HUB,不仅能对Twido进行编程，也能对TwidoPLC中的数据进行读写。
对于TWDLCAE40DRF假定其配置如下：对于上位机，我们利用VB的Win Sock套接字控件能很容易的进行编程。
新建1个套接字对象，设定其属性如右，注意其远程主机的IP就是以上TWDLCAE40DR的IP地址：］1．建立网络连接Private Sub Command2_Click()On Error Resume NextWinsock1.CloseWinsock1.Connect “85.16.1.1 ”, 502If Err ThenMsgBox “网络连接时发生错误:” & Err.Description, vbCriticaI网络连接” E“ClearEnd IfEnd Sub2 .读多个字的命令(本例表示从PLC读％MW3和％MW4两个字)：Private Sub cmdSend_Click()On Error GoTo ErrProcDim SendStr(11) As ByteDim RcvStr() As ByteSendStr(0) = 0 交换'识别号高字节,通常为0SendStr(1) = 0 交换'识别号低字节,通常为0SendStr(2) = 0 协议'识别号高字节,为0SendStr(3) = 0 协议'识别号低字节,为0SendStr(4) = 0字节xx高字节SendStr(5) = 6以下字节xx低字节SendStr(6) = 255 单元'识别号,确省为255 SendStr(7) = &H3 读'多个字命令代码SendStr(8) = 0 读数'据的起始地址高字节SendStr(9) = 3 读数'据的起始地址低字节SendStr(10) = 0数据xx高字节SendStr(11) = 2数据xx低字节Dim aStr As StringDim i As IntegerFor i = 0 To 11aStr = aStr & Chr(SendStr(i))NextWinsock1.SendData aStrExit SubErrProc:MsgBox传输数据失败”，vbCriticaI网络传输“”End Sub3．写多个字的命令(本例表示写%MW3、%MW4、%MW5 三个字到PLCxx)：Private Sub cmdwrite_CIick()On Error GoTo ErrProcDim SendStr(18) As ByteDim RcvStr() As ByteSendStr(0) = 0 交换'识别号高字节,通常为0SendStr(1) = 0 交换'识别号低字节,通常为0 SendStr(2) = 0 协议'识别号高字节,为0SendStr(3) = 0 协议'识别号低字节,为0 SendStr(4) = 0字节xx高字节SendStr(5) = 13以下字节xx低字节SendStr(6) = 255 单元'识别号,确省为255 SendStr(7) = &H10 写多'个字命令代码SendStr(8) = 0 写数'据的起始地址高字节SendStr(9) = 3 写数'据的起始地址低字节SendStr(10) = 0 数据'长度字数的高字节SendStr(11) = 3 数据'长度字数的低字节SendStr(12) = 6数据xx的字节数SendStr(13) = &HA 写的'第1 个字的高字节SendStr(14) = &HB 写的'第1 个字的低字节SendStr(15) = &HC 写的'第2 个字的高字节SendStr(16) = &HD 写的'第2 个字的低字节SendStr(17) = &HE 写的'第3个字的高字节SendStr(18) = &HF 写的'第3 个字的低字节Dim aStr As StringDim i As IntegerFor i = 0 To 18 aStr = aStr & Chr(SendStr(i)) NextWinsock1.SendData aStrExit SubErrProc:MsgBox传输数据失败”，vbCritical,网络传输“”End Sub4．通讯数据处理(本例是得到4 个字节的数据)：Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Dim a1, a2, b1, b2, s As StringWinsock1.GetData sIf bytesTotal > 12 Thena1 = Hex$(Asc(Mid$(s, 10, 1)))a2 = Hex$(Asc(Mid$(s, 11, 1)))b1 = Hex$(Asc(Mid$(s, 12, 1)))b2 = Hex$(Asc(Mid$(s, 13, 1)))End IftxtReceive.Text = a1 & a2 & “ // ” & b1 & b2If Len(txtReceive.Text) > 5000 ThentxtReceive.Text = Right(txtReceive.Text, 2000)End IfEnd Sub。
基于MODBUS协议的串行通讯例程(VB)
基于MODBUS协议的串行通讯例程（VB）'可通过MODBUS协议获取：主电压、电流、运行状态、DIP开关设置、硬接线状态、统计数据等；'并可通过MODBUS协议控制：启动、急停、软停、双重参数调节、慢速正/反转、节能等；'本例程为通过通讯获取软启动器当前运行状态'编制：董斌 dbboss@Private Const Read_Coil_Status = &H1Private Const Read_Input_Status = &H2Private Const Read_Holding_Registers = &H3Private Const Read_Input_Registers = &H4Private Const Force_Single_Coil = &H5Private Const Single_Registers = &H6Private Const Diagnostics = &H8Private Const Force_Multiple_Coil = &HFPrivate Const Force_Multiple_Register = &H10Public Function CRC16(data() As Byte) As tCRCDim CRC16Hi As ByteDim CRC16Lo As ByteDim Result As tCRCCRC16Hi = &HFFCRC16Lo = &HFFDim i As IntegerDim iIndex As LongFor i = 0 To UBound(data)iIndex = CRC16Lo Xor data(i)CRC16Lo = CRC16Hi Xor GetCRCLo(iIndex) '低位处理CRC16Hi = GetCRCHi(iIndex) '高位处理Next iWith Result.bytLow = CRC16Lo 'CRC低位.bytHigh = CRC16Hi 'CRC高位End WithCRC16 = ResultEnd Function'CRC低位字节值表Private Function GetCRCLo(Ind As Long) As ByteGetCRCLo = Choose(Ind + 1, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80 , &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80 , &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81 , &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80 , &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80 , &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80 , &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80 , &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80 , &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80 , &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80 , &H41, &H1, &HC0, _&H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &H C0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &H C0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &H C0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &H C0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &H C0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &H C0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &H C1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &H C0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &H C0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &H C0, &H80, &H41, &H0, &HC1, &H81, &H40)End Function'CRC高位字节值表Private Function GetCRCHi(Ind As Long) As ByteGetCRCHi = Choose(Ind + 1, &H0, &HC0, &HC1, &H1, &HC3, &H3, &H2, &HC2, &HC6, &H6, &H7, &HC7, &H5, &HC5, &HC4, &H4, &HCC, &HC, &HD, &HC D, &HF, &HCF, &HCE, &HE, &HA, &HCA, &HCB, &HB, &HC9, &H9, &H8, &HC8, &HD8, &H18, &H19, &HD9, &H1B, &HDB, &HDA, &H1A, &H1E, &HDE, &HDF, &H1 F, &HDD, &H1D, &H1C, &HDC, &H14, &HD4, &HD5, &H15, &HD7, &H17, &H16, &HD6, &HD2, &H12, &H13, &HD3, &H11, &HD1, &HD0, &H10, &HF0, &H30, &H3 1, &HF1, &H33, &HF3, &HF2, &H32, &H36, &HF6, &HF7, &H37, &HF5, &H35, &H34, &HF4, &H3C, &HFC, &HFD, &H3D, &HFF, &H3F, &H3E, &HFE, &HFA, &H3 A, &H3B, &HFB, &H39, &HF9, &HF8, &H38, &H28, &HE8, &HE9, &H29, &HEB, &H2B, &H2A, &HEA, &HEE, &H2E, &H2F, &HEF, &H2D, &HED, &HEC, &H2C, &HE 4, &H24, &H25, &HE5, &H27, &HE7, &HE6, &H26, &H22, &HE2, &HE3, &H23, &HE1, &H21, &H20, &HE0, &HA0, &H60, _&H61, &HA1, &H63, &HA3, &HA2, &H62, &H66, &HA6, &HA7, &H67, &HA5, &H65, &H64, &HA4, &H6C, &HAC, &HAD, &H6D, &HAF, &H6F, &H6E, &HAE, &H AA, &H6A, &H6B, &HAB, &H69, &HA9, &HA8, &H68, &H78, &HB8, &HB9, &H79, &HBB, &H7B, &H7A, &HBA, &HBE, &H7E, &H7F, &HBF, &H7D, &HBD, &HBC, &H 7C, &HB4, &H74, &H75, &HB5, &H77, &HB7, &HB6, &H76, &H72, &HB2, &HB3, &H73, &HB1, &H71, &H70, &HB0, &H50, &H90, &H91, &H51, &H93, &H53, &H52, &H92, &H96, &H56, &H57, &H97, &H55, &H95, &H94, &H54, &H9C, &H5C, &H5D, &H9D, &H5F, &H9F, &H9E, &H5E, &H5A, &H9A, &H9B, &H5B, &H99, &H 59, &H58, &H98, &H88, &H48, &H49, &H89, &H4B, &H8B, &H8A, &H4A, &H4E, &H8E, &H8F, &H4F, &H8D, &H4D, &H4C, &H8C, &H44, &H84, &H85, &H45, &H 87, &H47, &H46, &H86, &H82, &H42, &H43, &H83, &H41, &H81, &H80, &H40) End FunctionPublic Function Get_Logic_Status(objRS485_Comm As MSComm, nSerialLink As Byte, _tTimeOut As Double) As tLogic_Status'取软启动器逻辑状态Dim CRC As tCRC, blnTimeOut As BooleanDim outByte() As Byte, T As Double, inByte() As Long, i As Long, r As IntegerDim inChr As String, wStatus As Long, Result As tLogic_StatusReDim outByte(0 To 5) As ByteoutByte(0) = nSerialLink '从设备号outByte(1) = Read_Input_Registers '功能调用号outByte(2) = &H0 '数据所在开始地址(高字节)outByte(3) = &H0 '数据所在开始地址(低字节)outByte(4) = &H0 '读取数据个数（高字节）outByte(5) = &H1 '读取数据个数（低字节）CRC = CRC16(outByte()) '计算CRCReDim Preserve outByte(0 To 7) As ByteWith CRCoutByte(6) = .bytLowoutByte(7) = .bytHighEnd WithobjRS485_Comm.InBufferCount = 0 '清通讯口输入缓存区objRS485_Comm.Output = outByte '输出DoDoEventsLoop Until objRS485_Comm.OutBufferCount = 0 '输出直至完毕T = TimerDoIf Timer - T > tTimeOut Then '超时？blnTimeOut = TrueEnd IfLoop Until (objRS485_Comm.InBufferCount >= 7) Or blnTimeOut '超时或接收数据长度〉7时结束接收If objRS485_Comm.InBufferCount > 0 Then '处理接收数据objRS485_Comm.InputLen = 1i = 0DoinChr = objRS485_Comm.InputReDim Preserve inByte(0 To i) As LonginByte(i) = AscB(inChr)i = i + 1Loop Until objRS485_Comm.InBufferCount = 0wStatus = CLng(inByte(3) * 256) + inByte(4)With Result.blnInsulation = wStatus And &H40& '绝缘报警.blnMotorRunningSlowSpeedReverse = wStatus And &H80& '慢速反转.blnMotorRunningSlowSpeedForward = wStatus And &H100& '慢速正转.blnMotorRunningEnergySaveON = wStatus And &H200& '节能.blnDualAdjON = wStatus And &H400& '双重参数调节.blnMotorRunning = wStatus And &H800& '电机运行.blnMotorStartProcess = wStatus And &H1000& '电机起动过程中.blnMotorSoftStopProcess = wStatus And &H2000& ’电机软停过程中.blnMotorStopped = wStatus And &H4000& ‘电机停止.blnTripped = wStatus And &H8000& ‘跳闸End WithGet_Logic_Status = ResultEnd IfobjRS485_Comm.InBufferCount = 0End Function‘本程序在Windows9x/2k/xp vb6.0 下调试通过。
VB编写的Modbus RTU协议通讯源程序
VB编写的Modbus RTU协议通讯源程序modbus rtu协议可以算是一种事实上的工业标准协议，为许多仪表、PLC等所支持。
以前有几个用户问如何使用VB编程来与我们的KND-K3系列PLC通讯，于是整了一个demo程序。
这次把这个demo共享，希望能给大家一点帮助。
1）模块文件：modCRC，其中包含了CRC校验的函数。
'data 待校验的数组名称'no 数组中元素个数'btLoCRC 算出的CRC高字节'btHiCRC 算出的CRC低字节Public Function CalCRC16Fast(data() As Byte, no As Integer, btLoCRC As Byte, btHiCRC As Byte) As StringDim CL As Byte, CH As Byte '多项式码&HA001Dim SaveHi As Byte, SaveLo As ByteDim i As IntegerDim Flag As IntegerbtHiCRC = &HFFbtLoCRC = &HFFCL = &H1CH = &HA0For i = 0 To (no - 1)btHiCRC = btHiCRC Xor data(i) '每一个数据与CRC寄存器进行异或For Flag = 0 To 7SaveHi = btLoCRCSaveLo = btHiCRCbtLoCRC = btLoCRC \ 2 '高位右移一位btHiCRC = btHiCRC \ 2 '低位右移一位If ((SaveHi And &H1) = &H1) Then '如果高位字节最后一位为1btHiCRC = btHiCRC Or &H80 '则低位字节右移后前面补1End If '否则自动补0If ((SaveLo And &H1) = &H1) Then '如果LSB为1，则与多项式码进行异或btLoCRC = btLoCRC Xor CHbtHiCRC = btHiCRC Xor CLEnd IfNext FlagNext iDim ReturnData(1) As ByteReturnData(0) = btHiCRC 'CRC高位ReturnData(1) = btLoCRC 'CRC低位CalCRC16Fast = ReturnDataEnd FunctionPublic Function CalCRC16Tbl(data() As Byte, no As Integer, btLoCRC As Byte, btHiCRC As Byte) As StringDim btLoCRC As ByteDim btHiCRC As BytebtLoCRC = &HFFbtHiCRC = &HFFDim i As IntegerDim iIndex As LongFor i = 0 To (no - 1)iIndex = btHiCRC Xor data(i)btHiCRC = btLoCRC Xor GetCRCLo(iIndex) '低位处理btLoCRC = GetCRCHi(iIndex) '高位处理Next iDim ReturnData(1) As ByteReturnData(0) = btHiCRC 'CRC高位ReturnData(1) = btLoCRC 'CRC低位CalCRC16Tbl = ReturnDataEnd Function'CRC低位字节值表Function GetCRCLo(Ind As Long) As ByteGetCRCLo = Choose(Ind + 1, _&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, _&H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _&H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, _&H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, _&H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, _&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, _&H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, _&H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, _&H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, _&H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, _&H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, _&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, _&H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, _&H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _&H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, _&H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, _&H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, _&H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, _&H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40)End Function'CRC高位字节值表Function GetCRCHi(Ind As Long) As ByteGetCRCHi = Choose(Ind + 1, _&H0, &HC0, &HC1, &H1, &HC3, &H3, &H2, &HC2, &HC6, &H6, &H7, &HC7, &H5, &HC5, &HC4, &H4, &HCC, &HC, &HD, &HCD, &HF, &HCF, &HCE, &HE, &HA, &HCA, &HCB, &HB, &HC9, &H9, &H8, &HC8, &HD8, &H18, &H19, &HD9, &H1B, &HDB, &HDA, &H1A, &H1E, &HDE, &HDF, &H1F, &HDD, &H1D, &H1C, &HDC, &H14, &HD4, &HD5, &H15, &HD7, &H17, &H16, &HD6, &HD2, &H12, &H13, &HD3, &H11, &HD1, &HD0, &H10, &HF0, &H30, &H31, &HF1, &H33, &HF3, &HF2, &H32, &H36, &HF6, &HF7, &H37, &HF5, &H35, &H34, &HF4, &H3C, &HFC, &HFD, &H3D, &HFF, &H3F, &H3E, &HFE, &HFA, &H3A, &H3B, &HFB, &H39, &HF9, &HF8, &H38, &H28, &HE8, &HE9, &H29, &HEB, &H2B, &H2A, &HEA, &HEE, &H2E, &H2F, &HEF, &H2D, &HED, &HEC, &H2C, &HE4, &H24, &H25, &HE5, &H27, &HE7, &HE6, &H26, &H22, &HE2, &HE3, &H23, &HE1, &H21, &H20, &HE0, &HA0, &H60, _ &H61, &HA1, &H63, &HA3, &HA2, &H62, &H66, &HA6, &HA7, &H67, &HA5, &H65, &H64, &HA4, &H6C, &HAC, &HAD, &H6D, &HAF, &H6F, &H6E, &HAE, &HAA, &H6A, &H6B, &HAB, &H69, &HA9, &HA8, &H68, &H78, &HB8, &HB9, &H79, &HBB, &H7B, &H7A, &HBA, &HBE, &H7E, &H7F, &HBF, &H7D, &HBD, &HBC, &H7C, &HB4, &H74, &H75, &HB5, &H77, &HB7, &HB6, &H76, &H72, &HB2, &HB3, &H73, &HB1, &H71, &H70, &HB0, &H50, &H90, &H91, &H51, &H93, &H53, &H52, &H92, &H96, &H56, &H57, &H97, &H55, &H95, &H94, &H54, &H9C, &H5C, &H5D, &H9D, &H5F, &H9F, &H9E, &H5E, &H5A, &H9A, &H9B, &H5B, &H99, &H59, &H58, &H98, &H88, &H48, &H49, &H89, &H4B, &H8B, &H8A, &H4A, &H4E, &H8E, &H8F, &H4F, &H8D, &H4D, &H4C, &H8C, &H44, &H84, &H85, &H45, &H87, &H47, &H46, &H86, &H82, &H42, &H43, &H83, &H41, &H81, &H80, &H40)End Function2）窗体：FORM1，上面放置的控件如下：Begin VB.Form frmComCaption = "Form1"ClientHeight = 8235ClientLeft = 3885ClientTop = 2250ClientWidth = 6810LinkTopic = "Form1"ScaleHeight = 8235ScaleWidth = 6810Begin VB.TextBox txtReceive ‘注：放置接收上来的IB0数据Height = 495Left = 1200TabIndex = 2Top = 2280Width = 1335EndBegin mandButton Command1Caption = "读取IB0"Height = 495Left = 2760TabIndex = 1Top = 2280Width = 1695EndBegin mandButton cmdSDOCaption = "置位Q1.1"Height = 495Left = 2160TabIndex = 0Top = 3720Width = 1575EndBegin MSCommLib.MSComm ComK3Left = 480Top = 1080_ExtentX = 1005_ExtentY = 1005_V ersion = 393216DTREnable = -1 'TrueEnd①Form_Load事件，在此主要是实现了打开并初始化串口Private Sub Form_Load()With ComK3.CommPort = 1.Settings = "19200,N,8,1".InputMode = comInputModeBinary '二进制收发.InBufferSize = 512.OutBufferSize = 512If (Not .PortOpen) Then .PortOpen = True End WithEnd Sub②Form_UnLoad事件，在此主要是关闭串口Private Sub Form_Unload(Cancel As Integer)If (ComK3.PortOpen) ThenComK3.PortOpen = FalseEnd IfEnd Sub③“置位Q1.1”按钮单击事件'设置Q1.1为1Private Sub cmdSDO_Click()Dim btSend(8) As BytebtSend(0) = &H1 '目标站号btSend(1) = &H5 '功能码btSend(2) = &H0 'Q1.1地址（0009）高字节btSend(3) = &H9 'Q1.1地址（0009）低字节btSend(4) = &HFF '强制值高字节btSend(5) = &H0 '强制值低字节Dim crcDim btCRCHi As Byte, btCRCLo As Bytecrc = CalCRC16Fast(btSend, 6, btCRCLo, btCRCHi)btSend(6) = btCRCHibtSend(7) = btCRCLoComK3.Output = CV ar(btSend)End Sub④“读取IB0”按钮单击事件'查表知I0.0的modbus地址为0000，从I0.0开始读取连续8位Private Sub Command1_Click()'发请求Dim btSend(8) As BytebtSend(0) = &H1 '目标站号btSend(1) = &H2 '功能码btSend(2) = &H0 'I0.0地址（0000）高字节btSend(3) = &H0 'i0.0地址（0000）低字节btSend(4) = &H0 '读取个数高字节btSend(5) = &H8 '读取个数低字节Dim crcDim btCRCHi As Byte, btCRCLo As Bytecrc = CalCRC16Fast(btSend, 6, btCRCLo, btCRCHi)btSend(6) = btCRCHibtSend(7) = btCRCLoComK3.Output = CV ar(btSend)'注意下面编写的接收过程很简单，要编写实际应用的监控程序来说需要更完善Dim btReceive As V ariantWith ComK3DoDoEventsLoop Until .InBufferCount = 6.InputLen = 6btReceive = .InputIf btReceive(1) = &H2 Then '若正确，返回帧的第2个字节为功能码.实际上，此处应首先进行CRC校验txtReceive.Text = Hex$(btReceive(3))End IfEnd WithEnd Sub。
MODBUS通讯协议及编程
MODBUS通讯协议及编程一、协议概述MODBUS通讯协议是一种常用的串行通信协议，用于在工业自动化领域中实现设备之间的数据交换。
该协议简单、易于实现，并且具有广泛的应用范围。
本协议旨在提供一种规范的通信方式，以确保不同设备之间的互操作性。
二、协议结构MODBUS通讯协议采用主从结构，其中主机负责发起通信请求，从机负责响应请求并提供所需的数据。
通信过程中，主机通过发送请求帧来获取或设置从机的数据。
1. 物理层MODBUS通讯协议可以在不同的物理层上实现，如串口、以太网等。
在选择物理层时，需根据具体的应用场景和设备特性进行合理选择。
2. 帧格式MODBUS通讯协议的帧格式如下：- 起始位：一个起始位，用于标识帧的开始。
- 地址位：一个地址位，用于指定从机的地址。
- 功能码：一个功能码，用于指定所需的操作类型。
- 数据域：根据具体的功能码，用于传输数据。
- CRC校验：一个循环冗余校验，用于检测数据传输过程中的错误。
3. 功能码MODBUS通讯协议定义了一系列功能码，用于指定不同的操作类型。
常用的功能码包括：- 读取线圈状态：用于读取从机的线圈状态。
- 读取输入状态：用于读取从机的输入状态。
- 读取保持寄存器：用于读取从机的保持寄存器数据。
- 读取输入寄存器：用于读取从机的输入寄存器数据。
- 写单个线圈：用于设置从机的单个线圈状态。
- 写单个寄存器：用于设置从机的单个寄存器数据。
三、编程实现MODBUS通讯协议的编程实现可以通过不同的编程语言来完成。
下面以Python语言为例，介绍如何使用Python编写MODBUS通讯程序。
1. 安装依赖库首先，需要安装Python的MODBUS依赖库，如pymodbus等。
可以通过pip 命令进行安装。
2. 连接从机使用Python的MODBUS库，可以通过以下代码连接从机：```pythonfrom pymodbus.client.sync import ModbusSerialClient# 创建串口连接client = ModbusSerialClient(method='rtu', port='/dev/ttyUSB0', baudrate=9600) # 连接从机client.connect()```3. 读取数据使用Python的MODBUS库，可以通过以下代码读取从机的数据：```python# 读取保持寄存器数据result = client.read_holding_registers(address=0, count=10, unit=1)# 解析数据if result.isError():print("读取数据失败")else:print("读取数据成功")for i in range(result.registers):print(f"寄存器{i}的值为：{result.registers[i]}")```4. 写入数据使用Python的MODBUS库，可以通过以下代码向从机写入数据：```python# 写入单个寄存器数据result = client.write_register(address=0, value=1234, unit=1)# 检查写入结果if result.isError():print("写入数据失败")else:print("写入数据成功")```四、总结本协议详细介绍了MODBUS通讯协议及编程实现。
MODBUS vb实现
Private Sub btnSend_Click(Index As Integer)Select Case IndexCase 0 '03命令测试' MsgBox (cmbSlId(0).Text)Label9.Caption = CommandQuery03(cmbSlId(0).Text, Val(cmbRegAdd(0).Text) - 1, cmbDataType(0).Text)lblSlaveStatus(0).Caption = "读从机，等待！"Case 1 '16命令测试If Not IsNumeric(txtWriteData.Text) ThenMsgBox ("请输入数据！")txtSend(1).Text = ""txtSend(1).SetFocusExit SubEnd IftxtSend(1).Text = CommandQuery16(cmbSlId(1).Text, Val(cmbRegAdd(1).Text), cmbDataType(1).Text, txtWriteData.Text)lblSlaveStatus(1).Caption = "写从机,等待响应"txtReceive(1).Text = ""Case 2 '08命令测试If Not IsNumeric(txtDignoseAsk.Text) ThenMsgBox ("请输入数据！")txtSend(2).Text = ""txtDignoseAsk.Text = ""txtDignoseAsk.SetFocusExit SubEnd IftxtSend(2).Text = CommandQuery08(cmbSlId(2).Text, cmbDataType(2).Text, txtDignoseAsk.Text)lblSlaveStatus(2).Caption = "诊断从机,等待响应"txtReceive(2).Text = ""txtDignoseBack.Text = ""Case ElseEnd SelectEnd SubPrivate Sub Command1_Click()On Error Resume NextSetPortWith MSComm1If .PortOpen = True Then.PortOpen = FalseCommand1.Caption = "打开串口"Shape1.FillColor = &HFF&Label11.Caption = "串口已关闭"Label6.Caption = "串口状态：关闭"ElseCommand1.Caption = "关闭串口".PortOpen = TrueLabel6.Caption = "串口状态：打开"Shape1.FillColor = &HC000&Label11.Caption = "串口已打开"If Err.Number <> 0 ThenLabel11.Caption = "串口已使用"Err.ClearEnd IfEnd IfEnd With'MsgBox (MSComm1.PortOpen)End SubPrivate Sub SetPort()Dim curPortOpen As BooleanDim intCommPort As IntegerDim strCheckBit As StringDim strSettings As StringDim i As IntegerSelect Case Combo1.TextCase "COM1"intCommPort = 1Case "COM2"intCommPort = 2Case "COM3"intCommPort = 3Case "COM4"intCommPort = 4Case "COM5"intCommPort = 5Case "COM6"intCommPort = 6Case "COM7"intCommPort = 7Case "COM8"intCommPort = 8Case "COM9"intCommPort = 9Case ElseintCommPort = 1End SelectSelect Case Combo2.TextCase "NONE"strCheckBit = "n"Case "EVEN"strCheckBit = "e"Case "ODD"strCheckBit = "o"Case ElsestrCheckBit = "n"End Select'9600,n,8,1strSettings = Combo4.Text & "," & strCheckBit & "," & Combo5.Text & "," & Combo3.Text curPortOpen = MSComm1.PortOpenmPort = intCommPortMSComm1.Settings = strSettingsIf (Command1.Caption = "打开连接") ThenShape1.FillColor = &HFF&MSComm1.PortOpen = TrueCommand1.Caption = "关闭连接"ElseIf (MSComm1.PortOpen = True) ThenMSComm1.PortOpen = FalseEnd IfEnd IfEnd SubPrivate Sub MSComm1_Click()End SubPrivate Sub Form_Load()Combo5.AddItem (8)Combo5.AddItem (7)Combo3.AddItem (1)Combo3.AddItem (2)Dim i As IntegercmbDataType(0).AddItem ("16位整数")cmbDataType(0).AddItem ("32位整数")cmbDataType(0).AddItem ("64位整数")cmbDataType(0).AddItem ("32位浮点型")For i = 1 To 255cmbSlId(0).AddItem (i)Next icmbSlId(0).Text = 1cmbDataType(0).Text = "16位整数"For m = 1 To 1000cmbRegAdd(0).AddItem (m)Next mcmbRegAdd(0).Text = 100End SubPublic Function CommandQuery03(strSlaveAdd As String, strBeginAdd As String, strDataType As String) As StringDim longCRC As LongDim i As IntegerDim strQuery As StringbyteModbusQurey(0) = strSlaveAdd 'Slave AddbyteModbusQurey(1) = 3 'FunctionbyteModbusQurey(2) = 0 'RegAddHibyteModbusQurey(3) = strBeginAdd 'RegAddLobyteModbusQurey(4) = 0 'RegNumHiSelect Case strDataType 'RegNumLoCase "16位整数"byteModbusQurey(5) = 1Case "32位整数"byteModbusQurey(5) = 2Case "64位整数"byteModbusQurey(5) = 4Case "32位浮点数"byteModbusQurey(5) = 2Case ElsebyteModbusQurey(5) = 1'cmbDataType(0).Text = "16位整数"End SelectlongCRC = CRC16(byteModbusQurey, 6)byteModbusQurey(6) = (longCRC And &HFF00) \ 256 'CRCHibyteModbusQurey(7) = longCRC And &HFF 'CRCLostrQuery = ""For i = 0 To 7strQuery = strQuery + ByteDataToString(byteModbusQurey(i)) + " "Next iCommandQuery03 = strQueryintQueryNum = 8Call SendCommand(byteModbusQurey, intQueryNum)'lblSlaveStatus(0).Caption = "读取从机,等待响应"End Function'****************************************************************************** ********************************'Private Function CommandQuery16(strSlaveAdd As String, strBeginAdd As String, strDataType As String,cryWriteData as currency) As String'功能: 16号命令'参数: 无'返回: 无'修改历史:'****************************************************************************** ********************************Public Function CommandQuery16(strSlaveAdd As String, strBeginAdd As String, strDataType As String, strWriteData As String) As StringDim longCRC As LongDim i As IntegerDim strQuery As StringDim byteByteData() As ByteDim cryData As CurrencyDim intByteDataLength As IntegerDim byteTmp(1) As BytebyteModbusQurey(0) = strSlaveAdd 'Slave AddbyteModbusQurey(1) = 16 'FunctionbyteModbusQurey(2) = 0 'RegAddHibyteModbusQurey(3) = strBeginAdd 'RegAddLobyteModbusQurey(4) = 0 'RegNumHiSelect Case strDataType 'RegNumLoCase "16位整数"byteModbusQurey(5) = 1Case "32位整数"byteModbusQurey(5) = 2Case "64位整数"byteModbusQurey(5) = 4Case "32位浮点数"byteModbusQurey(5) = 2Case ElsebyteModbusQurey(5) = 1cmbDataType(1).Text = "16位整数"End SelectbyteModbusQurey(6) = byteModbusQurey(5) * 2 'ByteNumcryData = strWriteDatabyteByteData = DataToByteArray(cryData, strDataType)'按字倒序intByteDataLength = UBound(byteByteData) + 1For i = 0 To intByteDataLength \ 2 - 1 Step 2byteTmp(0) = byteByteData(i)byteTmp(1) = byteByteData(i + 1)byteByteData(i) = byteByteData(intByteDataLength - 2 - i)byteByteData(i + 1) = byteByteData(intByteDataLength - 2 + 1 - i)byteByteData(intByteDataLength - 2 - i) = byteTmp(0)byteByteData(intByteDataLength - 2 + 1 - i) = byteTmp(1)Next i'写入的数据加入请求数组For i = 0 To intByteDataLength - 1byteModbusQurey(7 + i) = byteByteData(i)Next ilongCRC = CRC16(byteModbusQurey, 7 + byteModbusQurey(6))byteModbusQurey(7 + byteModbusQurey(6)) = (longCRC And &HFF00) \ 256 'CRCHibyteModbusQurey(8 + byteModbusQurey(6)) = longCRC And &HFF'CRCLostrQuery = ""For i = 0 To 8 + byteModbusQurey(6)strQuery = strQuery + ByteDataToString(byteModbusQurey(i)) + " "Next iCommandQuery16 = strQueryintQueryNum = 9 + byteModbusQurey(6)Call SendCommand(byteModbusQurey, intQueryNum)End Function'****************************************************************************** ********************************'Private Function CommandQuery08(strSlaveAdd As String, strDataType As String, cryDignoseData As Currency) As String'功能: 08号命令'参数: 无'返回: 无'修改历史:'****************************************************************************** ********************************Public Function CommandQuery08(strSlaveAdd As String, strDataType As String, cryDignoseData As Currency) As StringDim longCRC As LongDim i As IntegerDim strQuery As StringDim byteByteData() As ByteDim cryData As CurrencyDim intByteDataLength As IntegerDim byteTmp(1) As BytebyteModbusQurey(0) = strSlaveAdd 'Slave AddbyteModbusQurey(1) = 8 'FunctionbyteModbusQurey(2) = 0 'Subfunction HibyteModbusQurey(3) = 0 'Subfunction LocryData = cryDignoseDatabyteByteData = DataToByteArray(cryData, strDataType)byteModbusQurey(4) = byteByteData(0)byteModbusQurey(5) = byteByteData(1)longCRC = CRC16(byteModbusQurey, 6)byteModbusQurey(6) = (longCRC And &HFF00) \ 256 'CRCHibyteModbusQurey(7) = longCRC And &HFF 'CRCLostrQuery = ""For i = 0 To 7strQuery = strQuery + ByteDataToString(byteModbusQurey(i)) + " "Next iCommandQuery08 = strQueryintQueryNum = 8Call SendCommand(byteModbusQurey, intQueryNum)End FunctionPublic Function CRC16(data() As Byte, length As Integer) As Long Dim i As Integer, j As IntegerDim Bit As BooleanDim Temp As ByteDim CRC As LongDim Generator As LongCRC = 65535Generator = 40961For i = 0 To length - 1Temp = data(i)CRC = CRC Xor TempFor j = 1 To 8Bit = CRC And 1CRC = CRC \ 2If Bit = True ThenCRC = CRC Xor GeneratorEnd IfNext jNext iCRC16 = CRC \ 256CRC = (CRC - CRC16 * 256) * 256CRC16 = CRC + CRC16End FunctionPublic Function ByteDataToString(data As Byte) As StringDim OutString As StringDim datahi As ByteDim datalo As Bytedatahi = data \ 16datalo = data And &HFSelect Case datahiCase 0OutString = "0"Case 1OutString = "1"Case 2OutString = "2"Case 3OutString = "3"Case 4OutString = "4"Case 5OutString = "5"Case 6OutString = "6"Case 7OutString = "7"Case 8OutString = "8"Case 9OutString = "9"Case 10OutString = "A"Case 11OutString = "B"Case 12OutString = "C"Case 13OutString = "D"Case 14OutString = "E"Case 15OutString = "F"Case ElseOutString = "0"End SelectSelect Case dataloCase 0OutString = OutString + "0" Case 1OutString = OutString + "1" Case 2OutString = OutString + "2" Case 3OutString = OutString + "3" Case 4OutString = OutString + "4" Case 5OutString = OutString + "5" Case 6OutString = OutString + "6"Case 7OutString = OutString + "7"Case 8OutString = OutString + "8"Case 9OutString = OutString + "9"Case 10OutString = OutString + "A"Case 11OutString = OutString + "B"Case 12OutString = OutString + "C"Case 13OutString = OutString + "D"Case 14OutString = OutString + "E"Case 15OutString = OutString + "F"Case ElseOutString = OutString + "0"End SelectByteDataToString = OutStringEnd FunctionPublic Sub SendCommand(byteQueryArr() As Byte, length As Integer) Dim byteQ() As ByteDim i As IntegerReDim byteQ(length) As ByteFor i = 0 To length - 1byteQ(i) = byteQueryArr(i)Next iIf MSComm1.PortOpen = True ThenMSComm1.OutBufferCount = 0 '清空发送缓冲区MSComm1.Output = byteQintResponseNum = 0MSComm1.InBufferCount = 0 '清空接收缓冲区MSComm1.RThreshold = 1'等待接收数据timerReceiveTimeOut.Interval = 3000 '三秒无数据报错误timerReceiveTimeOut.Enabled = True '启动定时器End IfEnd SubPublic Sub delay(ms As Integer)Dim Savetime As DoubleSavetime = timeGetTime '记下开始时的时间While timeGetTime < Savetime + ms '循环等待DoEvents '转让控制权，以便让操作系统处理其它的事件。
用VB实现Modbus串行通讯
如何用VB实现Modbus串行通讯在一些应用中可能需要使用诸如VB来进行上位机监控程序的开发，而Modbus协议是这类应用中首选的通讯协议；Modbus协议以其简单易用，在工业领域里已广泛的为其他第三方设备所支持。
这里对VB和Twido PLC间的通讯进行说明。
对于大部分应用，Twido PLC作为从站，它不需要编制通讯程序，只要把通讯口的参数设置好即可，例如下图表示此Twido通过编程口和上位机连接，其站号地址为2；波特率、数据位、校验、停止位和上位机设置保持一致。
VB程序通过利用MSComm控件很容易就能够实现。
1．通讯口初始化：MSComm1.Settings = "9600,n,8,1"mPort = 1MSComm1.SThreshold = 0If Not MSComm1.PortOpen Then MSComm1.PortOpen = True2．CRC校验码的计算方法，如以下函数，可以得到字节数组变量cmdstring指向的字符串的CRC校验码。
Function crc16_1(ByRef cmdstring() As Byte, ByVal j As Integer)Dim data As IntegerDim i As IntegerAddressreg_crc = &HFFFFFor i = 0 To jAddressreg_crc = Addressreg_crc Xor cmdstring(i)For j = 0 To 7data = Addressreg_crc And &H1If data ThenAddressreg_crc = Int(Addressreg_crc / 2)Addressreg_crc = Addressreg_crc And &H7FFFAddressreg_crc = Addressreg_crc Xor &HA001ElseAddressreg_crc = Addressreg_crc / 2Addressreg_crc = Addressreg_crc And &H7FFFEnd IfNext jNext iIf Addressreg_crc < 0 ThenAddressreg_crc = Addressreg_crc - &HFFFF0000End IfHiByte = Addressreg_crc And &HFFLoByte = (Addressreg_crc And &HFF00) / &H100End Function3．读多个字的命令（本例是从2号站读%MW10起始的4个字）：Dim SendStr(7) As ByteDim RcvStr() As ByteSendStr(0) = 2 ,从站号是2SendStr(1) = &H3 ,读多个字的命令代码SendStr(2) = 0 ,起始地址高字节SendStr(3) = 10,起始地址低字节SendStr(4) = &H0,数据长度高字节SendStr(5) = 4 ,数据长度低字节Call crc16(SendStr(), 5) ,CRC计算SendStr(6) = HiByteSendStr(7) = LoByte,读命令发送后,当接收5 + SendStr(5) * 2 个字节时产生中断CmdLenth = 5 + SendStr(5) * 2MSComm1.RThreshold = CmdLenthMSComm1.Output = SendStr ,发送命令4．写多个字的命令（本例是写2号站%MW20起始的3个字）：Dim WriteStr() As Bytek = 6 ,写6个字节ReDim WriteStr(8 + k)WriteStr(0) = 2 ,从站号是2WriteStr(1) = &H10 ,写多个字的命令代码WriteStr(2) = 0 ,起始地址高字节WriteStr(3) = 20 ,起始地址低字节WriteStr(4) = &H0 ,数据长度高字节<字的个数> WriteStr(5) = k / 2 ,数据长度低字节<字的个数>WriteStr(6) = k ,数据长度<字节的个数> WriteStr(7) = &H12,写的第1个字的高字节WriteStr(8) = &H34,写的第1个字的低字节WriteStr(9) = &H56,写的第2个字的高字节WriteStr(10) = &H78,写的第2个字的低字节WriteStr(11) = &H9A,写的第3个字的高字节WriteStr(12) = &HBC,写的第3个字的低字节Call crc16(WriteStr(), 6 + k)WriteStr(9 + (k / 2 - 1) * 2) = HiByteWriteStr(10 + (k / 2 - 1) * 2) = LoByteMSComm1.InBufferCount = 0MSComm1.Output = WriteStr,写命令发送后,当接收到8个字节时中断CmdLenth = 8MSComm1.RThreshold = CmdLenth5．通讯事件中断产生时的数据处理：Private Sub MSComm1_OnComm()Dim inx() As ByteSelect Case mEventCase comEvReceive ,判断为接收事件MSComm1.InputLen = CmdLenth ,接收数据的长度inx = MSComm1.Input ,接收数据MSComm1.InBufferCount = 0For k = 3 To CmdLenth - 3tmpstr = tmpstr & "/" & Hex(inx(k))NextText1.Text = tmpstr ,以十六进制显示所接收长度的数据BeepEnd SelectEnd Sub。
用VB写的modbusrtu模式通讯源码
用VB写的modbusrtu模式通讯源码‘用VB 写的modbus rtu模式通讯源码，已在台达PLC上调试通过Private Sub CmdOpen_Click()On Error Resume NextIf (MSComm1.PortOpen) Then ‘打开/关闭串口MSComm1.PortOpen = FalseElseMSComm1.PortOpen = TrueEnd IfIf (MSComm1.PortOpen) ThenCmdOpen.Caption = "关闭串口"Shape5.FillStyle = vbFSSolidElseCmdOpen.Caption = "打开串口"Shape5.FillStyle = vbFSTransparentEnd IfIf Err ThenMsgBox Error$, 48, "错误码信息"Exit SubEnd IfEnd SubPrivate Sub Combo1_Click()/doc/df18763589.html,mPort = Combo1.ListIndex + 1End SubPrivate Sub Combo2_Click()Call SettingEnd SubPrivate Sub Combo3_Click()Call SettingEnd SubPrivate Sub Combo4_Click()Call SettingEnd SubPrivate Sub Combo5_Click()Call SettingEnd SubPrivate Sub Command1_Click()‘S hape1.FillStyle = vbFSSolidDim Y0_status As ByteDim Sendstr As StringDim i As Integer, j As IntegerSendstr = "01 01 05 00 00 10 "HexSend (Sendstr)Sleep (30)HexSend (Sendstr)End SubPrivate Function HexSend(Sendstr As String) As Integer Dim outbuf() As ByteDim Temp(0) As ByteDim crc As String, Sendstrls As StringDim sendlen As IntegerDim i As Integer, j As IntegerIf Sendstr = "" ThenMsgBox "发送数据不能为空！"HexSend = 0Exit FunctionEnd IfS endstrls = Trim(Sendstr) ‘去掉空格sendlen = Len(Sendstrls) + 1 ‘取长度j = 0ReDim outbuf(1 To sendlen \ 3) As ByteFor i = 1 To sendlen Step 3j = j + 1outbuf(j) = Val("&H" & CStr(Mid(Sendstrls, i, 2)))Next icrc = Crc16(outbuf)ReDim Preserve outbuf(1 T o (sendlen \ 3 + 2)) As Byte ‘加上CRC校验码outbuf(sendlen \ 3 + 1) = Val("&H" & CStr(Mid(crc, 1, 2)))outbuf(sendlen \ 3 + 2) = Val("&H" & CStr(Mid(crc, 3, 2)))For i = 1 To (sendlen \ 3 + 2)Temp(0) = outbuf(i)MSComm1.Output = TempNext iFor i = 1 To 2000Next iHexSend = 1End FunctionPrivate Function Setting()MSComm1.Settings = CStr(Combo2.Text) & "," & CStr(Combo3.Text) & "," & CStr(Combo4.Text) & "," & CStr(Combo5.Text) End FunctionPrivate Sub Command2_Click()‘If (MSComm1.RThreshold = 0) Then‘MSComm1.RTh reshold = 1‘Else‘MSComm1.RThreshold = 0‘End IfLabel11.Caption = "接收个数:" & CStr(ReceCount) & " " & "接收帧数：" & CStr(Framecount) End SubPrivate Sub Form_Load()Combo1.AddItem ("COM1")Combo1.AddItem ("COM2")Combo1.AddItem ("COM3")Combo1.AddItem ("COM4")Combo1.AddItem ("COM5")Combo1.ListIndex = 0Combo2.AddItem ("2400")Combo2.AddItem ("4800")Combo2.AddItem ("9600")Combo2.AddItem ("11520")Combo2.ListIndex = 0Combo3.AddItem ("E")Combo3.AddItem ("O")Combo3.AddItem ("N")Combo3.ListIndex = 2Combo4.AddItem ("6")Combo4.AddItem ("7")Combo4.AddItem ("8")Combo4.ListIndex = 2Combo5.AddItem ("1")Combo5.AddItem ("2")Combo5.ListIndex = 0ReceCount = 0End SubPrivate Function Crc16(data() As Byte) As StringDim CRC16Lo As Byte, CRC16Hi As Byte ‘CRC寄存器Dim CL As Byte, CH As Byte ‘多项式码&HA001Dim CrcLo As String, CrcHi As StringDim SaveHi As Byte, SaveLo As ByteDim i As IntegerDim Flag As IntegerCRC16Lo = &HFFCRC16Hi = &HFFCL = &H1CH = &HA0For i = 1 To UBound(data)CRC16Lo = CRC16Lo Xor data(i) ‘每一个数据与CRC寄存器进行异或For Flag = 0 To 7SaveHi = CRC16HiSaveLo = CRC16LoCRC16Hi = CRC16Hi \ 2 ‘高位右移一位CRC16Lo = CRC16Lo \ 2 ‘低位右移一位If ((SaveHi And &H1) = &H1) Then ‘如果高位字节最后一位为1CRC16Lo = CRC16Lo Or &H80 ‘则低位字节右移后前面补1 End If ‘否则自动补0If ((SaveLo And &H1) = &H1) Then ‘如果LSB为1，则与多项式码进行异或CRC16Hi = CRC16Hi Xor CHCRC16Lo = CRC16Lo Xor CLEnd IfNext FlagNext iIf Len(Hex(CRC16Hi)) = 1 ThenCrcHi = "0" + Hex(CRC16Hi)ElseCrcHi = Hex(CRC16Hi)End IfIf Len(Hex(CRC16Lo)) = 1 ThenCrcLo = "0" + Hex(CRC16Lo)ElseCrcLo = Hex(CRC16Lo)End IfCrc16 = CrcLo & CrcHiEnd FunctionPrivate Sub MSComm1_OnComm()Dim inpu() As ByteDim i As IntegerDim tempstr As String, Strdata As StringSelect Case /doc/df18763589.html,mEvent Case comEvReceive ‘接收事件tempstr = MSComm1.Inputinpu() = tempstrFramecount = Framecount + 1 ‘帧个数加1If (Framecount = 1) Thenframepoint(Framecount) = UBound(inpu) + 1 ‘第一帧帧尾Elseframepoint(Framecount) = framepoint(Framecount - 1) + UBound(inpu) + 1 ‘第二帧开始指针End IfFor i = 0 To UB ound(inpu) ‘将字符转换为数组If (Len(Hex(inpu(i))) = 1) ThenStrdata = Strdata & "0" & Hex(inpu(i)) & " "ElseStrdata = Strdata & Hex(inpu(i)) & " "End IfNext iFor i = ReceCount + 1 To UBound(inpu) + 1 ‘数据进入缓冲区Recebuf(i) = inpu(i - 1)NextReceCount = ReceCount + UBound(inpu) + 1TextReceive.Text = TextReceive.Text & StrdataStrdata = ""Case comEvSendEnd SelectEnd SubPrivate Function RtuCheck(data() As Byte) As IntegerDim CrcHi As Byte, CrcLo As ByteDim Checkdata() As ByteDim i As IntegerDim crc As StringCrcHi = data(UBound(data))CrcLo = data(UBound(data) - 1)ReDim Checkdata(1 To (UBound(data) - 1)) As ByteFor i = 1 To (UBound(data) - 1) ‘附值Checkdata(i) = data(i - 1)Nextcrc = Crc16(Checkdata)If (CrcLo = Val("&H" & CStr(Mid(crc, 1, 2))) And CrcHi = Val("&H" & CStr(Mid(crc, 3, 2)))) Then RtuCheck = 1ElseRtuCheck = 0End IfEnd Function。