PLC48路采集数据监听

一网友需要采集接收从PLC发过来的48路采集数据，特为其编写了一个小程序，其通信协议如下所示：

返回固定地址adr	00 43 40 41（固定指令）		返回: adr 43 CRC

读未校准电压读数寄存器	adr 03 0100 0030 CRC	返回: adr 03 60 xxxx xxxx ..... xxxx CRC,  xxxx是48个电压,放大100倍.
读校准后电压寄存器		adr 03 0130 0030 CRC	返回: adr 03 60 xxxx xxxx ..... xxxx CRC,  xxxx是48个电压,放大100倍.


读5V时，ADC电压采样值		adr 03 0300 0030 CRC	返回: adr 03 60 xxxx xxxx ..... xxxx CRC,  xxxx是48个输入电压为5V时各点未校准值，放大100倍.
读48V时，ADC电压采样值		adr 03 0330 0030 CRC	返回: adr 03 60 xxxx xxxx ..... xxxx CRC,  xxxx是48个输入电压为48V时各点未校准值, 放大100倍.
读基准电压			adr 03 0460 0002 CRC	返回: adr 03 04 xxxx xxxx CRC,  第一个值为5V基准，第二个值为48V基准，放大100倍.

设定老化机种电压参数寄存器      adr 10 0380 0001 02  XXXX CRC	  

第一通道校准
写某路 X1点校准寄存器	adr 10 0200 0001 02 XXXX CRC	(第1个点 5V)		返回: adr 10 0200 0002 CRC  //0200  表示第一通道，0201 表示第二通道...022f表示48通道
写某路 X2点校准寄存器	adr 10 0240 0001 02 XXXX  CRC	(第2个点 48V)		返回: adr 10 0240 0002 CRC////0240  表示第一通道，0241 表示第二通道...026f表示48通道



校准方法：
1: 将标准电压X1(比如5V)接入。等待几秒钟以便读数稳定。
2: 发命令"adr 10 0200 0001 02 uuuu CRC"，记录X1点校准, uuuu是标准电压X1(放大100倍,即两位小数)。
1: 将标准电压X2(比如48V)接入。等待几秒钟以便读数稳定。
2: 发命令"adr 10 0200 0001 02 uuuu CRC"，记录X2点校准, uuuu是标准电压X2(放大100倍,即两位小数)。
校准结束。

　代码如下所示：

Dim bRev() As Byte
Dim bSnd() As Byte '发送数据
Private Sub cmdCom_Click()
 On Error GoTo err1
 If cmdCom.Caption = "打开端口" Then
  '设置串口
On errr GoTo defaults
  If Cobcom.Text = "" Then
      MsgBox "请选择串口号！"
      Exit Sub
  End If
  If cobspeed.Text = "" Then
      MsgBox "请选择波特率！"
      Exit Sub
  End If
  MSComm.CommPort = Cobcom.Text  '选用com串行口"9600,N,8,1"
  MSComm.Settings = cobspeed.Text & ",N,8,1"
  MSComm.PortOpen = True '打开通信
  cmdCom.Caption = "关闭端口"
  Exit Sub
defaults:
  MSComm1.CommPort = 1
  MSComm1.Settings = "9600,N,8,1"
  MsgBox "设置错误!" & Chr(13) & "自动设置默认值:9600,N,8,1"
 Else
  cmdCom.Caption = "打开端口"
  MSComm.PortOpen = False '关闭通信
 End If
 Exit Sub
err1:  MsgBox "端口已打开!"
End Sub

Private Sub cmdExit_Click()
If MSComm.PortOpen Then
    MsgBox "串口还在接收处理数据，请关闭后在退出！"
Else
    End
End If

End Sub

Private Sub cmdgetaddr_Click()
ReDim bSnd(0 To 3) As Byte
bSnd(0) = &H0
bSnd(1) = &H43
bSnd(0) = &H40
bSnd(1) = &H41
If (MSComm.PortOpen) Then
    MSComm.Output = bSnd
Else
    MsgBox "串口没有打开，请打开串口！"
End If

End Sub

Private Sub cmdJiao_Click()

ReDim bSnd(0 To 10) As Byte

If txtV.Text = "" Then
    MsgBox "请填写校准电压值！"
    Exit Sub
End If
If cobVol.Text = "" Then
    MsgBox "请选择基准电压！"
    Exit Sub
End If

If txtChl.Text = "" Then
    MsgBox "请填写通道号！"
    Exit Sub
End If

bSnd(0) = Int(Val(addr.Text))
bSnd(1) = &H10 '10
bSnd(2) = &H2   '02
If cobVol.Text = "5V" Then
    bSnd(3) = &H0 + Int(Val(txtChl.Text))
Else
    bSnd(3) = &H40 + Int(Val(txtChl.Text))
End If
bSnd(4) = &H0  '00
bSnd(5) = &H1  '01
bSnd(6) = &H2  '02
'处理电压
Dim v As Integer
v = Int(Val(txtV.Text) * 100) '获取电压值
bSnd(7) = (v / 256)
bSnd(8) = v Mod 256

Dim sTmp(0 To 8) As Byte
For i = 0 To 8
    sTmp(i) = bSnd(i)
Next
bSnd(6) = CRC16INT(sTmp, "L")
bSnd(7) = CRC16INT(sTmp, "H")
If MSComm.PortOpen Then
    MSComm.Output = bSnd
End If

End Sub

Private Sub cmdRun_Click()
If cmdRun.Caption = "运行" Then
    If zhouqi.Text = "" Then
        MsgBox "请设置好周期在运行程序！"
        Exit Sub
    End If
    If Val(zhouqi.Text) > 0 Then
        timRead.Interval = Int(Val(zhouqi.Text))
        timRead.Enabled = True
        cmdRun.Caption = "停止"
    Else
        MsgBox "周期设置错误！"
    End If
Else
    timRead.Enabled = False
    cmdRun.Caption = "运行"
End If

End Sub

Private Sub Form_Load()
For i = 1 To 16
    On Error Resume Next
   '当运行发生错误时，控件转到紧接着发生错误的语句之后的语句，并在此继续运行
    MSComm.CommPort = i
    MSComm.PortOpen = True
    Select Case Err.Number
       Case 0                       '错误号为0(也就是没出错),
         Cobcom.AddItem i
         MSComm.PortOpen = False
       Case 8005                '错误号为8005,也就是端口被占用
         Cobcom.AddItem i
         MSComm.PortOpen = False
    End Select
    Err = 0     '将错误号置0. 注:Err.Number可以简写为Err ,2者等效
Next
If Cobcom.ListCount > 0 Then
   Cobcom.ListIndex = 0
End If
cobVol.ListIndex = 0

cobspeed.AddItem ("4800")
cobspeed.AddItem ("9600")
cobspeed.AddItem ("115200")
Call InitCom
cobspeed.Text = "9600"
End Sub
Private Sub InitCom()
    MSComm.Settings = "9600,N,8,1" '波特率9600，无奇偶校验位，8位数据位1位停止位
    
    MSComm.InputLen = 0 'input将读取接收缓冲区的全部内容
    MSComm.InBufferSize = 1024 '设置接收缓冲区的字节长度
    'MSComm1.PortOpen = True '打开通信口
    MSComm.InBufferCount = 0 '清除接收缓冲区数据
    MSComm.OutBufferCount = 0 '清除发送缓冲区数据
    MSComm.InputMode = comInputModeBinary 'comInputModeText
    'MSComm.InputMode = comInputModeBinary
    'periodic.inteval = 100 '设置ls定时间隔，使遥测命令每隔ls发送1次
    MSComm.RThreshold = 1

End Sub

Private Sub MSComm_OnComm()
  Dim i As Integer, SBUF() As Byte
  If MSComm.CommEvent = comEvReceive Then
    SBUF = MSComm.Input
    For i = 0 To UBound(SBUF)
      Text1.Text = Text1.Text & " " & Hex(SBUF(i))
    Next
    Call DealData(SBUF)
  End If
End Sub

Private Sub DealData(sRev() As Byte)
Dim sTmp() As Byte
Dim i As Integer
Dim crcvalue, crcGet
Select Case UBound(sRev)
    Case 3 '返回的是地址，或者是错误数据,验证一下
        If (sRev(1) = &H43) Then
            ReDim sTmp(0 To 1) As Byte
            sTmp(0) = sRev(0)
            sTmp(1) = sRev(1)
            crcvalue = GETCRC16(sTmp, "L") '协议中固定为低位在前，高位在后
            crcGet = Hex(sRev(2)) + " " + Hex(sRev(3))
            If crcvalue = crcGet Then
                addr.Text = sTmp(0)
                txtShowMsg.Text = txtShowMsg.Text + "获取设备地址成功！" + vbCrLf
            End If
        End If
    Case 100 '正常数据电压采样值
        '判断地址是否相等，不相等就认为不是所要的数据
        If (sRev(0) + "" = addr.Text) And sRev(1) = &H3 Then
            ReDim sTmp(0 To 98) As Byte
            For i = 0 To 98
                sTmp(i) = sRev(i)
            Next
            crcvalue = GETCRC16(sTmp, "L") '
            crcGet = Hex(sRev(99)) + " " + Hex(sRev(100))
            If crcvalue = crcGet Then
                For i = 0 To 47
                    txtChannel(i).Text = (sRev(3 + i) * 256 + sRev(4 + i)) / 100 '把值显示在文本框
                Next
            End If
        End If
    Case 7 '读基准电压，写校准等
        If (sRev(0) + "" = addr.Text) And sRev(1) = &H10 Then
            ReDim sTmp(0 To 6) As Byte
            For i = 0 To 6
                sTmp(i) = sRev(i)
            Next
            crcvalue = GETCRC16(sTmp, "L") '
            crcGet = Hex(sRev(7)) + " " + Hex(sRev(8))
            If crcvalue = crcGet Then
                If (sRev(3) - &H40 > 0) Then
                    txtShowMsg.Text = txtShowMsg.Text + "X2点" + (sRev(3) - &H40 + 1) + "通道校准成功！" + vbCrLf
                Else
                    txtShowMsg.Text = txtShowMsg.Text + "X1点" + (sRev(3) + 1) + "通道校准成功！" + vbCrLf
                End If
            End If
        End If
        
        If (sRev(0) + "" = addr.Text) And sRev(1) = &H3 Then
            ReDim sTmp(0 To 6) As Byte
            For i = 0 To 6
                sTmp(i) = sRev(i)
            Next
            crcvalue = GETCRC16(sTmp, "L") '
            crcGet = Hex(sRev(7)) + " " + Hex(sRev(8))
            If crcvalue = crcGet Then
                txtShowMsg.Text = txtShowMsg.Text + "5V基准值：" + sRev(3) + "." + sRev(4) + vbCrLf
                txtShowMsg.Text = txtShowMsg.Text + "48V基准值：" + sRev(5) + "." + sRev(6) + vbCrLf
            End If
        End If
End Select


End Sub

Private Sub timRead_Timer()
'发送数据示例
'发送 读校准后电压寄存器 指令
ReDim bSnd(0 To 7) As Byte
bSnd(0) = Int(Val(addr.Text))
bSnd(1) = &H3 '03
bSnd(2) = &H1  '01
bSnd(3) = &H0  '00
bSnd(4) = &H0  '00
bSnd(5) = &H30 '30
Dim sTmp(0 To 5) As Byte
For i = 0 To 5
    sTmp(i) = bSnd(i)
Next
bSnd(6) = CRC16INT(sTmp, "L")
bSnd(7) = CRC16INT(sTmp, "H")
If MSComm.PortOpen Then
    MSComm.Output = bSnd
End If

End Sub

公共的CRC代码如下所示：

Public Function CRC(str1 As String, HL As String)


Dim CRCREG As Long

Dim MVAL As Long
Dim R As Integer
Dim T As Integer
CRCREG = 65535

For R = 1 To Len(str1) Step 2
MVAL = Val("&H" + Mid(str1, R, 2))

CRCREG = CRCREG Xor MVAL
CRCREG = CRCREG And 65535

For T = 1 To 8 Step 1
If (CRCREG And &H1) Then
CRCREG = (CRCREG \ 2) Xor &HA001
 CRCREG = CRCREG And 65535
 Else
     
   CRCREG = CRCREG \ 2
CRCREG = CRCREG And 65535
End If
Next

Next
Dim a As Long
Dim b As Long
a = CRCREG And 255
b = CRCREG And 65280
a = a * 256
b = b / 256

If (a + b) < 16 Then
CRC = "000" + Hex(a + b)
ElseIf (a + b) < 256 Then

CRC = "00" + Hex(a + b)
ElseIf (a + b) < 4096 Then
CRC = "0" + Hex(a + b)
Else
CRC = Hex(a + b)
End If

If HL = "H" Then
CRC = Left(CRC, 2)
ElseIf HL = "L" Then
CRC = Right(CRC, 2)
End If
End Function

Function CRC16(data() As Byte, HL As String) As String
Dim CRC16Lo As Byte
Dim CRC16Hi As Byte
Dim CL As Byte
Dim SaveHi As Byte
Dim SaveLo As Byte
Dim ii As Integer
Dim flag As Integer
CRC16Lo = &HFF
CRC16Hi = &HFF
CL = &H1
CH = &HA0
For ii = 0 To UBound(data)
CRC16Lo = CRC16Lo Xor data(ii)
For flag = 0 To 7
SaveHi = CRC16Hi
SaveLo = CRC16Lo
CRC16Hi = CRC16Hi \ 2
CRC16Lo = CRC16Lo \ 2
If ((SaveHi And &H1) = &H1) Then
CRC16Lo = CRC16Lo Or &H80
End If
If ((SaveLo And &H1) = &H1) Then
CRC16Hi = CRC16Hi Xor CH
CRC16Lo = CRC16Lo Xor CL
End If
Next flag
Next ii
Dim ReturnData(1) As Byte
ReturnData(0) = CRC16Hi
ReturnData(1) = CRC16Lo
If HL = "H" Then
CRC16 = Hex(ReturnData(0))
End If
If HL = "L" Then
CRC16 = Hex(ReturnData(1))
End If
End Function

' 用途：将十六进制转化为十进制
' 输入：Hex(十六进制数)
' 输入数据类型：String
' 输出：H2D(十进制数)
' 输出数据类型：Long
' 输入的最大数为7FFFFFFF,输出的最大数为2147483647
Public Function H2D(ByVal Hex As String) As Long
     Dim i As Long
     Dim b As Long
    
    Hex = UCase(Hex)
     For i = 1 To Len(Hex)
         Select Case Mid(Hex, Len(Hex) - i + 1, 1)
             Case "0": b = b + 16 ^ (i - 1) * 0
             Case "1": b = b + 16 ^ (i - 1) * 1
             Case "2": b = b + 16 ^ (i - 1) * 2
             Case "3": b = b + 16 ^ (i - 1) * 3
             Case "4": b = b + 16 ^ (i - 1) * 4
             Case "5": b = b + 16 ^ (i - 1) * 5
             Case "6": b = b + 16 ^ (i - 1) * 6
             Case "7": b = b + 16 ^ (i - 1) * 7
             Case "8": b = b + 16 ^ (i - 1) * 8
             Case "9": b = b + 16 ^ (i - 1) * 9
             Case "A": b = b + 16 ^ (i - 1) * 10
             Case "B": b = b + 16 ^ (i - 1) * 11
             Case "C": b = b + 16 ^ (i - 1) * 12
             Case "D": b = b + 16 ^ (i - 1) * 13
             Case "E": b = b + 16 ^ (i - 1) * 14
             Case "F": b = b + 16 ^ (i - 1) * 15
         End Select
     Next i
     H2D = b
End Function

Function GETCRC16(data() As Byte, HLBegin As String) As String
Dim CRC16Lo As Byte
Dim CRC16Hi As Byte
Dim CL As Byte
Dim SaveHi As Byte
Dim SaveLo As Byte
Dim ii As Integer
Dim flag As Integer
CRC16Lo = &HFF
CRC16Hi = &HFF
CL = &H1
CH = &HA0
For ii = 0 To UBound(data)
CRC16Lo = CRC16Lo Xor data(ii)
For flag = 0 To 7
SaveHi = CRC16Hi
SaveLo = CRC16Lo
CRC16Hi = CRC16Hi \ 2
CRC16Lo = CRC16Lo \ 2
If ((SaveHi And &H1) = &H1) Then
CRC16Lo = CRC16Lo Or &H80
End If
If ((SaveLo And &H1) = &H1) Then
CRC16Hi = CRC16Hi Xor CH
CRC16Lo = CRC16Lo Xor CL
End If
Next flag
Next ii
Dim ReturnData(1) As Byte
ReturnData(0) = CRC16Hi
ReturnData(1) = CRC16Lo
'H表示高位在前，L表示低位在前
If HLBegin = "H" Then
GETCRC16 = Hex(ReturnData(0)) + " " + Hex(ReturnData(1))
End If
If HLBegin = "L" Then
GETCRC16 = Hex(ReturnData(1)) + " " + Hex(ReturnData(0))
End If
End Function

Function CRC16INT(data() As Byte, HL As String) As Integer
Dim CRC16Lo As Byte
Dim CRC16Hi As Byte
Dim CL As Byte
Dim SaveHi As Byte
Dim SaveLo As Byte
Dim ii As Integer
Dim flag As Integer
CRC16Lo = &HFF
CRC16Hi = &HFF
CL = &H1
CH = &HA0
For ii = 0 To UBound(data)
CRC16Lo = CRC16Lo Xor data(ii)
For flag = 0 To 7
SaveHi = CRC16Hi
SaveLo = CRC16Lo
CRC16Hi = CRC16Hi \ 2
CRC16Lo = CRC16Lo \ 2
If ((SaveHi And &H1) = &H1) Then
CRC16Lo = CRC16Lo Or &H80
End If
If ((SaveLo And &H1) = &H1) Then
CRC16Hi = CRC16Hi Xor CH
CRC16Lo = CRC16Lo Xor CL
End If
Next flag
Next ii
Dim ReturnData(1) As Byte
ReturnData(0) = CRC16Hi
ReturnData(1) = CRC16Lo
If HL = "H" Then
CRC16INT = ReturnData(0)
End If
If HL = "L" Then
CRC16INT = ReturnData(1)
End If
End Function

这样完整的代码就弄好了。

运行如下所示：