通过S7-200西门子PLC做串口通讯 实现Modbus RTU协议通讯
自己写的 。。
Function crcresult(ByVal data As Long, ByVal genpoly As Long, ByVal crcdata As Long) As Long
Dim tmpi As Integer
data = data * 2
For tmpi = 8 To 1 Step -1
data = Fix(data / 2)
If ((data Xor crcdata) And 1) Then
crcdata = Fix(crcdata / 2) Xor genpoly
Else
crcdata = Fix(crcdata / 2)
End If
Next tmpi
crcresult = crcdata
End Function
Private Sub Command1_Click()
aflag = True
'On Error GoTo ErrProc
Dim sendbyte(7) As Byte
Dim receivebyte() As Byte
Dim receivedata() As Byte
sendbyte(0) = 2 '从机地址
sendbyte(1) = &H3 'Modbus数据读取命令
sendbyte(2) = &H0 '寄存器地址高字节 m
sendbyte(3) = &H0 '寄存器地址低字节
sendbyte(4) = &H0 '连续读寄存器个数高字节
sendbyte(5) = &H2 '连续读寄存器个数低字节
crc = &HFFFF& 'crc循环冗余计算
For tmpi = 0 To 5
crc = crcresult(CLng(sendbyte(tmpi)), &HA001&, crc)
Next
sendbyte(6) = CByte(crc And &HFF&) 'crc低8位
sendbyte(7) = CByte(Fix(crc / 256) And &HFF&) 'crc高8位
If MSComm1.PortOpen = False Then Exit Sub '如果串口未打开 退出
receivebyte = MSComm1.Input '清空缓冲区
MSComm1.Output = sendbyte '送出数据
MSComm1.RThreshold = 9 '设置接收数据区大小
If MSComm1.CommEvent Then
receivedata = MSComm1.Input '接收数据
crc = &HFFFF& '验证接收数据是否正确
For tmpi = 0 To 6
crc = crcresult(CLng(receivedata(tmpi)), &HA001&, crc)
Next
If receivedata(7) = CByte(crc And &HFF&) And receivedata(8) = CByte(Fix(crc / 256) And &HFF&) Then
Dim aStr As String
Dim i As Integer
For i = 3 To 6
aStr = aStr & Chr(receivedata(i))
Text1.Text = aStr
Next i
End If
End If
' End If
'ErrProc:
' MsgBox "传输数据失败", vbCritical, "网络传输"
End Sub
Private Sub Command2_Click()
bflag = True
On Error GoTo ErrProc
Dim sendbyte(7) As Byte
Dim receivebyte() As Byte
Dim receivedata() As Byte
sendbyte(0) = 2 '从机地址
sendbyte(1) = &H6 'Modbus数据写命令
sendbyte(2) = &H0 '寄存器地址高字节
sendbyte(3) = &H0 '寄存器地址低字节
sendbyte(4) = &H0 '写入寄存器数据的高字节
sendbyte(5) = &H2 '写入寄存器数据的低字节
crc = &HFFFF& 'crc循环冗余计算
For tmpi = 0 To 5
crc = crcresult(CLng(sendbyte(tmpi)), &HA001&, crc)
Next
sendbyte(6) = CByte(crc And &HFF&) 'crc低8位
sendbyte(7) = CByte(Fix(crc / 256) And &HFF&) 'crc高8位
If MSComm1.PortOpen = False Then Exit Sub '如果串口未打开 退出
receivebyte = MSComm1.Input '清空缓冲区
MSComm1.Output = sendbyte '送出数据
MSComm1.RThreshold = 8 '设置接收数据区大小
If MSComm1.CommEvent Then
receivedata = MSComm1.Input '接收数据
crc = &HFFFF& '验证接收数据是否正确
For tmpi = 0 To 5
crc = crcresult(CLng(receivedata(tmpi)), &HA001&, crc)
Next
If receivedata(6) = CByte(crc And &HFF&) And receivedata(7) = CByte(Fix(crc / 256) And &HFF&) Then
Dim aStr As String
Dim i As Integer
For i = 4 To 5
aStr = aStr & Chr(receivedata(i))
Text2.Text = aStr
Next i
End If
End If
End If
ErrProc:
MsgBox "传输数据失败", vbCritical, "网络传输"
End Sub
Private Sub MSComm1_OnComm()
Dim buffer As Variant '由缓冲区读取的数据用Variant 变量接收
Dim arr() As Byte '定义二进制数据数组
Dim i As Integer
Dim receivestr As String '定义输出到文本框的字符变量
If aflag = True Then
Select Case Comm1.CommEvent
Case comEvReceive
buffer = Comm1.Input '接收缓冲区内数据到Variant 变量内
arr = buffer '转换为二进制数并送入相应数组
For i = 3 To 6
receivestr = arr(i) '用字符串形式表示
Text1.Text = Text1.Text & receivestr & "," '在文本框中显示
Next i
End Select
aflag = False
End If
If bflag = True Then
Select Case Comm1.CommEvent
Case comEvReceive
buffer = Comm1.Input '接收缓冲区内数据到Variant 变量内
arr = buffer '转换为二进制数并送入相应数组
For i = 4 To 5
receivestr = arr(i) '用字符串形式表示
Text1.Text = Text1.Text & receivestr & "," '在文本框中显示
Next i
End Select
bflag = False
End If
End Sub