一网友需要采集接收从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
这样完整的代码就弄好了。
运行如下所示：
