用VB实现Modbus RTU串行通讯工程实例

用VB编写modbus源代码的过程

用VB编写modbus源代码的过程今天是周六，现在刚从单位自愿加班回来。

为什么自愿加班呢？因为自己和老板夸下海口说：一个礼拜把modbus上位机程序写好（也就是这个礼拜拉）。

现在终于把这个程序写好拉。

感想很多啊！该如何说起呢？我语文不好，把自己想表达的意思说出来就行拉。

首先：还是那句话：一切得靠自己！上周一时，老板说让我做个modbus界面，我想：这个简单啊。

不就是串口收发么?于是我计划安排上写了1个礼拜搞定。

然后开始安装DELPHI（我在单位一直搞C编程，机子没有装这些），完后就打开我那曾经熟悉的界面。

恩？怎么看似熟悉的界面怎么这么陌生呢/于是上网找资料。

这个3天的期间我感慨好深啊：因为我大四学习的DELPHI，所以我感觉这个还熟悉点，可是当时做课程设计的时候也没有用过串口，这个串口编程咋得和MCU串口不一样呢？它就是不一样！晕晕。

上网找SPCOMM。

，学习了一天也不会用。

于是徒劳了3天也没有效果。

转眼就到了周四，我心里那个急呀。

唉！还是忍痛抛弃delphi吧！为什么呢？它没有自带串口控件，下载并安装了还是出错啊。

VB好象是我大二学的，具体时间我也忘了，反正就记得做课设的时候用它连个ACCESS实现了插入删除查询工作。

以后知道这个周四我也没有用过，甚至没有见到过它的界面。

我选择它一个因为我选择，我喜欢。

更重要的是它安装了自带串口控件，不用下载什么的了，用起来实打实的心里有底。

大家现在知道我的底子了吧？周四我借公司里的一本VB书看了一天的串口，然后心理有底了，周五动手一天，收获很大，今天早晨8点起床，心理还琢磨着程序的事情，由于家里没有实验仪器，于是打算去公司，一直做到现在，终于搞定拉。

这个礼拜上网找源代码的时候看着好多像我一样找源码的人发帖子要源程序，但是大多只是网页写了一大堆代码。

没有用！为什么呢？你怎么知道人家用什么控件，什么功能呢？还是老老实实的自己写吧。

没什么的，很简单的啊。

说实话，这个程序只要你把浮躁的心放下来写就可以了。

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'数据位改变Private Sub Combo2_Click()Call settingEnd Sub'波特率改变Private Sub Combo3_Click()Call settingEnd Sub'奇偶校验改变Private Sub Combo4_Click()Call settingEnd Sub'停止位改变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'打开关闭串口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进制Private Sub Command2_Click(Index As Integer)On Error Resume NextText4.Text = Hex(Text3.Text)If Err Then''则显示出错信息MsgBox Error$, 48, "错误信息"Exit SubEnd If'16转10进制Private Sub Command3_Click()Dim a As Longa = Val("&H"& CStr(Text4.Text))Text3.Text = aEnd Sub'手动串口发送Private Sub Command4_Click()If MSComm1.PortOpen = False ThenMsgBox"请先打开串口", , "错误信息" Exit SubEnd IfCall sentsubEnd Sub'清除接收窗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'串口接收程序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 '十六进制显示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 码显示End IfEnd Sub'手动发送选择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'自动发送选择 Private Sub Option2_Click()If Option2.value = True ThenTimer1.Enabled = TrueCommand4.Enabled = FalseElseTimer1.Enabled = FalseCommand4.Enabled = TrueEnd IfEnd SubPrivate Sub Option3_Click() 'Non选项 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选项 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选项 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'发送时间间隔调整输入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'自动发送定时器Private Sub Timer1_Timer()If MSComm1.PortOpen ThenCall sentsubEnd IfEnd Sub'状态刷新定时器Private Sub Timer2_Timer()StatusBar1.Panels(1).Text = "串口选择：" & CStr(Comb o1.Text)StatusBar1.Panels(2).Text = "串口设置：" & CStr(MSC omm1.Settings)StatusBar1.Panels(3).Text = "串口状态：" & 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'十六进制发送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"无效的数值，请重新输入", , "错误信息" 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码发送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))) '两个两个的取字符checksum = checksum + char'全部加起来NextAscLrc = checksum Mod&H100 '取255的余数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)) '两个两个的取字符 checksum = checksum + char'全部加起来NextLrc = (checksum + &H3) Mod&H100 '取255的余数 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校验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"输入错误，请重新输入", , "错误提示"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'显示出错信息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"输入错误，请重新输入", , "错误提示"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'显示出错信息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寄存器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'高位右移一位CRC16Lo = CRC16Lo \ 2'低位右移一位If((SaveHi And&H1) = &H1) Then'如果高位字节最后一位为1CRC16Lo = CRC16Lo Or&H80 '则低位字节右移后前面补1End If'否则自动补0If((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。

基于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。

VB中串口通讯的实现

VB中串口通讯的实现在VB中实现串口通讯需要借助于SerialPort类，该类提供了一系列方法和属性用于串口的配置和通讯操作。

接下来，定义一个SerialPort对象和一个字节数组，用于接收和发送数据。

在窗体加载事件中初始化SerialPort对象，并设置串口的一些属性，如波特率、数据位、校验位等，根据实际需求进行配置。

还可以设置数据接收和发送的事件处理函数。

例如，下面的代码演示了如何配置串口：```vbImports System.IO.PortsPublic Class Form1Dim serialPort As New SerialPortDim receiveBuffer(255) As BytePrivate Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load'配置串口属性serialPort.PortName = "COM1"serialPort.BaudRate = 9600serialPort.DataBits = 8serialPort.Parity = Parity.NoneserialPort.StopBits = StopBits.One'数据接收事件处理函数AddHandler serialPort.DataReceived, AddressOfSerialPort_DataReceived'打开串口serialPort.OpenEnd SubPrivate Sub SerialPort_DataReceived(sender As Object, e As SerialDataReceivedEventArgs)'接收数据Dim bytesToRead As Integer = serialPort.BytesToReadDim bytesRead As Integer = serialPort.Read(receiveBuffer, 0, bytesToRead)'处理接收到的数据If bytesRead > 0 ThenDim receivedData As String =Encoding.ASCII.GetString(receiveBuffer, 0, bytesRead) '显示接收到的数据UpdateReceivedData(receivedData)End IfEnd SubPrivate Sub btnSend_Click(sender As Object, e As EventArgs) Handles btnSend.Click'发送数据Dim sendData As String = txtSendData.TextDim sendBuffer As Byte( = Encoding.ASCII.GetBytes(sendData) serialPort.Write(sendBuffer, 0, sendBuffer.Length)'清空发送框txtSendData.Text = ""End SubPrivate Sub UpdateReceivedData(data As String)'更新接收数据的显示If Me.InvokeRequired Then ' 跨线程调用控件Me.Invoke(Sub( UpdateReceivedData(data))ElselblReceivedData.Text = dataEnd IfEnd SubEnd Class```在上述代码中，我们主要关注Form1_Load事件处理函数和btnSend_Click事件处理函数。

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串口通信程序实例

VB 串口通信程序设计典型实例利用 VB 开发串口通信程序既可以使用 MSComm 控件也可以调用 Windows API 函数实现。

不过，只要 MSComm 控件可以被选用，我们推荐选择此控件实现，因为 MSComm 控件的功能和 API 调用一样强，甚至比它还好且使用起来更加简单。

在本章提供的串口通信程序设计中，除了 PC 与 PC 串口通信外，PC 与单片机、PC 与智能仪表、PC 与 PLC、PC 与 GSM 短信模块等串口通信任务的实现均采用 MSComm 控件。

6.1 PC 与 PC 串口通信程序设计当两台串口设备通信距离较近时，可以直接连接，最简单的情况，在通信中只需 3 根线（发送线、接收线、信号地线）便可实现全双工异步串行通信。

本设计通过两台 PC 串口 3 线连接，介绍了利用 API 函数和 MSComm 控件设计串口通信程序的方法，包括字符与文件的发送与接收。

6.1.1 PC 与 PC 串口通信程序设计目的（1）掌握 PC 与 PC 串口通信的线路连接方法。

（2）利用 MSComm 控件和 API 函数实现 PC 与 PC 串口通信的程序设计方法。

6.1.2 PC 与 PC 串口通信程序设计用软、硬件本设计用到的硬件和软件清单如表 6-1 所示。

表 6-1 序 1 2 3 号 PC 或 IPC 串口通信线（三线制） Visual Basic 6.0 设计用软、硬件名称数 2 1 1 量6.1.3 PC 与 PC 串口通信程序硬件线路图线路说明，在计算机通电前，按图 6-1 所示将两台 PC 通过串口线连接起来：计算机 A 串口 COM1 端口的 TXD 与计算机 B 串口 COM1 端口的 RXD 相连，计算机 A 串口 COM1 端口的 RXD 与计算机 B 串口 COM1 端口的 TXD 相连，计算机 A 串口 COM1 端口的 GND 与计算机 B 串口 COM1 端口的 GND 相连。

用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。

串口通讯及其在VB平台下的实现

串口通讯及其在VB平台下的实现摘要：本文首先介绍串行通讯的基础知识，然后结合示例剖析在VB平台下的串口通讯的编程技巧。

随着计算机系统的普及与外围设备技术的发展，计算机与外围设备之间的通讯就显得越来越重要了。

由于串行通信是在一根传输线上一位一位的传送信息，所用的传输线少，并且可以借助现成的电话网进行信息传送，因此，特别适合于远距离传输。

对于那些与计算机相距不远的人－机交换设备和串行存储的外部设备如终端、打印机、逻辑分析仪、磁盘等，采用串行方式交换数据也很普遍。

在实时控制和管理方面，采用多台微机处理机组成分级分布控制系统中，各CPU之间的通信一般都是串行方式。

所以串行接口是微机应用系统常用的接口，而相应的应用程序也成为今年来研究的热点。

本文旨在阐述一般的穿口通讯的原理及其程序设计，希望借此能够抛砖引玉，为更深入的研究打下一定的基础。

一、串行通讯的基本原理所谓"串行通信"是指外设和计算机间使用一根数据信号线,数据在一根数据信号线上按位进行传输，每一位数据都占据一个固定的时间长度。

这种通信方式使用的数据线少，在远距离通信中可以节约通信成本，当然，其传输速度比并行传输慢。

相比之下，由于高速率的要求，处于计算机内部的CPU与串口之间的通讯仍然采用并行的通讯方式，所以串行口的本质就是实现CPU与外围数据设备的数据格式转换（或者称为串并转换器），即当数据从外围设备输入计算机时，数据格式由位(bit)转化为字节数据；反之，当计算机发送下行数据到外围设备时，串口又将字节数据转化为位数据。

二、串口通讯的程序设计原理前面介绍了串行通讯的基本原理，那么如何在程序设计中实现它呢？事实上，这个过程并不复杂，一般有两种实现途径：其一就是使用MSCOMM控件，此控件提供很多方便操作的属性和方法，利用它们可以很方便地实现你的目的；另外一种途径就是使用Windows API，微软为开发者提供了很多相关的串行操作的编程接口，使用这些接口，可以很完成更为强大的功能。

VB下实现串口通信的方法

VB下实现串口通信的方法1 VB下实现串口通信的方法1.1 通信控件MSComm简介VB下的串行端口通信是通过其提供的控件Microsoft Comm control（简称MSComm）实现的。

该控件屏蔽了通信过程中的底层操作，程序员只需设置并监视MSComm控件的属性和事件，结合其它VB提供的控件就可完成对串口的初始化和数据的发送接收。

本系统中用到的主要MSComm控件属性如下：①、Commport：设置并返回通信端口代码。

默认值为1，最大值为16，需要使用超过16个通信端口时，要采用其他方式操控通信端口（如PcommPro软件）。

例如将串口2设为通信端口：mPort=2。

②、Setting：设置初始化参数。

其格式为“****，P，D，S”，其中****为波特率(baud)，P为校验方式，D为数据位数，S为停止位。

默认值为“9600，N，8，1”，意为“串口通信速度为9600Baud，无校验，每次数据为8个Bit，停止位为1个Bit”。

波特率可为110，300，600，1200，2400，9600，14400，19200，28800，38400（保留）等等。

校验位默认为None（无校验），若传输距离长，可增加校验位，可选M为符号校验，E为偶校验，O为奇校验，S为空白校验。

停止位的设定值可为：1（默认值），1.5，2。

此处的设置要和单片机侧的设置保持一致，否则不能实现正常的通信。

例如我们采用的初始化参数为“2400，N，8，1”，则单片机侧的设置相应项为：定时器1的初值为E6并且SMOD（串行口波特率加倍位）为1（对应2400Bit），串口控制寄存器SCON为40（10位异步收发，对应8Bit数据位，1Bit停止位）。

③、PortOpen：设置或返回通信端口状态。

④、Input：从缓冲区返回并删除字符。

将串行输入寄存器的数据读出，并清除寄存器中已读取的数据。

寄存器的特性是FIFO（First In First Out，先进先出）。

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'数据位改变Private Sub Combo2_Click()Call settingEnd Sub'波特率改变Private Sub Combo3_Click()Call settingEnd Sub'奇偶校验改变Private Sub Combo4_Click()Call settingEnd Sub'停止位改变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'打开关闭串口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进制Private Sub Command2_Click(Index As Integer)On Error Resume NextText4.Text = Hex(Text3.Text)If Err Then''则显示出错信息MsgBox Error$, 48, "错误信息"Exit SubEnd If'16转10进制Private Sub Command3_Click()Dim a As Longa = Val("&H"& CStr(Text4.Text))Text3.Text = aEnd Sub'手动串口发送Private Sub Command4_Click()If MSComm1.PortOpen = False ThenMsgBox"请先打开串口", , "错误信息" Exit SubEnd IfCall sentsubEnd Sub'清除接收窗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'串口接收程序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 '十六进制显示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 码显示End IfEnd Sub'手动发送选择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'自动发送选择 Private Sub Option2_Click()If Option2.value = True ThenTimer1.Enabled = TrueCommand4.Enabled = FalseElseTimer1.Enabled = FalseCommand4.Enabled = TrueEnd IfEnd SubPrivate Sub Option3_Click() 'Non选项 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选项 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选项 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'发送时间间隔调整输入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'自动发送定时器Private Sub Timer1_Timer()If MSComm1.PortOpen ThenCall sentsubEnd IfEnd Sub'状态刷新定时器Private Sub Timer2_Timer()StatusBar1.Panels(1).Text = "串口选择：" & CStr(Comb o1.Text)StatusBar1.Panels(2).Text = "串口设置：" & CStr(MSC omm1.Settings)StatusBar1.Panels(3).Text = "串口状态：" & 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'十六进制发送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"无效的数值，请重新输入", , "错误信息" 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码发送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))) '两个两个的取字符checksum = checksum + char'全部加起来NextAscLrc = checksum Mod&H100 '取255的余数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)) '两个两个的取字符 checksum = checksum + char'全部加起来NextLrc = (checksum + &H3) Mod&H100 '取255的余数 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校验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"输入错误，请重新输入", , "错误提示"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'显示出错信息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"输入错误，请重新输入", , "错误提示"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'显示出错信息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寄存器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'高位右移一位CRC16Lo = CRC16Lo \ 2'低位右移一位If((SaveHi And&H1) = &H1) Then'如果高位字节最后一位为1CRC16Lo = CRC16Lo Or&H80 '则低位字节右移后前面补1End If'否则自动补0If((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控件MSComm串口通讯实例教程

现有电子秤一台，使用串口与计算机进行通讯。

编写VB程序来访问串口，达到读取电子秤上显示的数据。

该电子秤为BE01型仪表，输出为RS-232C标准接口，波特率为300-9600、偶校验、7个数据位、2个停止位。

所有字符现有电子秤一台，使用串口与计算机进行通讯。

编写VB程序来访问串口，达到读取电子秤上显示的数据。

该电子秤为BE01型仪表，输出为RS-232C 标准接口，波特率为300-9600、偶校验、7个数据位、2个停止位。

所有字符均发送11位ASCII码，一个起始位。

在VB中与串口通讯需要引入控件MSComm串口通讯控件（在Microsoft Comm Control 6.0中）。

具体程序如下：控件简称：MSCDim Out(12) As Byte '接收var中的值Dim var As Variant '接收MSC.input中的数值Dim nRece As Integer '计算MSC.inputbuffer的个数Dim i As Integer, j As Integer '随即变量，计算循环************************************************************************** **Private Sub Form_Load()ClearTextWith MSC.CommPort = 1 '设置Com1为通信端口.Settings = "9600,E,7,2" '设置通信端口参数 9600赫兹、偶校验、7个数据位、2个停止位.（这里需要进一步说明的是：.Setting=”BBBB,P,D,S”。

含义是：B：Baud Rate（波特率）；P：Parity（奇偶）；D：Data Bit；S：Stop Bit）.InBufferSize = 40 '设置缓冲区接收数据为40字节.InputLen = 1 '设置Input一次从接收缓冲读取字节数为1.RThreshold = 1 '设置接收一个字节就产生OnComm事件End WithEnd Sub************************************************************************** **Private Sub ClearText()Text3.Text = ""Text2.Text = "5"Text1.Text = ""End SubPrivate Sub Command1_Click()ClearText' nRece = 0 '计数器清零With MSC.InputMode = comInputModeBinary '设置数据接收模式为二进制形式.InBufferCount = 0 '清除接收缓冲区If Not .PortOpen Then.PortOpen = True '打开通信端口End IfEnd WithEnd SubPrivate Sub MSC_OnComm()DelayTime ‘用来延续时间ClearTextWith MSCSelect Case .CommEvent '判断通信事件Case comEvReceive: '收到Rthreshold个字节产生的接收事件SwichVar 1If Out(1) = 2 Then '判断是否为数据的开始标志.RThreshold = 0 '关闭OnComm事件接收End IfDoDoEventsLoop Until .InBufferCount >= 3 '循环等待接收缓冲区>=3个字节' nRece = nRece + 1For i = 2 To 12SwichVar iText1.Text = Text1.Text & Chr(Out(i))NextText1.Text = LTrim(Text1.Text)Text2.Text = Text2.Text & CStr(nRece).RThreshold = 1 '打开MSComm事件接收Case Else' .PortOpen = FalseEnd SelectEnd WithEnd Sub************************************************************************** **Private Sub DelayTime()Dim bDT As BooleanDim sPrevious As Single, sLast As SinglebDT = TruesPrevious = Timer (Timer可以计算从子夜到现在所经过的秒数，在Microsoft Windows中，Timer函数可以返回一秒的小数部分)Do While bDTIf Timer - sPrevious >= 0.3 Then bDT = FalseLoopbDT = True（通信传输速率为9600bps，则最快速度1.04ms发送一个字节，仪表每秒发送50帧数据，每帧数据有4个字节，即每秒发送200个字节，平均5.0ms 发送一个字节，连续读取串口数据时要在程序中添加循环等待程序）Private Sub SwichVar(ByVal nNum As Integer)DelayTimevar = Nullvar = MSC.InputOut(nNum) = var(0)End Sub（设置接收数据模式采用二进制形式，即 InputMode=comInputModeBinary，但用Input 属性读取数据时，不能直接赋值给 Byte 类型变量，只能通过先赋值给一个 Variant 类型变量，返回一个二进制数据的数组，再转换保存到Byte类型数变量中。

执行ModBus RTU协议应答的设备与VB的连接实例

执行ModBus RTU协议应答的设备与VB的连接实例
关键词：ModBus RTU VB 通信OCX控件
ModBus RTU协议广泛应用于工业现场，监控软件除了使用商业组态软件外，使用VB是最基础且简单可行的办法，但对于不熟悉VB代码的工控界朋友也是个繁琐事，为此这里简单介绍一种可行的办法，使用ytmc.ocx控件！
l无需了解规约，不用一条条看规约，然后去编程，把这个任务交给ytmc控件。

l不用去编写繁琐的程序代码，只需填写控件属性。

l支持最大256个从机设备轮询。

关于该控件如何使用，下面我们来看个实例：
1、新建工程窗口，添加OCX组件
2、设置添加控件的属性
3、添加3局语句即可，仅此3句！
* 指定模块类型，自定义模块请参考说明书添加
ytmc1.ModuleName(address) = “M6001TRv100"
* 启动通信
call ytmc1.StartComm
* 定时刷新
call DMSS_All()
4、至此设置完毕，连接设备运行即可查看效果！
控件下载链接：/item.htm?id=19191725736 经检测有效！。

visualbasic串口通信及编程实例

visualbasic串口通信及编程实例Visual Basic串口通信及编程实例在实际的工业控制、机器人控制、智能家居等领域中，使用串口通信是一种非常广泛的方式。

Visual Basic (VB) 是一种微软公司开发的高级编程语言，它不仅易于学习，而且拥有丰富的图形界面设计和数据处理功能。

在本篇文章中，我们将深入介绍如何使用VB实现串口通信。

1. 建立串口通信首先，我们需要在VB中创建一个新的窗口(Form)，然后打开工具箱，从中拖拽出一个SerialPort(串口)控件。

在控件属性中，我们需要为其指定相关的参数，例如串口名称、波特率、数据位、停止位、校验位等。

通常情况下，这些参数需要根据硬件设备的配置来进行调整。

在VB中实现串口通信的核心部分是对于SerialPort控件的事件监控。

具体来讲，当SerialPort收到一个数据包时，它会触发一个DataReceived事件。

对于这个事件，我们可以在程序中编写回调函数进行处理。

例如：Private Sub SerialPort1_DataReceived(ByVal sender As System.Object, ByVal e AsSystem.IO.Ports.SerialDataReceivedEventArgs) HandlesSerialPort1.DataReceived'在这里实现对于数据包的解析和处理End Sub2. 数据读取和发送在SerialPort控件中，有几种方法可以实现数据的读取和发送。

下面我们将介绍其中两种方法：(1) ReadExisting这个方法可以从串口中读取所有现有的数据，例如：Dim data As String = SerialPort1.ReadExisting()(2) Write这个方法可以向串口发送数据，例如：SerialPort1.Write("Hello World")注意，这个函数只能发送字符串数据。

基于VB的MODBUS_RTU通信规约实现办法(1)

基于VB的MODBUS_RTU通信规约实现办法(1)一、MODBUS_RTU通信规约1、通信数据类型及格式标准的MODBUS协议使用串行接口，保护、测控装置（以下称从机，相应称微机为主机）上使用RS-485通信接口，主机上则需要一个RS-232转RS-485转接卡，才能和从机联接。

因此通信信息是标准的串口格式，串行数据字节格式如表1。

表1：串行数据字节格式RTU模式下每个8Bit字节包含两个4Bit的十六进制数字。

这种方式的主要优点是：在同样的波特率下，可比ASCII方式传送更多的数据。

通信数据帧格式如表2。

表2：通信数据帧格式2、地址码和功能码地址码是标识接在同一RS-485总线上不同从机的编号，只有符合地址码的从机才能响应并根据命令回送信息。

地址码是一个字节，从0到255，要求从机地址码不能重复，每个从机只有唯一的地址码。

可定义的功能码为1到127，常用的几个功能码如表3。

表3：常用功能码3、错误校验MODBUS_RTU的数据校验方式采用CRC-16（循环冗余错误校验）其步骤如下：①预置一个16位寄存器为十六进制FFFF，称此寄存器为CRC寄存器。

②把第一个8位二进制数据与CRC低8位字节进行异或运算，将结果放入CRC寄存器。

③把这个16寄存器向右移一位，用0填补最高位，检查移出位。

④若向右移出的数位是0，则返回③，若向右（标记位）移出的数位是1，则CRC寄存器与多项式1010000000000001（A001）进行异或运算。

⑤重复③和④，直至移出8位。

⑥重复②~⑤，进行下一字节处理。

⑦所有字节处理完毕，得到的16位CRC寄存器的高低字节进行交换。

⑧最后得到的CRC寄存器内容即CRC码。

二、VB中串行通信组件设置使用“Microsoft Comm Control 6.0”即MSComm控件，参数设置如图1。

图1：MSComm控件参数设置端口主要参数有端口代号，即串口号，常见的有微机标准配置1和2，其他的号则是由PCI或USB接口转换来的。

用VB实现Modbus RTU串行通讯工程实例

用VB实现Modbus RTU串行通讯工程实例声明：网上看到的，觉得不错，稍微整理了一下分享给大家。

用VB实现Modbus RTU串行通讯在一些应用中可能需要使用诸如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) = HiByte WriteStr(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。