下面是我通过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