cwidepluscomm.cls

与西门子PLC通讯的程序,经工业现场测试没有问题

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cWidePlusCH1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit


' @@@@@@@@  调用方法  @@@@@@@@

' 定义通讯串口号            setComPort
' 定义通讯串口设置          setComSet
' 实例化MSCOMM控件          setMSCOMMOCX
' 实例化Timer控件           setTimerOCX
' 初始化                    Initialization
' 开始通讯                  DoCommunication
' 在需要写数据的时候设置    setWriteOrder
' 关闭时销毁所有实例，调用  Termination



Private WithEvents priCOMM As MSComm
Attribute priCOMM.VB_VarHelpID = -1
Private WithEvents priTMRERR As Timer
Attribute priTMRERR.VB_VarHelpID = -1


Private priCOMPort                  As Integer      '串口号
Private priACPosition               As Integer      '累加器，记录当前通讯所处的位置
Private priRUNCount                 As Integer      '运行的命令条数
Private priPosition(1 To 25)        As Integer      '数组，记录第i次通讯代表的是第priPosition(i)块仪表
Private priCOMSettings              As String       '串口设置
Private priRecBuf                   As String       '接收字符串
Private priReadOrder(1 To 25)       As String       '读取命令数组
Private priTempOrder                As String       '临时的命令
Private priThisLoopTime             As Long         '本次通讯所用的时间
Private priLastLoopTime             As Long         '上次通讯所用的时间
Private priRealData                 As Double       '采集到的数据



' @ 返回采集到的数据信息
Public Event GetRealTimeData(ByRef lData() As Long, ByVal lPosition As Integer)



' @ 定义本类的属性

Public Property Let setComPort(ByVal lNewValue As Integer)          '定义通讯串口号
    priCOMPort = lNewValue
End Property

Public Property Let setComSet(ByVal lNewValue As String)            '定义通讯串口设置
    priCOMSettings = lNewValue
End Property

Public Property Let setMSCOMMOCX(ByRef lMSCOMM As MSComm)           '实例化MSComm控件
    Set priCOMM = lMSCOMM
End Property

Public Property Let setTimerOCX(ByRef lTimer As Timer)              '实例化Timer控件
    Set priTMRERR = lTimer
End Property

Public Property Let setWriteOrder(ByVal lNewValue As String)        '定义写命令
    
    On Local Error GoTo ErrOPR
        '检查写信息是否合法
        If CheckCRC(lNewValue) Then                             '注意要在写通讯结束之后，将这些设置恢复到正常的状态
            priReadOrder(25) = "@" & lNewValue & Chr$(13)       '将写命令赋给第25条命令集合
            priRUNCount = priRUNCount + 1                       '将需要通讯的次数增加一条
            priPosition(priRUNCount) = 25                       '将写命令赋值给最后一次通讯命令
        End If
    Exit Property
ErrOPR:
    
End Property

Public Property Let setArrBLWP(ByRef lNewValue As Variant)          '定义24个通讯设备是否进行通讯
    
    On Local Error GoTo ErrOPR                                      '按照顺序进行标志（1，2，3，6。。。。）
        Dim i%
        For i = 1 To 25
            If lNewValue(i) = 0 Then
                priRUNCount = i - 1         '需要通讯的次数，但是不包含写命令
'                priPosition(i) = 25        '最后一个通讯是写标志位
                Exit For
            End If
            priPosition(i) = lNewValue(i)   '第i次通讯对应某块编号的仪表
        Next
    Exit Property
ErrOPR:

End Property




'进行初始化，并打开串口
Public Function Initialization() As Boolean
    
    On Local Error GoTo ErrOPR
        priTMRERR.Interval = 2000
        priTMRERR.Enabled = True
        If priCOMM.PortOpen = True Then priCOMM.PortOpen = False
            priCOMM.CommPort = priCOMPort
        If priCOMM.PortOpen = False Then priCOMM.PortOpen = True
        priCOMM.Settings = priCOMSettings
        priCOMM.InputLen = 0
        priCOMM.RThreshold = 1
        priCOMM.InputMode = comInputModeText
        Call GetCOMString   '得到读命令字符串
    Exit Function
ErrOPR:
    
End Function

Public Sub DoCommunicationNow()                 ' @ 开始第一次通讯，并持续通讯下去
    
    On Local Error GoTo ErrOPR
        Call SendCOMString(priPosition(1))      '进行第一条通讯信息，并不一定是第一块仪表
    Exit Sub
ErrOPR:
        
End Sub


Private Sub GetCOMString()              ' @ 计算通讯命令字符串（固定的）
    
    On Local Error GoTo ErrOPR
        Dim i%, j%, k%, s$, m$
        For i = 1 To 24
            k = 0
            s = Hex(i)
            If Len(s) = 1 Then s = "0" & s
            s = s & "RD"
            For j = 1 To 4      '只有4个字符（固定的）
                k = k Xor Asc(Mid(s, j, 1))
            Next
            m = Hex(k)
            If Len(m) = 1 Then m = "0" & m
            priReadOrder(i) = "@" & s & m & Chr$(13)
        Next
        priReadOrder(25) = ""
    Exit Sub
ErrOPR:
    
End Sub

Private Function CheckCRC(ByVal xOrder As String) As Boolean    ' @ 检验命令的合法性

    On Local Error GoTo ErrOPR
        Dim s$, oldCRC%, i%, j%
        CheckCRC = False
        If Len(xOrder) < 6 Then
            Exit Function               '长度不够
        End If
        oldCRC = CInt("&H" & Right(xOrder, 2))
        s = Left(xOrder, Len(xOrder) - 2)
        For i = 1 To Len(s)
            j = j Xor Asc(Mid(s, i, 1))
        Next
        If oldCRC = j Then CheckCRC = True
    Exit Function
ErrOPR:
    CheckCRC = False
    
End Function

Private Sub SendCOMString(ByVal lPosition As Integer)   '仅仅是发送标志位对应的命令
    
    On Local Error GoTo ErrOPR
        Sleep 5                                         '延时5 ms
        priCOMM.Output = priReadOrder(lPosition)        '向串口发送命令
    Exit Sub
ErrOPR:
    
End Sub


Private Sub COMReset()                 '通讯出错时对通讯进行复位
    
    On Local Error GoTo ErrOPR
        Dim sTP
        sTP = priCOMM.Input                             '清空接收缓冲区
        If priACPosition = priRUNCount Then             '对通讯标志位进行处理，使之达到下一个通讯位
            priACPosition = 0
        End If
        priACPosition = priACPosition + 1
        priRecBuf = ""                                  '清除 priRecbuf 接收字符串
        Call SendCOMString(priPosition(priACPosition))  '发送下一条通讯命令
    Exit Sub
ErrOPR:
        
End Sub

Private Function NegOPR(ByVal lOldValue As Long) As Long    ' @ 处理负数
    
    NegOPR = lOldValue
    If lOldValue > 32767 Then NegOPR = 32768 - lOldValue
    
End Function

Private Sub CodeToData(ByVal lCode As String, ByVal lPosition As Integer)      ' @ 将数据码翻译成数据，然后触发 GetDATA 事件
    
    On Local Error GoTo ErrOPR
        '判断数据码是否合法，不合法就不触发 GetDATA 事件
        If Not IsNumeric("&H" & Left(lCode, 6)) Or Not IsNumeric("&H" & Right(lCode, 6)) Then
            Exit Sub        '任何一段不符合就退出此过程
        End If
        Dim tData(1) As Long
        Select Case priPosition(lPosition)                  '如果换了仪表的循序,则需要修改这个 Select Case
            Case 1, 9, 10, 12, 14, 17 To 24              '所有的单显仪表
            tData(0) = NegOPR(CLng("&H" & Mid(lCode, 5, 2) & Mid(lCode, 3, 2)))
            tData(1) = 0
            Case 2 To 4, 11, 13, 15, 16                             '所有的PID控制仪表
            tData(0) = NegOPR(CLng("&H" & Mid(lCode, 5, 2) & Mid(lCode, 3, 2)))
            tData(1) = NegOPR(CLng("&H" & Mid(lCode, 11, 2) & Mid(lCode, 9, 2)))
            Case 5      '流量计
            Case 6      '电量表
            Case 7      '8路巡检仪表
            Case 8      '报警器
            Case Else
        End Select
        RaiseEvent GetRealTimeData(tData(), priPosition(lPosition))
    Exit Sub
ErrOPR:
    
End Sub

Private Sub priCOMM_OnComm()                 ' @ MsComm控件的OnComm事件
    On Local Error GoTo ErrOPR
        Select Case priCOMM.CommEvent
            Case comEvReceive
                priRecBuf = priRecBuf & priCOMM.Input
            Case Else
        End Select
        '************************* 处理接收到的信息 *******************************
        If InStr(priRecBuf, Chr$(13)) Then                      '收到正确的信号
            Dim POS%                                            '得到信息中"R"的位置
'            frmMain.lblTest.Caption = priRecBuf
            '------------------ 完成对仪表参数的修改 ------------------
            If InStr(priRecBuf, "##") Then                      '检测到写命令正确的信息
                priRUNCount = priRUNCount - 1                   '复位读取命令的条数
                priReadOrder(25) = ""                           '清除命令队列中的最后一条命令
                priRecBuf = ""                                  '清除 priRecbuf 接收字符串
                priThisLoopTime = GetCurrentTime()              '得到当前的时间 ms
                priACPosition = 1
                Call SendCOMString(priPosition(1))              '直接发送第一条命令
                Exit Sub                                        '直接结束 OnComm 事件
            End If
            
            '------------------ 正常读取信息时的操作 ------------------
            priThisLoopTime = GetCurrentTime()                  '得到当前的时间 ms
            If Len(priRecBuf) < 18 Then                         '数据串太短认为此次通讯失败
                Call COMReset                                   '复位通讯
                Exit Sub                                        '直接结束 OnComm 事件
            End If
            POS = InStr(priRecBuf, "R")
            priRecBuf = Mid(priRecBuf, POS + 2, 12)             '获得数据位
            Call CodeToData(priRecBuf, priACPosition)           '数据处理
            If priACPosition = priRUNCount Then                 '对通讯标志位进行处理，使之达到下一个通讯位
                priACPosition = 0
            End If
            priACPosition = priACPosition + 1
            priRecBuf = ""                                      '清除 priRecbuf 接收字符串
            Call SendCOMString(priPosition(priACPosition))      '发送下一条通讯命令
            Exit Sub                                            '直接结束 OnComm 事件
        End If
    Exit Sub
ErrOPR:
    
    
End Sub

Private Sub priTMRERR_Timer()           ' @ 处理通讯延时时间的 Timer 定时器

        If priThisLoopTime = priLastLoopTime Then       '通讯超时
            Call COMReset                               '通讯复位（下一次）
        End If
        priLastLoopTime = priThisLoopTime
        
End Sub