VB控件Mscomm控件与PLC进行RS485(Modbus)通讯源码

VB与PLC通信程序（欧姆龙PLC）关于VB的MSCOMM控件可参考相关资料。

通信程序摘要如下：（1）初始化程序mport=2 ’选择COM2Mscomm1.Settings=”9600,N,8,2”’设置通信参数Mscomm1.Inputlen=0 ’读入接收缓冲区全部字符Mscomm1.OutbufferSize=256 ’设置发送缓冲区大小Mscomm1.InbufferSize=512 ’设置接收缓冲区大小Mscomm1.PortOpen=True ’打开COM2（2）发送命令程序比如读取节点号03的PLC中IR000到IR009的内容，并放到tag1字符串变量中，此时有：Dim Command, node, begin, number as stringDim Answerlen as integernode=”03”’节点号Command=”RR”’命令为读IR区begin=”0000”’从IR000开始number=10 ’读取长度Answerlen=51 ’计算接收字符串长度进行命令发送和接收应答处理：Dim FCS, I as integerDim s ,f as strings=”@”+node+Commad+begin+numberFCS=0For i=1 to Len(s)FCS=FCS xor Asc(Mid$(s,i,1) ) ’帧校验码FCSNext if=Hex$(FCS)If Len(f)=1 Then f=”0”+fCommfrm.MSComm1.Output=s + f + ”*” + CHR$(13) ’命令帧发送DoDummy=DoEvents()Loop Untill Commfrm.MSComm1.InbufferCount >= Answerlen ’等待应答帧Do tag1= Commfrm.MSComm1.InputLoop Untill Commfrm.MSComm1.InbufferCount=0 ’读完应答帧上述程序具有相当的通用性，对于其它设备不同的只是各自的数据帧格式，因而只需做相应少量修改即可。

VB6.0下用MSComm控件实现串口通信MSComm控件通过串行端口传输和接收数据，为应用程序提供串行通讯功能，以下先对其属性进行详细的说明后再举一个例子进行说明：1基本属性CommPortO mPort[=value]Object为MSComm控件，value为整数值，标志端口号。

说明：该属性设置并返回通讯端口号，value的值可以设为1-16间的任意数(默认为1)。

在打开端口之前必须先设置CommPort属性，当端口不存在时，如果用PortOpen属性打开它，MSComm控件会产生错误68(即设备无效的错误)。

SettingsObjiect.Setting[=value]Object为MSComm控件，value为字符串类型，表示通讯端口的设置值。

说明：本属性用来设置并返回端口的波特率、奇偶校验位、数据位和停止位参数。

当端口打开时，如果指定的value参数非法，则MSComm控件产生380号(非法属性值)错误。

有效的value参数值由四个设置值组成，有如下格式：“BBBB,P,D,S”，其中BBBB为波特率，P为奇偶校验，D为数据位数，S为停止位数。

Value的默认值为：“9600,N,8,1”，下面给出合法的波特率、奇偶校验位、数据位和停止位参数：波特率：110，300，600，1200，2400，4800，9600(默认)，14400，19200，28800，38400，56000，57600，115200，128000，256000。

奇偶校验值：E(偶校验，Even)、M(标记，Mark)、N(默认，Default，None)、O(奇校验，Odd)、S(空格，Space)。

数据位值：4，5，6，7，8(默认)，9。

停止位值：1(默认)，1.5，2。

PortOpenO bject.PortOpen[=value]Object为MSComm控件。

Value为布尔类型，表明通讯端口的状态。

Private Sub MSComm1_OnComm()Select Case mEventCase comEvReceive'此处添加处理接收的代码End SelectEnd Sub'发送主代码frmMain.MSComm1.Output = bytSendByte在使用MSComm控件时需注意接收是以ASCII码或二进制码详细可参阅“人名邮电出版社”的“VISUAL BASIC 串口通讯实例导航”一书。

按你提供的C2C7FAE1看为16进制数,其10进制值为-1027081503,如何处理成-99.99要看下位机是如何约定数据的来定.Text1 = &HC2C7FAE1 或Text1 = VAL(&HC2C7FAE1)一般上下位机对数字值传递通常以16位二进制数字传递,而小数点不传递,仅乘一定倍率来实现.同时16位二进制数字按两个8位(ASCII码值)输送,上位机通过程序代码处理成10进制数.串口传送数据实质是传送ASCII码，如是8位二进制数据，其ASCII码值（10进制）为0-255。

用二进制表示为00000000 - 1111111116进制表示为00 - FF传送数据大于255，则用16位二进制（即2字节ASCII码组成）。

10进制范围-32768到+32767。

如有小数，则应由上下位机约定，不进行发送。

串口通信中数制转换必须相当重视。

以上是以二进制方式收发数据。

也可直接以ASCII码的文本方式发送数据，而字节量大。

如何实现串口数据采集，如何分析这些数据？MSCOMM控件在VB6的企业版中有，需通过部件添加方式加载。

Private Sub MSComm_OnComm()Dim bytInput() As ByteDim intInputLen As IntegerSelect Case mEventCase comEvReceiveIf blnReceiveFlag ThenIf Not frmMain.ctrMSComm.PortOpen ThenmPort = intPortfrmMain.ctrMSComm.Settings = strSetfrmMain.ctrMSComm.PortOpen = TrueEnd If'此处添加处理接收的代码frmMain.ctrMSComm.InputMode = comInputModeText '按ASCII 接收intInputLen = frmMain.ctrMSComm.InBufferCountReDim bytInput(intInputLen)bytInput = frmMain.ctrMSComm.InputText1 = bytInputText2 = Text1jscd = Len(Text1)If Left(Text1, 1) <> Chr(27) Or jscd > 25 Then 'bel3.BackColor = vbRedbel3.ForeColor = vbWhitebel3.Caption = "接收信号出错!"ElseIf Left(Text2, 1) = Chr(27) And Mid(Text2, 25, 1) = Chr(13) Thenbel3.BackColor = vbGreenbel3.ForeColor = vbBlackbel3.Caption = "接收信号正常!"If Left(Text2, 6) = Chr(27) & "R0032" And jscd = 25 ThenIf Val(fa2) >= 0 And Len(fa2) = 4 Thenfa2 = "0" & Mid(fa2, 2, 3)End IffrmMain.txtSend = Chr(27) & fa0 & fa1 & "9999" & zhenkong & fa2 & fa3 & fa4 & Chr(13)lenTxtSend = Len(txtSend)bel8.Caption = txtSendbel11.Caption = lenTxtSendIf lenTxtSend = 24 ThenCall commFasongElsebel3.BackColor = vbRedbel3.ForeColor = vbWhitebel3.Caption = "发送信号出错!"End IfblL1 = Mid$(Text2, 19, 2)If blL1 = "01" Thenrecord_jmm(0) = Val(Mid$(Text2, 21, 4)) / 10 '制品1温度ElseIf blL1 = "02" Thenrecord_jmm(1) = Val(Mid$(Text2, 21, 4)) / 10 '制品2温度ElseIf blL1 = "03" Thenrecord_jmm(2) = Val(Mid$(Text2, 21, 4)) / 10 '制品3温度ElseIf blL1 = "04" Thenrecord_jmm(3) = Val(Mid$(Text2, 21, 4)) / 10 '制品4温度ElseIf blL1 = "05" Thenrecord_jmm(4) = Val(Mid$(Text2, 21, 4)) / 10 '制品5温度ElseIf blL1 = "06" Thenrecord_jmm(5) = Val(Mid$(Text2, 21, 4)) / 10 '制品6温度End Ifrecord_jm(0) = Val(record_jmm(0))record_jm(1) = Val(record_jmm(1))record_jm(2) = Val(record_jmm(2))record_jm(3) = Val(record_jmm(3))record_jm(4) = Val(record_jmm(4))record_jm(5) = Val(record_jmm(5))blL = Mid$(Text2, 7, 6)Call Hex_bin '输出口状态鉴别blLg = Mid$(Text2, 13, 6)Call hex_bin1 '输出口故障状态鉴别txtSend = ""ElsetxtSend = ""End IfEnd IfIf Not blnAutoSendFlag And Not blnReceiveFlag ThenfrmMain.ctrMSComm.PortOpen = FalseEnd IfEnd IfEnd SelectEnd Sub以上是一段MSCOMM的ONCOMM事件代码,接收的数据按上下位机约定取出赋值于全局变量,在其它窗体进行数据记录(写入数据库).至于数据分析确如一楼说的可以海阔天空,通过数据控件及SQL语句来完成任务.以下提供MSDN参考：OnComm 常数常数值描述comEvSend 1 发送事件。

的文件材料的收集、整理、移交工作；二要对施工单位文件材料的形成情况进行质量检查把关，按照监理规程要求，在控制节点进行审核、签署，发现问题及时提出整改。

建设单位：全面负责立项文件、建设用地征地拆迁文件、勘察、测绘、设计文件，工程招投标文件、开工审批文件、财务文件的形成和归档。

为确保项目竣工验收，建议前期组织人员调研项目档案验收程序，明确重点验收范围，编制档案验收文件汇总目录，分项落实到部门和相关人员，负责完整、准确形成档案资料和及时归档。

5结论是否可以与越来越复杂的建井条件挂钩：在复杂条件下，为便于开展工程评价，并为后继工程提供借鉴，对档案管理的要求在提高，原有的档案管理模式不能满足这一要求，在项目档案管理出现管理难度大，形成难，归档难，案卷整理组巻难的问题。

因此，建议在在矿井工程建设各方中增设档案管理人员，分施工单位、监理单位、建设单位三个层面进行控制归档。

个人简介孙洪章（1963～），男，高级工程师，1986年毕业于阜新矿业学院，现在兖煤菏泽能化有限公司从事矿建工作。

（收稿日期：2008-9-19）用VB编写RS-485数据采集程序昆明理工大学国土资源工程学院张明旭黄德镛现场总线和智能仪表的出现标志着工业控制领域进入了网络时代，迅速成为了工业控制的主流。

目前国际上正在使用的现场总线名目繁多，如PROFIBUS、INTERBUS、CAN总线，但是其系统造价相对较高，不太适用于中小型系统的应用。

而RS485串行通信总线以构造简单、技术成熟、造价低廉、便于维护等特点广泛应用于工业控制、仪器、仪表、机电一体化产品等诸多领域。

尤其在数据通信、计算机网络以及工业分布式控制系统中，经常需要采用串行通信来实现远程信息交换。

但是为了对控制串行网络远程采集数据，依然需要为串行通讯网络和智能仪表编写数据采集程序。

本文就简单介绍一个适应RS-485串行网络的数据采集程序。

1RS-485简述电子工业协会EIA于1983年制订并发布RS-485标准，并经TIA-通讯工业协会修订后命名为TIA/EIA-485-A，习惯地称之为RS-485。

vb中怎样用mscomm控件实现串口通信本问分两部分均来自第一部分jessezappy（晶晶)================================================================================== If MSComm1.PortOpen Then MSComm1.PortOpen = FalsemPort = 1 '假定是用COM1口' 设定传输速率等，可依照您的需求更改MSComm1.Settings = "9600,N,8,1"MSComm1.PortOpen = True'---------初始化Modem-------------MSComm1.Output = "ATZ"MSComm1.Output = "AT&F"MSComm1.Output = "ATE0"MSComm1.Output = "ATM1"MSComm1.Output = "ATQ0"MSComm1.Output = "ATV0"'--------------------------拨号-------------MSComm1.Output ="ATDT163" '拨163'---------------------------接通后MSComm1.Output ="SDFJDKSJLKFA" '发送字符串'---------------------Private Sub MSComm1_OnComm() '用串口事件捕捉数据..If MSComm1.InBufferCount Then' 通讯埠中假如有资料的话, 则读取进来InStringB = InStringB & MSComm1.Input' 如果资料中有Chr(13) 和Chr(10) 的话, 则显示出来If InStr(InStringB, vbCrLf) Theninstring = instring & InStringBAddText Text3, InStringB, FalseInStringB = ""End IfEnd IfEND SUB'-------------------------挂断--------MSComm1.PortOpen = False '这个挂断方法不能适用所有MODEM,我正在研究...通用办法================================================================================================第二部分:===========================================================================最后借你一篇文章看,作者不是我,里面的不一定都对..'-----------------------------------------------------------VB Mscomm控件应用江苏戚墅堰机车车辆厂设计处(213011) 李秉璋--------------------------------------------------------------------------------Visual Basic 6.0(以下简称VB) 是一种功能强大、简单易学的程序设计语言。

搞技术，搞不定，很闹心！别人的奉献可以使你明朗，心情愉悦！奉献是快乐的！不要吝啬你千辛万苦摸索出来的技术！与三菱PLC的串行通讯要点PLC测的设置页面（在PLC左侧工程树下点击参数设置，然后写到PLC里）485硬件连接：rs232转485端的A接PLC的485BD上的RDA和SDA（如下图的红线），B接485BD上的RDB和SDB（如下图的白线）。

如果以设置了还不正确，要看看电脑端的串口接好没有，连线有没有短线等。

窗体源码：Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.LoadmPort = 1MSComm1.Settings = "9600,E,7,1"MSComm1.Handshaking = None MSComm1.InputLen = 0MSComm1.InBufferCount = 0MSComm1.OutBufferCount = 0MSComm1.PortOpen = TrueEnd Sub按钮及文本显示源码：Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.ClickMSComm1.InBufferCount = 0MSComm1.OutBufferCount = 0MSComm1.InputLen = 0Dim fanhui As StringDim zhuangtai As Stringzhuangtai = Chr("5") + "05FFBRAX00010140"MSComm1.Output = zhuangtaiDoApplication.DoEvents()Loop Until MSComm1.InBufferCount = 9fanhui = MSComm1.InputText1.Text = "x001状态" + "------" + "数据为：" + fanhui End Sub注意：VB6.0用chr（5）表示，但是要用chr（"5"）表示，否则出错。

应用MSComm控件实现计算机与PLC间的串行通讯摘要本文应用S7-200系列PLC的RS-485接口，通过PC/PPI电缆与计算机的RS-232接口连接，软件方面应用Visual Basic提供的串行通讯控件（MSComm）实现PC机对可编程序控制器的监控与管理。

本文主旨在于探讨应用可视化编程语言实现PC机与PLC网络之间数据通讯的技术以及实现方案，利用PC机的管理与监控功能实现对PLC的自动化控制。

关键词可编程序控制器；串行通讯；中断0 引言可编程序控制器（PLC）专门用于工业控制，它的核心是以微处理器的结构为基础，在硬件结构上和普通的计算机基本一致。

它在基本的计算机结构当中，加入了传统的继电器控制系统，使其具有了高度的可靠性，更好的适应工业现场的环境，而且具备了强大的联网处理功能，广泛地应用在工业控制生产过程中。

微软的Visual Basic提供了MSComm控件，通过硬件的串行端口传送和接收数据，实现了PC机与PLC之间的通信，为可视化程序对PLC的控制提供了可能。

本文基于西门子公司生产的S7-200型PLC，应用MSComm控件，编写了计算机与PLC通讯程序，包括了上位机和下位机相应的程序代码。

提出了应用编程语言实现PC/PLC网络之间数据通信的软件解决方案，实现了用PC机对PLC 的监控及控制。

1 PLC与计算机间的通讯S7-200型PLC可以连接编程器、人机接口设备，甚至连接其他的PLC或PC机，组成PLC网络，可以实现PC与PLC、PLC与PLC的各种通信功能。

同时可以应用PC的管理功能实现对PLC的编程、监控和联网的功能。

S7-200系列PLC具有9针的RS-485接口，可以通过PC/PPI电缆与计算机连接，PLC之间可以通过SINEC-L2接口连接成PLC网络。

S7-200系列PLC主要有两种通信模式：一种为点对点（PPI）通信协议模式，用在PLC与编程器或人机接口产品之间通讯；另一种是自由口通讯模式，此模式对用户完全开放，用户可以自行设定通讯协议，使用程序控制串行通讯接口。

VB实现PC与欧姆龙PLC通讯的串口编程第一篇：VB实现PC与欧姆龙PLC通讯的串口编程Private Sub Form_Load()Dim i As Integer'OPEN COM1If ComTrue(1)= 0 ThenIf ComOpen(1, 38400, 7, 1, 1, “sjh”)= 1 Then 'MsgBox(“已注册”)'sjh为你的注册账号Call SetDelayNum(64)End IfEnd Ifjisujisu1jisu2End Sub第二篇：VB中串口通讯的实现VB中串口通讯的实现.txt VB中串口通讯的实现------------------一、概述串口通讯作为一种古老而又灵活的通讯方式，被广泛地应用于PC 间的通讯以及PC和单片机之间的通讯之中。

提到串口通讯的编程，人们往往立刻想到C、汇编等对系统底层操作支持较好的编程语言以及大串繁琐的代码。

实际上，只要我们借助相关ActiveX控件的帮助，即使是在底层操作一向不被人看好的VB中，一样能够实现串口通讯，甚至其实现方法和C、汇编相比，要更加快捷方便。

下面，笔者就介绍一下在VB 中实现串口通讯的方法。

在Visual Basic中有一个名为Microsoft Communication Control（简称MSComm）的通讯控件。

我们只要通过对此控件的属性和事件进行相应编程操作，就可以轻松地实现串口通讯。

下面，笔者就简要地介绍一下MSComm控件的使用方法。

二、MSComm控件的主要属性、事件1、MSComm的属性由于MSComm控件属性很多，在此笔者仅介绍与实现串口通讯密切相关的核心属性。

Commport：设置通讯所占用的串口号。

如设成1（默认值），表示对Com1进行操作。

Setting：对串口通讯的相关参数。

包括串口通讯的比特率，奇偶校验，数据位长度、停止位等。

其默认值是“9600,N,8,1”，表示串口比特率是9600bit/s，不作奇偶校验，8位数据位，1个停止位。

该程序可以实现实时数据采集显示，以及能对寄存器进行设置。

程序很简单，想用的可以完善，现在只能实时采集显示一个地址的数据，只要修改一下，就可以实时采集多个地址的数据。

现在也只能一次对一个寄存器进行设置，也可以更加完善。

下面是运行界面，采集的模块的地址为75，是一个温湿度采集模块。

有3个寄存器，显示的数据上是温度，湿度，露点温度。

modbusPrivate Sub Command1_Click() '设置按钮Dim bisend() As ByteDim crcDim btLoCRC As Byte, btHiCRC As ByteDim Data As IntegerIf MSComm1.PortOpen = True ThenIf Combo5.ListIndex = 0 ThenReDim bisend(7) '重新定义数组长度bisend(0) = "&h" + Hex(V al(Text1.Text)) '地址码bisend(1) = "&h" + Hex(3) '功能码读寄存器bisend(2) = "&h" + Hex(0) '起始地址高位bisend(3) = "&h" + Hex(0) '起始地址低位bisend(4) = "&h" + Hex(0) '寄存器个数高位bisend(5) = "&h" + Hex(Combo6.ListIndex + 1) '寄存器个数低位crc = CRC16(bisend, 6, btLoCRC, btHiCRC)bisend(6) = "&h" + Hex(btLoCRC) 'CRC高位bisend(7) = "&h" + Hex(btHiCRC) 'CRC低位'发送数据MSComm1.Output = bisendElseReDim bisend(10) '一次只能写一个寄存器bisend(0) = "&h" + Hex(V al(Text1.Text)) '地址码bisend(1) = "&h" + Hex(16) '功能码写寄存器bisend(2) = "&h" + Hex(0) '起始地址高位bisend(3) = "&h" + Hex(0) '起始地址低位bisend(4) = "&h" + Hex(0) '寄存器个数高位bisend(5) = "&h" + Hex(1) '寄存器个数低位bisend(6) = "&h" + Hex(2) '字节数Data = Val(Trim(Text3.Text))bisend(7) = "&h" + Hex(Data \ 256) '要写入寄存器的值的高字节bisend(8) = "&h" + Hex(Data Mod 256) '要写入寄存器的值的低字节crc = CRC16(bisend, 9, btLoCRC, btHiCRC)bisend(9) = "&h" + Hex(btLoCRC) 'CRC高位bisend(10) = "&h" + Hex(btHiCRC) 'CRC低位MSComm1.Output = bisendEnd IfElseMsgBox "串口没有打开"End IfEnd SubPrivate Sub Command2_Click() '实时采集按钮Timer1.Enabled = Not Timer1.Enabled '进行状态切换End SubPrivate Sub Command3_Click()'初始化，并打开串口With MSComm1If .PortOpen = False Then.CommPort = Combo7.ListIndex + 1 '打开串口1.Settings = Combo1.Text + "," + Combo2.Text + "," + Combo3.Text + Combo4.Text.InputMode = 1.InputLen = 50 '一次性从接收缓冲区中读取所有数据(8个字节为一组！！).InBufferCount = 0 '清空接收缓冲区.OutBufferCount = 0 '清空发送缓冲区.RThreshold = 5 + (Combo6.ListIndex + 1) * 2.InBufferSize = 1024.OutBufferSize = 1024.PortOpen = TrueElseMsgBox "串口已经打开"End IfEnd WithEnd SubPrivate Sub Command4_Click() '关闭串口按钮If MSComm1.PortOpen = True ThenMSComm1.PortOpen = FalseEnd IfEnd SubPrivate Sub Form_Load()Dim i As Integer'波特率设置Combo1.AddItem "4800", 0 Combo1.AddItem "9600", 1 Combo1.AddItem "115200", 2'校验位设置Combo2.AddItem "N", 0Combo2.AddItem "E", 1Combo2.AddItem "O", 2'数据位设置Combo3.AddItem "7", 0Combo3.AddItem "8", 1'停止位设置Combo4.AddItem "1", 0Combo4.AddItem "2", 1'功能码选择Combo5.AddItem "读寄存器03", 0 Combo5.AddItem "写寄存器16", 1'寄存器个数设置Combo6.AddItem "1", 0Combo6.AddItem "2", 1Combo6.AddItem "3", 2Combo6.AddItem "4", 3Combo6.AddItem "5", 4 Combo6.AddItem "6", 5Combo6.AddItem "7", 6Combo6.AddItem "8", 7Combo6.AddItem "9", 8Combo6.AddItem "10", 9 Combo6.AddItem "11", 10 Combo6.AddItem "12", 11 Combo6.AddItem "13", 12 Combo6.AddItem "14", 13Combo6.AddItem "15", 14Combo6.AddItem "16", 15Combo6.AddItem "17", 16Combo6.AddItem "18", 17Combo6.AddItem "19", 18Combo6.AddItem "20", 19Combo6.AddItem "21", 20Combo6.AddItem "22", 21'串口选择Combo7.AddItem "串口1", 0Combo7.AddItem "串口2", 1Combo7.AddItem "串口3", 2Combo7.AddItem "串口4", 3'初始赋值Combo1.ListIndex = 1Combo2.ListIndex = 1Combo3.ListIndex = 1Combo4.ListIndex = 0Combo5.ListIndex = 0Combo6.ListIndex = 2Combo7.ListIndex = 0'初始化串口End SubPrivate Sub Form_Unload(Cancel As Integer)If MSComm1.PortOpen = True ThenMSComm1.PortOpen = FalseEnd IfEnd SubPrivate Sub MSComm1_OnComm()Dim INByte() As ByteDim Buf As StringDim btLoCRC As Byte, btHiCRC As ByteDim Data As IntegerIf mEvent = comEvReceive Then '接收到数据以后INByte = MSComm1.InputIf INByte(1) = 3 Then '读寄存器'CRC校验crc = CRC16(INByte, UBound(INByte) - LBound(INByte) - 1, btLoCRC, btHiCRC)If INByte(UBound(INByte) - 1) = btLoCRC And INByte(UBound(INByte)) = btHiCRC Then'校验正确'////////////////////////////////////For i = 3 To UBound(INByte) - 2 Step 2Data = "&h" + Hex(INByte(i)) + Hex(INByte(i + 1))' Buf = Buf + Hex(INByte(i)) + Chr(32)Buf = Buf + Str(Data) '转换为十进制显示Next iList1.AddItem BufEnd IfEnd IfMSComm1.InBufferCount = 0 '请缓存End IfEnd SubPrivate Sub Timer1_Timer()'定时发送命令Dim tbisend(7) As ByteDim crc '定时1sDim btLoCRC As Byte, btHiCRC As ByteDim Buf As StringIf MSComm1.PortOpen = True Thentbisend(0) = "&h" + Hex(Val(Text1.Text)) '地址码tbisend(1) = "&h" + Hex(3) '功能码读寄存器tbisend(2) = "&h" + Hex(0) '起始地址高位tbisend(3) = "&h" + Hex(0) '起始地址低位tbisend(4) = "&h" + Hex(0) '寄存器个数高位tbisend(5) = "&h" + Hex(Combo6.ListIndex + 1) '寄存器个数低位crc = CRC16(tbisend, 6, btLoCRC, btHiCRC)tbisend(6) = "&h" + Hex(btLoCRC) 'CRC高位tbisend(7) = "&h" + Hex(btHiCRC) 'CRC低位'发送数据MSComm1.Output = tbisendEnd IfEnd Sub////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ///////////////Function CRC16(Data() As Byte, no As Integer, CRC16Lo As Byte, CRC16Hi As Byte) As String Dim CL As Byte, CH As Byte '多项式码&HA001Dim SaveHi As Byte, SaveLo As ByteDim i As IntegerDim Flag As IntegerCRC16Lo = &HFFCRC16Hi = &HFFCL = &H1CH = &HA0For i = 0 To no - 1CRC16Lo = 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 '则低位字节右移后前面补1End If '否则自动补0If ((SaveLo And &H1) = &H1) Then '如果LSB为1，则与多项式码进行异或CRC16Hi = CRC16Hi Xor CHCRC16Lo = CRC16Lo Xor CLEnd IfNext FlagNext iDim ReturnData(1) As ByteReturnData(0) = CRC16Hi 'CRC高位ReturnData(1) = CRC16Lo 'CRC低位CRC16 = ReturnDataEnd Function'CRC低位字节值表Function GetCRCLo(ind As Long) As ByteGetCRCLo = Choose(ind + 1, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, _&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, &HC1, &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, &H81, &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, &O33, &;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 Function。

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

最近，本人为了实现电脑与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。

通过MSComm控件进行WINCC串口通讯总结- 西门子plc目的：通过MSComm控件实现WINCC串口通讯（C脚本和VB脚本两种方式）测试环境：操作系统 win7WINCC版本：V7.2帮助工具：串口调试工具ASPD虚拟串口工具测试WINCC组态画面：测试试验过程画面：1、通过VB实现串口通讯画面对象“打开画面”VB大事脚本：Sub OnOpen()Dim objMSComm, tagConnectionSet objMSComm = hmiRuntime.Screens("串口通讯VB版").ScreenItems("COM")Set tagConnection = HMIRuntime.Tags("tagConnection1")If objMSComm.PortOpen = False Then' Assign com port numbermport = 4' Values: 9600 Baud, N - No Parity, 8 - Databit, 1 - StopbitobjMSComm.RThreshold = 1objMSComm.SThreshold = 0objMSComm.InBufferCount = 0objMSComm.InputLen = 0objMSComm.PortOpen = TruetagConnection.Write (True)HMIRuntime.Trace("Port open." vbCrLf)ElseHMIRuntime.Trace("Port is already opened." vbCrLf)End IfEnd SubMSComm控件OnComm对象大事：Sub OnOpen()Dim objMSComm, tagConnectionSet objMSComm = HMIRuntime.Screens("串口通讯VB版").ScreenItems("COM")Set tagConnection = HMIRuntime.Tags("tagConnection1")If objMSComm.PortOpen = False Then' Assign com port numbermport = 4' Values: 9600 Baud, N - No Parity, 8 - Databit, 1 - StopbitobjMSComm.RThreshold = 1objMSComm.SThreshold = 0objMSComm.InBufferCount = 0objMSComm.InputLen = 0objMSComm.PortOpen = TruetagConnection.Write (True)HMIRuntime.Trace("Port open." vbCrLf)ElseHMIRuntime.Trace("Port is already opened." vbCrLf)End IfEnd Sub“SEND按钮”鼠标左键按下大事：Sub OnLButtonDown(ByVal Item, ByVal Flags, ByVal x, ByVal y) Dim objMSCommDim strTemp,bufferHMIRuntime.Trace("Communication!" vbCrLf)Set objMsComm = HMIRuntime.Screens("串口通讯VB版").ScreenItems("COM")Set buffer = HMIRuntime.Tags("Buffer1")strTemp = buffer.ReadIf objMSComm.PortOpen = True ThenIf strTemp"" thenobjMSComm.Output=strTempEnd IfEnd IfEnd Sub2、通过C脚本实现串口通讯画面对象“打开画面”C大事脚本：#include "apdefap.h"void OnOpenPicture(char* lpszPictureName, char* lpszObjectName, char* lpszPropertyName){#define GetObject GetObject__object *pdl=NULL;__object *pic=NULL;__object *obj=NULL;int i,j;pdl = __object_create("PDLRuntime");if(pdl){printf("portopen get pdl ok ");}pic=pdl-GetPicture("串口通讯C版");if(pic){printf("portopen get pic ok "); }obj=pic-GetObject("COM");if(obj){printf("portopen get obj ok "); }if(obj-PortOpen==0){obj-Commport = 3;obj-Settings = "9600,N,8,1";obj-RThreshold = 1;obj-SThreshold = 0;obj-InBufferCount = 0;obj-InputLen = 0;obj-PortOpen = 1;}__object_delete(obj);__object_delete(pic);__object_delete(pdl);}MSComm控件OnComm对象大事：#include "apdefap.h"void OnComm(char* lpszPictureName, char* lpszObjectName ) {#define GetObject GetObject__object *pdl=NULL;__object *pic=NULL;__object *obj=NULL;char *data="";pdl = __object_create("PDLRuntime");if(pdl){printf("portopen get pdl ok ");}pic=pdl-GetPicture("串口通讯C版");if(pic){printf("portopen get pic ok ");}obj=pic-GetObject("COM");if(obj){printf("portopen get obj ok ");}SetTagChar("BufferTemp",obj-Input);printf("BufferTemp:%s ",GetTagChar("BufferTemp"));if(strcmp(GetTagChar("BufferTemp"),"")){SetTagChar("Buffer1",GetTagChar("BufferTemp"));}__object_delete(obj);__object_delete(pic);__object_delete(pdl);}“SEND按钮”鼠标左键按下大事：#include "apdefap.h"void OnLButtonDown(char* lpszPictureName, char* lpszObjectName, char* lpszPropertyName, UINT nFlags, int x, int y)#define GetObject GetObject__object *pdl=NULL;__object *pic=NULL;__object *obj=NULL;char *data="";pdl = __object_create("PDLRuntime"); if(pdl){printf("portopen get pdl ok ");}pic=pdl-GetPicture("串口通讯C版"); if(pic){printf("portopen get pic ok ");}obj=pic-GetObject("COM");if(obj){printf("portopen get obj ok ");}if(strcmp(GetTagChar("Buffer1"),""))obj-Output=GetTagChar("Buffer1"); }__object_delete(obj);__object_delete(pic);__object_delete(pdl);}MSComm控件.rar。

基于VB的上位机与PLC的串行通信收藏此信息打印该信息添加：佚名来源：未知1 引言在现代控制系统中，pc机作为上位机负责系统管理、状态监控、信息处理和打印报表等工作，plc作为下位机进行面向现场的实时控制已成为一种典型的系统结构。

因此，pc机与plc之间的通信问题便成了系统能否实现的关键。

串行通信以其接线简单、容易实现的特点得到了广泛的应用。

visual basic编程软件简单易学、功能强大，利用它可以很方便的实现pc机与plc间的串行通讯。

本文以omron公司的cpm2a plc为例，介绍了利用vb6.0实现pc机与plc串行通讯的具体方法。

omron公司的cpm2a plc支持host-link通信协议，可以与上位计算机进行通信。

使用host-link通信协议构成的通信网络，可以很方便的实现上位pc对下位plc的实时监控。

2 原理设计2.1 系统结构系统结构如图1所示，计算机作为上位机，plc作为下位机，因omron cpm2a本身带有rs-232串口，因此，利用rs-232电缆将其与pc机的串口(com1或com2)相连，便构成了一个1：1的简单的通讯系统[1]。

图1 系统结构2.2 host-link通信协议[2]omron公司的host-link通信系统是由上位计算机(ibm pc或兼容机)通过安装在各台p lc上的host-link单元连接多台plc构成的网络。

上位机对系统中的plc进行集中管理与监控，通过与host link单元的通信，可以编辑或修改各台plc的程序，实时监控其运行过程，实现自动化系统的集散控制。

对于小型plc，也可以通过其rs 232c通信端口进行链接。

系统使用host-link通信协议进行通信，上位机具有传送优先权，总是首先发出命令并启动通信，host link单元收到命令交由plc执行，然后将执行结果返回上位机，二者以通信帧为单位，轮流交换数据。

通信时一组传送的数据称为“块”，它是命令或响应的单位，从上位机发送到host -link单元的数据块称为命令块，反过来，从host- link单元发送到上位机的数据块称为响应块。

用Visual Basic编写的Modbus 通信源程序以下是PC机与PLC进行Modbus通信的VB源程序，提供给大家做个参考。

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_Version = 393216DTREnable = -1 'TrueEndEnd①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 = CVar(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 = CVar(btSend)'注意下面编写的接收过程很简单，要编写实际应用的监控程序来说需要更完善Dim btReceive As VariantWith ComK3DoDoEventsLoop Until .InBufferCount = 6.InputLen = 6btReceive = .InputIf btReceive(1) = &H2 Then '若正确，返回帧的第2个字节为功能码.实际上，此处应首先进行CRC校验txtReceive.Text = Hex$(btReceive(3))End IfEnd WithEnd Sub。