用VB 写的上位机modbus rtu模式通讯源码，已在台达PLC上调试通过-专业自动化论坛-中国工控网论坛

用VB 写的上位机modbus rtu模式通讯源码，已在台达PLC上调试通过点击：7697 | 回复：28

happinessman88

精华：0帖
求助：0帖
帖子：36帖 | 122回
年度积分：0
历史总积分：789
注册：2010年5月02日

发表于：2012-07-22 19:19:27

楼主

‘用VB 写的 modbus rtu模式通讯源码，已在台达PLC上调试通过

Private Sub CmdOpen_Click()
On Error Resume Next

If (MSComm1.PortOpen) Then ‘打开/关闭串口
MSComm1.PortOpen = False
Else
MSComm1.PortOpen = True
End If

If (MSComm1.PortOpen) Then
CmdOpen.Caption = "关闭串口"
Shape5.FillStyle = vbFSSolid
Else
CmdOpen.Caption = "打开串口"
Shape5.FillStyle = vbFSTransparent
End If

If Err Then
MsgBox Error$, 48, "错误码信息"
Exit Sub
End If
End Sub

Private Sub Combo1_Click()
MSComm1.CommPort = Combo1.ListIndex + 1
End Sub

Private Sub Combo2_Click()
Call Setting
End Sub

Private Sub Combo3_Click()
Call Setting
End Sub

Private Sub Combo4_Click()
Call Setting
End Sub

Private Sub Combo5_Click()
Call Setting
End Sub

Private Sub Command1_Click()
‘Shape1.FillStyle = vbFSSolid
Dim Y0_status As Byte
Dim Sendstr As String
Dim i As Integer, j As Integer
Sendstr = "01 01 05 00 00 10 "
HexSend (Sendstr)

Sleep (30)

HexSend (Sendstr)
End Sub

Private Function HexSend(Sendstr As String) As Integer

Dim outbuf() As Byte
Dim Temp(0) As Byte
Dim crc As String, Sendstrls As String
Dim sendlen As Integer
Dim i As Integer, j As Integer

If Sendstr = "" Then
MsgBox "发送数据不能为空！"
HexSend = 0
Exit Function
End If

Sendstrls = Trim(Sendstr) ‘去掉空格
sendlen = Len(Sendstrls) + 1 ‘取长度
j = 0
ReDim outbuf(1 To sendlen \ 3) As Byte
For i = 1 To sendlen Step 3
j = j + 1
outbuf(j) = Val("&H" & CStr(Mid(Sendstrls, i, 2)))
Next i

crc = Crc16(outbuf)
ReDim Preserve outbuf(1 To (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 = Temp
Next i
For i = 1 To 2000
Next i
HexSend = 1
End Function

Private Function Setting()
MSComm1.Settings = CStr(Combo2.Text) & "," & CStr(Combo3.Text) & "," & CStr(Combo4.Text) & "," & CStr(Combo5.Text)
End Function

Private Sub Command2_Click()
‘If (MSComm1.RThreshold = 0) Then
‘MSComm1.RThreshold = 1

‘Else
‘MSComm1.RThreshold = 0
‘End If
Label11.Caption = "接收个数:" & CStr(ReceCount) & " " & "接收帧数：" & CStr(Framecount)
End Sub

Private Sub Form_Load()
Combo1.AddItem ("COM1")
Combo1.AddItem ("COM2")
Combo1.AddItem ("COM3")
Combo1.AddItem ("COM4")
Combo1.AddItem ("COM5")
Combo1.ListIndex = 0

Combo2.AddItem ("2400")
Combo2.AddItem ("4800")
Combo2.AddItem ("9600")
Combo2.AddItem ("11520")
Combo2.ListIndex = 0

Combo3.AddItem ("E")
Combo3.AddItem ("O")
Combo3.AddItem ("N")
Combo3.ListIndex = 2

Combo4.AddItem ("6")
Combo4.AddItem ("7")
Combo4.AddItem ("8")
Combo4.ListIndex = 2

Combo5.AddItem ("1")
Combo5.AddItem ("2")
Combo5.ListIndex = 0

ReceCount = 0
End Sub

Private Function Crc16(data() As Byte) As String
      Dim CRC16Lo As Byte, CRC16Hi As Byte      ‘CRC寄存器
      Dim CL As Byte, CH As Byte                ‘多项式码&HA001
      Dim CrcLo As String, CrcHi As String
      Dim SaveHi As Byte, SaveLo As Byte
      Dim i As Integer
      Dim Flag As Integer
      CRC16Lo = &HFF
      CRC16Hi = &HFF
      CL = &H1
      CH = &HA0
      For i = 1 To UBound(data)
        CRC16Lo = CRC16Lo Xor data(i) ‘每一个数据与CRC寄存器进行异或
        For Flag = 0 To 7
          SaveHi = CRC16Hi
          SaveLo = CRC16Lo
          CRC16Hi = CRC16Hi \ 2            ‘高位右移一位
          CRC16Lo = CRC16Lo \ 2            ‘低位右移一位
          If ((SaveHi And &H1) = &H1) Then ‘如果高位字节最后一位为1
            CRC16Lo = CRC16Lo Or &H80      ‘则低位字节右移后前面补1
          End If                           ‘否则自动补0
          If ((SaveLo And &H1) = &H1) Then ‘如果LSB为1，则与多项式码进行异或
            CRC16Hi = CRC16Hi Xor CH
            CRC16Lo = CRC16Lo Xor CL
          End If
        Next Flag
      Next i
      If Len(Hex(CRC16Hi)) = 1 Then
         CrcHi = "0" + Hex(CRC16Hi)
      Else
         CrcHi = Hex(CRC16Hi)
      End If
      If Len(Hex(CRC16Lo)) = 1 Then
         CrcLo = "0" + Hex(CRC16Lo)
      Else
         CrcLo = Hex(CRC16Lo)
      End If
         Crc16 = CrcLo & CrcHi
End Function

Private Sub MSComm1_OnComm()
Dim inpu() As Byte
Dim i As Integer
Dim tempstr As String, Strdata As String

Select Case MSComm1.CommEvent
Case comEvReceive ‘接收事件

tempstr = MSComm1.Input
inpu() = tempstr

Framecount = Framecount + 1                      ‘帧个数加1
If (Framecount = 1) Then
framepoint(Framecount) = UBound(inpu) + 1         ‘第一帧帧尾
Else
framepoint(Framecount) = framepoint(Framecount - 1) + UBound(inpu) + 1     ‘第二帧开始指针
End If

For i = 0 To UBound(inpu)                    ‘将字符转换为数组
If (Len(Hex(inpu(i))) = 1) Then
Strdata = Strdata & "0" & Hex(inpu(i)) & " "
Else
Strdata = Strdata & Hex(inpu(i)) & " "
End If
Next i

For i = ReceCount + 1 To UBound(inpu) + 1 ‘数据进入缓冲区
Recebuf(i) = inpu(i - 1)
Next

ReceCount = ReceCount + UBound(inpu) + 1

TextReceive.Text = TextReceive.Text & Strdata
Strdata = ""

Case comEvSend

End Select

End Sub

Private Function RtuCheck(data() As Byte) As Integer

Dim CrcHi As Byte, CrcLo As Byte
Dim Checkdata() As Byte
Dim i As Integer
Dim crc As String

CrcHi = data(UBound(data))
CrcLo = data(UBound(data) - 1)
ReDim Checkdata(1 To (UBound(data) - 1)) As Byte

For i = 1 To (UBound(data) - 1) ‘附值
Checkdata(i) = data(i - 1)
Next

crc = Crc16(Checkdata)
If (CrcLo = Val("&H" & CStr(Mid(crc, 1, 2))) And CrcHi = Val("&H" & CStr(Mid(crc, 3, 2)))) Then
RtuCheck = 1
Else
RtuCheck = 0
End If

End Function

分享到：

邀请回答

回复楼主

碧水轻波

精华：1帖
求助：1帖
帖子：16帖 | 924回
年度积分：12
历史总积分：4129
注册：2012年3月12日

发表于：2012-07-22 21:14:12

1楼

好东东，可我看不懂哎

回复引用举报

花木兰-骑士军团

精华：0帖
求助：16帖
帖子：48帖 | 2123回
年度积分：0
历史总积分：3884
注册：2012年2月16日

发表于：2012-07-22 22:46:41

2楼

悲催啊，我也看不懂啊

回复引用举报

战魂——骑士军团

精华：0帖
求助：1帖
帖子：15帖 | 940回
年度积分：0
历史总积分：2011
注册：2012年3月22日

发表于：2012-07-22 22:54:14

3楼

上传点界面图片。

回复引用举报

leayee1010

精华：0帖
求助：0帖
帖子：1帖 | 72回
年度积分：0
历史总积分：63
注册：2011年7月01日

发表于：2012-08-01 23:38:31

4楼

不知道怎么用的。。求详细解释

回复引用举报

ahljj

精华：0帖
求助：0帖
帖子：1帖 | 806回
年度积分：0
历史总积分：3791
注册：2002年10月03日

发表于：2012-12-03 13:06:41

5楼

学习了。。。。。。。。

回复引用举报

亲吻那棵树

精华：0帖
求助：0帖
帖子：2帖 | 140回
年度积分：0
历史总积分：518
注册：2008年2月21日

发表于：2012-12-20 11:15:41

6楼

只会梯子，连句子都看不懂，何况这么多字母

回复引用举报

happinessman88

精华：0帖
求助：0帖
帖子：36帖 | 122回
年度积分：0
历史总积分：789
注册：2010年5月02日

发表于：2012-12-20 11:50:23

7楼

回复内容：
对：亲吻那棵树关于只会梯子，连句子都看不懂，何况这么多字母内容的回复：

也是，计算机编程就欺负工控人，那就爬着梯子上去吧。

计算机编程就欺负工控人，这也是西门子WINCC吃香喝辣的原因

回复引用举报

亲吻那棵树

精华：0帖
求助：0帖
帖子：2帖 | 140回
年度积分：0
历史总积分：518
注册：2008年2月21日

发表于：2012-12-20 16:06:45

8楼

回复内容：
对：happinessman88关于回复内容：对：亲吻那棵树关于只会梯子，连句子都看不懂，何况这么多字母内容的回复：也是，计算机编程就欺负工控人，那就爬着梯子上去吧。计算机编程就欺负工控人，这也是西门子WINCC吃香喝辣的原因内容的回复：

大侠有时间的话给解释解释吧，俺们也想学习学习。向计算机编程者致敬！

回复引用举报

四眼12

精华：0帖
求助：0帖
帖子：1帖 | 107回
年度积分：2
历史总积分：95
注册：2013年4月12日

发表于：2013-04-12 13:37:32

9楼

慢慢学习

回复引用举报

fdd

精华：0帖
求助：6帖
帖子：24帖 | 200回
年度积分：23
历史总积分：5363
注册：2006年8月21日

发表于：2014-03-05 14:31:49

10楼

'定时运行

Private Sub Timer1_Timer()

Dim ybtSend1(8) As Byte '发送数据数组

Dim xbtSend1(8) As Byte '发送数据数组

Dim i As Integer

Dim crc

Dim btCRCHi As Byte, btCRCLo As Byte

'读取Y值

ybtSend1(0) = &H1 ' PLC地址 01 01 0000 0008 3DCC 读取Y0---Y7

ybtSend1(1) = &H1 ' 读取吗

ybtSend1(2) = &H0 'PLC Y输出地址

ybtSend1(3) = &H0 '

ybtSend1(4) = &H0 '

ybtSend1(5) = &H8 '读取数目 Y0----Y7===8位

crc = CalCRC16Fast(ybtSend1, 6, btCRCLo, btCRCHi) '调用CRC16计算函数 'CRC(0)为高位 'CRC(1)为低位

ybtSend1(6) = btCRCHi ' 低位 CRC

ybtSend1(7) = btCRCLo ' 高位 CRC

MSComm1.InBufferCount = 0 ' 清除缓冲

MSComm1.PortOpen = True ' 打开串口

MSComm1.Output = CVar(ybtSend1) ' 发送数据

TimeDelay (200) ' 延时等待数据返回

ybtReceive = MSComm1.Input ' 接受数据

Text1.Text = Hex(ybtReceive(3)) ' 读取的有用数据进行处理 'Hex(btReceive(0)) + Hex(btReceive(1)) + Hex(btReceive(2)) + Hex(btReceive(3)) + Hex(btReceive(4)) + Hex(btReceive(5))

MSComm1.PortOpen = False ' 关闭串口

yout = Val("&H" & Text1.Text) ' 数据进行处理 16进制

For i = 0 To 7 ' 循环显示灯

If (yout And (2 ^ i)) = 0 Then

Shape1(i).FillColor = RGB(255, 0, 0) ' 红灯 RGB====red green black

y(i) = 0 ' 输出Y0-----Y7 OFF与ON

Else: Shape1(i).FillColor = RGB(0, 255, 0) ' 绿灯

y(i) = 1

End If

Next i

'读取X值

xbtSend1(0) = &H1 ' PLC地址 01 01 1200 0008 38B4 读取X0---X7

xbtSend1(1) = &H2 ' 读取吗

xbtSend1(2) = &H0 'PLC X输出地址

xbtSend1(3) = &H0 '

xbtSend1(4) = &H0 '

xbtSend1(5) = &H8 '读取数目 X0----X7===8位

crc = CalCRC16Fast(xbtSend1, 6, btCRCLo, btCRCHi) '调用CRC16计算函数 'CRC(0)为高位 'CRC(1)为低位

xbtSend1(6) = btCRCHi ' 低位 CRC

xbtSend1(7) = btCRCLo ' 高位 CRC

MSComm1.InBufferCount = 0 ' 清除缓冲

MSComm1.PortOpen = True ' 打开串口

MSComm1.Output = CVar(xbtSend1) ' 发送数据

TimeDelay (200) ' 延时等待数据返回

xbtReceive = MSComm1.Input ' 接受数据

Text2.Text = Hex(xbtReceive(3)) ' 读取的有用数据进行处理 'Hex(btReceive(0)) + Hex(btReceive(1)) + Hex(btReceive(2)) + Hex(btReceive(3)) + Hex(btReceive(4)) + Hex(btReceive(5))

MSComm1.PortOpen = False ' 关闭串口

xyout = Val("&H" & Text2.Text) ' 数据进行处理 16进制

For i = 0 To 7 ' 循环显示灯

If (xyout And (2 ^ i)) = 0 Then

Shape2(i).FillColor = RGB(255, 0, 0) ' 红灯 RGB====red green black

X(i) = 0 ' 输出Y0-----Y7 OFF与ON

Else: Shape2(i).FillColor = RGB(0, 255, 0) ' 绿灯

X(i) = 1

End If

Next i

End Sub

回复引用举报

fdd

精华：0帖
求助：6帖
帖子：24帖 | 200回
年度积分：23
历史总积分：5363
注册：2006年8月21日

发表于：2014-03-05 14:34:03

11楼

回复内容：

对： fdd '定时运行Private Sub Timer1_Tim... 内容的回复！

我写了个，大家参考参考，欢迎指点

回复引用举报

zw纯爷们

精华：0帖
求助：0帖
帖子：0帖 | 15回
年度积分：0
历史总积分：4
注册：2014年11月26日

发表于：2014-12-02 14:05:04

12楼

好东西啊！有C语言的吗？？

回复引用举报

jine1116

精华：0帖
求助：0帖
帖子：1帖 | 48回
年度积分：9
历史总积分：1285
注册：2014年1月22日

发表于：2015-02-11 23:41:21

13楼

好东西啊！慢慢学习！

回复引用举报

cjj_f22

精华：0帖
求助：1帖
帖子：3帖 | 24回
年度积分：0
历史总积分：25
注册：2008年6月06日

发表于：2015-02-16 01:22:41

14楼

从头到尾看了1分钟，基本都懂，就是获取接收事件和某本书上的法子不太一样，值得借鉴。把整条指令当做子函数模块也比书上的方便多了，呵呵，又涨了见识喽，开阔思路，多谢楼主

回复引用举报

快手小呆

精华：0帖
求助：0帖
帖子：0帖 | 2回
年度积分：0
历史总积分：1
注册：2015年10月12日

发表于：2015-10-12 14:21:58

15楼

33333333333

回复引用举报

iteerh

精华：0帖
求助：1帖
帖子：2帖 | 79回
年度积分：0
历史总积分：43
注册：2014年3月18日

发表于：2016-02-16 22:53:32

16楼

完全看不懂，謝謝分享

回复引用举报

迷路耗子

精华：0帖
求助：0帖
帖子：1帖 | 7回
年度积分：0
历史总积分：181
注册：2004年6月02日

发表于：2016-04-01 10:21:42

17楼

这个不错啊谢谢分享

回复引用举报

scluobin

精华：0帖
求助：3帖
帖子：4帖 | 66回
年度积分：0
历史总积分：50
注册：2011年11月18日

发表于：2016-04-14 19:42:07

18楼

不知道怎么用的。。求详细解释

回复引用举报

sos991

精华：0帖
求助：0帖
帖子：0帖 | 2回
年度积分：0
历史总积分：26
注册：2017年5月12日

发表于：2017-07-18 01:11:48

19楼

正需要用呢，学习下，非常感谢分享！！！

回复引用举报

aqxjsss

精华：0帖
求助：1帖
帖子：5帖 | 115回
年度积分：48
历史总积分：1005
注册：2010年9月01日

发表于：2017-12-27 17:01:46

20楼

学习，非常感谢分享！！！

回复引用举报

热门招聘

﻿用VB 写的上位机modbus rtu模式通讯源码，已在台达PLC上调试通过 ﻿点击：7697 | 回复：28

用VB 写的上位机modbus rtu模式通讯源码，已在台达PLC上调试通过点击：7697 | 回复：28