下面是我通过232对一个功率表实现数据采集的代码,如果想通过485实现对多个功率表的数据采集,该如何修改。
Dim t_flag As Integer
Dim t_type As String
'为了支持组态软件,推出新modbus规约2。0(相对于1。0命令地址、寄存器个数、回送个数,有所不同,请注意)
'以召测电压为例,请注意注释标记1.0和2.0的区别。
Private Sub Command1_Click()
Dim crc As Long
Dim dbl As A_single
Dim byteAry As a_ByteAry
On Error GoTo errs
With MSComm1
ReDim fx(7)
.CommPort = 8
.SThreshold = 8
.RThreshold = 9 '2.0版(浮点数、长整形回送9个,整形回送7个,字节形回送6个)
'1.0版(浮点数回送9个)
.PortOpen = True
.Settings = "9600,n,8,1" '2.0版(无校验n)
'1.0版(偶校验e)
fx(0) = &H1
fx(1) = &H3
fx(2) = &H10 '2.0版(fx(2)=&h10,fx(3)=&h0)
fx(3) = &H4 '1.0版(fx(2)=&h0,fx(3)=&h0)
fx(4) = &H0 '2.0版(fx(5)=2)
fx(5) = &H2 '1.0版(fx(5)=1)
tmp = .Input '清空端口
shuju = 0 '清空数据
'CRC校验
crc = &HFFFF&
For TmpI = 0 To 5
crc = CrcResult(CLng(fx(TmpI)), &HA001&, crc)
Next
fx(6) = CByte(crc And &HFF&)
fx(7) = CByte(Fix(crc / 256) And &HFF&)
t_flag = 0 '通讯状态标志置零
t_type = "召测电压"
.Output = fx '发送数据
Timer1.Enabled = True
Do
If t_flag <> 0 Then
Label1.Caption = "W"
If t_flag = 1 Then
shu = fresult
Label1.Caption = fresult + Label1.Caption
ElseIf t_flag = 3 Then
errt = errt + t_type + "通讯超时!" + Chr(10) + Chr(13)
End If
Exit Do
End If
DoEvents
Loop
.PortOpen = False
End With
If errt <> "" Then
MsgBox errt, , "通讯错误"
Else
MsgBox "召测数据成功!"
End If
Exit Sub
errs:
MsgBox Err.Description
Timer1.Enabled = False
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
End SubPrivate Sub MSComm2_OnComm()End Sub
Private Sub MSComm1_OnComm()
Dim read_count As Integer
Dim crc As Long
Select Case MSComm1.CommEvent
Case comEvReceive
read_count = MSComm1.InBufferCount
shuju = MSComm1.Input
'CRC校验
crc = &HFFFF&
Timer1.Enabled = False
For TmpI = 0 To read_count - 3
crc = CrcResult(CLng(shuju(TmpI)), &HA001&, crc)
Next
If shuju(TmpI) = CByte(crc And &HFF&) And shuju(TmpI + 1) = CByte(Fix(crc / 256) And &HFF&) Then
t_flag = 1 '成功标志
Else
t_flag = 2
errt = errt & t_type & "CRC校验错!" + Chr(10) + Chr(13)
End If
Case comEvSend
Case comEventRxParity
Timer1.Enabled = False
t_flag = 2
errt = errt & t_type & "奇偶校验错!" + Chr(10) + Chr(13)
End Select
End SubPrivate Sub Timer1_Timer()
Dim read_count As Integer
Dim crc As Long
read_count = MSComm1.InBufferCount
If read_count = 5 Then
t_flag = 2
shuju = MSComm1.Input
'CRC校验
crc = &HFFFF&
Timer1.Enabled = False
For TmpI = 0 To read_count - 3
crc = CrcResult(CLng(shuju(TmpI)), &HA001&, crc)
Next
If shuju(TmpI) = CByte(crc And &HFF&) And shuju(TmpI + 1) = CByte(Fix(crc / 256) And &HFF&) Then
If shuju(2) = 1 Then
errt = errt & t_type & "错误响应-非法命令!" + Chr(10) + Chr(13)
Else
errt = errt & t_type & "错误响应-非法数据位置!" + Chr(10) + Chr(13)
End If
Else
errt = errt & t_type & "错误响应!" + Chr(10) + Chr(13)
End If
Else
'置超时标志
t_flag = 3
Timer1.Enabled = False
End If
End Sub
Dim t_flag As Integer
Dim t_type As String
'为了支持组态软件,推出新modbus规约2。0(相对于1。0命令地址、寄存器个数、回送个数,有所不同,请注意)
'以召测电压为例,请注意注释标记1.0和2.0的区别。
Private Sub Command1_Click()
Dim crc As Long
Dim dbl As A_single
Dim byteAry As a_ByteAry
On Error GoTo errs
With MSComm1
ReDim fx(7)
.CommPort = 8
.SThreshold = 8
.RThreshold = 9 '2.0版(浮点数、长整形回送9个,整形回送7个,字节形回送6个)
'1.0版(浮点数回送9个)
.PortOpen = True
.Settings = "9600,n,8,1" '2.0版(无校验n)
'1.0版(偶校验e)
fx(0) = &H1
fx(1) = &H3
fx(2) = &H10 '2.0版(fx(2)=&h10,fx(3)=&h0)
fx(3) = &H4 '1.0版(fx(2)=&h0,fx(3)=&h0)
fx(4) = &H0 '2.0版(fx(5)=2)
fx(5) = &H2 '1.0版(fx(5)=1)
tmp = .Input '清空端口
shuju = 0 '清空数据
'CRC校验
crc = &HFFFF&
For TmpI = 0 To 5
crc = CrcResult(CLng(fx(TmpI)), &HA001&, crc)
Next
fx(6) = CByte(crc And &HFF&)
fx(7) = CByte(Fix(crc / 256) And &HFF&)
t_flag = 0 '通讯状态标志置零
t_type = "召测电压"
.Output = fx '发送数据
Timer1.Enabled = True
Do
If t_flag <> 0 Then
Label1.Caption = "W"
If t_flag = 1 Then
shu = fresult
Label1.Caption = fresult + Label1.Caption
ElseIf t_flag = 3 Then
errt = errt + t_type + "通讯超时!" + Chr(10) + Chr(13)
End If
Exit Do
End If
DoEvents
Loop
.PortOpen = False
End With
If errt <> "" Then
MsgBox errt, , "通讯错误"
Else
MsgBox "召测数据成功!"
End If
Exit Sub
errs:
MsgBox Err.Description
Timer1.Enabled = False
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
End SubPrivate Sub MSComm2_OnComm()End Sub
Private Sub MSComm1_OnComm()
Dim read_count As Integer
Dim crc As Long
Select Case MSComm1.CommEvent
Case comEvReceive
read_count = MSComm1.InBufferCount
shuju = MSComm1.Input
'CRC校验
crc = &HFFFF&
Timer1.Enabled = False
For TmpI = 0 To read_count - 3
crc = CrcResult(CLng(shuju(TmpI)), &HA001&, crc)
Next
If shuju(TmpI) = CByte(crc And &HFF&) And shuju(TmpI + 1) = CByte(Fix(crc / 256) And &HFF&) Then
t_flag = 1 '成功标志
Else
t_flag = 2
errt = errt & t_type & "CRC校验错!" + Chr(10) + Chr(13)
End If
Case comEvSend
Case comEventRxParity
Timer1.Enabled = False
t_flag = 2
errt = errt & t_type & "奇偶校验错!" + Chr(10) + Chr(13)
End Select
End SubPrivate Sub Timer1_Timer()
Dim read_count As Integer
Dim crc As Long
read_count = MSComm1.InBufferCount
If read_count = 5 Then
t_flag = 2
shuju = MSComm1.Input
'CRC校验
crc = &HFFFF&
Timer1.Enabled = False
For TmpI = 0 To read_count - 3
crc = CrcResult(CLng(shuju(TmpI)), &HA001&, crc)
Next
If shuju(TmpI) = CByte(crc And &HFF&) And shuju(TmpI + 1) = CByte(Fix(crc / 256) And &HFF&) Then
If shuju(2) = 1 Then
errt = errt & t_type & "错误响应-非法命令!" + Chr(10) + Chr(13)
Else
errt = errt & t_type & "错误响应-非法数据位置!" + Chr(10) + Chr(13)
End If
Else
errt = errt & t_type & "错误响应!" + Chr(10) + Chr(13)
End If
Else
'置超时标志
t_flag = 3
Timer1.Enabled = False
End If
End Sub
1 首先,从机必须支持 485 协议。如果就是一种支持 RS232 的从机,则无法实现。(此情况,可以买 RS485 Hub 来实现,从机到 Hub 仍是 RS232 协议。北京卡来通公司有售)2 主机端要发送两种格式的命令:
* 9-bit 格式的地址命令,选中一个从机。
* 8-bit 格式的数据命令。只有被选中的从机应答此命令。两种命令交替进行。