无线照明系统开发过程说明（五）

无线照明系统开发过程说明（五） 通讯类

     无线照明控制的底层通讯，采用的串口通讯模式，串口迅速一般都不是很快，通讯波特率一般为2400~19200，这里串口通讯设计为9600,N,8,1。空中实际通讯为4800.每一次通讯时间（实测）时间：16ms。一秒之内最多可以获得50个模块的信息。还是不错，当然速度高是最好的，但价格也高了。串口通讯最大的缺点是通讯要一个接一个，串行方式，快了就处理不了。 所以在设计通讯类只能是SHARED方式。详细内容

Public Class ClsRsComm
    Shared st As New Stopwatch
    Shared mBaudRate As Integer
    Shared mParity As IO.Ports.Parity
    Shared mDataBit As Integer
    Shared mStopBit As IO.Ports.StopBits
    Shared mPortName As String
    Shared WithEvents Rs232 As SerialPort
 
    ''' <summary>
    ''' 设置通讯延时时间,默认值78ms
    ''' </summary>
    ''' <remarks></remarks>
    Shared mvarDelayComm As Integer = 100
    Shared Property DelayComm() As Integer
        Get
            Return mvarDelayComm
        End Get
        Set(ByVal value As Integer)
            mvarDelayComm = value
        End Set
End Property

    Shared mvarCommPort As String = "COM1"
    Shared Property CommPort() As String
        Get
            Return mvarCommPort
        End Get
        Set(ByVal value As String)
            mvarCommPort = value
        End Set
    End Property

    Sub New()
        mPortName = "COM4"
        mBaudRate = 9600
        mParity = Parity.None
        mDataBit = 8
        mStopBit = StopBits.One
    End Sub

    Sub New(ByVal pPortName As String, ByVal pBaudRate As Integer, ByVal pDatabit As Integer, ByVal pParity As Parity, ByVal pStopbit As StopBits)
        mPortName = pPortName
        mBaudRate = pBaudRate
        mParity = pParity
        mDataBit = pDatabit
        mStopBit = pStopbit
    End Sub

    Shared Function OpenComm() As Boolean
        Dim Bl As Boolean = False
        mPortName = mvarCommPort
        mBaudRate = 9600
        mParity = Parity.None
        mDataBit = 8
        mStopBit = StopBits.One
        Try
            Rs232 = New IO.Ports.SerialPort(mPortName, mBaudRate, mParity, mDataBit, mStopBit)
            Rs232.Encoding = Encoding.ASCII
            If Not Rs232.IsOpen Then
                Rs232.Open()
                Rs232.ReceivedBytesThreshold = 1
            Else
                MsgBox("通讯端口打开错误（端口已被打开)")
            End If
            Bl = True

        Catch ex As Exception
            MsgBox(ex.ToString & vbCrLf & "打开出错！")
            Bl = False
        End Try

        Return Bl
    End Function

    ''' <summary>
    ''' 关闭串口
    ''' </summary>
    ''' <remarks></remarks>
    Shared Sub CloseComm()
        If Rs232 Is Nothing OrElse Not Rs232.IsOpen Then
            MsgBox("通信端口尚未打开！")
            Exit Sub
        Else
            Rs232.Close()
            Rs232 = Nothing
        End If
    End Sub

    ''' <summary>
    ''' 延时程序(ms)
    ''' </summary>
    ''' <param name="Dt"></param>
    ''' <remarks></remarks>
    Shared Sub TimeDelay(ByVal Dt As Integer)
        Dim StartTick As Integer
        StartTick = Environment.TickCount
        Do
            If Environment.TickCount - StartTick >= Dt Then Exit Do
         Loop
    End Sub

    ''' <summary>
    ''' 等待字节数目是否达到，或时间超时
    ''' </summary>
    ''' <param name="Strlen"></param>
    ''' <param name="Dt"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Overloads Shared Function WaitResponse(ByVal Strlen As Integer, ByVal Dt As Integer) As String
        Dim TT As Integer, bTimeOver As Boolean
        TT = Environment.TickCount
        bTimeOver = False
        Do
            If Rs232.BytesToRead >= Strlen Then Exit Do
            If Environment.TickCount - TT > Dt Then bTimeOver = True
        Loop Until bTimeOver

        If bTimeOver Then
            Return String.Empty
        Else
            TimeDelay(5)
            Return (Rs232.ReadExisting)
        End If
    End Function

    ''' <summary>
    ''' #01000+#, @01+0#格式设置数字输出状态来控制模块
    ''' </summary>
    ''' <param name="mInput"></param>
    ''' <param name="mRetLeng"></param>
    ''' <param name="mWaitTime"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Overloads Shared Function Write(ByVal mInput As String, Optional ByVal mRetLeng As Integer = 2, Optional ByVal mWaitTime As Integer = 100) As Boolean
        Dim RetDM As String
        Rs232.DiscardInBuffer()
        Rs232.Write(mInput + vbCr)
        RetDM = WaitResponse(mRetLeng, mWaitTime)
        If RetDM.Contains(">") Then
            Return True
        Else
            Return False
        End If
    End Function

    ''' <summary>
    ''' 根据地址，及控件字符来@01## 控制模块
    ''' </summary>
    ''' <param name="mAddress"></param>
    ''' <param name="mInput"></param>
    ''' <param name="mFlag"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Overloads Shared Function Write(ByVal mAddress As Integer, ByVal mInput As String, ByVal mFlag As Integer) As Boolean
        Dim mBuf As String

        mBuf = Hex(mAddress)                 '转换成 16进制 
        If mBuf.Length = 1 Then              '对长度进行
            mBuf = "0" & mBuf
        End If

        If mInput.Length = 1 Then
            mInput = "0" & mInput
        End If

        Dim mInStr As String
        mInStr = "@" & mBuf & mInput         '@01##

        Return Write(mInStr)

    End Function

    ''' <summary>
    ''' 写mInput字符，并指定返回mRetleng长度字符，如果长度不够则退出
    ''' </summary>
    ''' <param name="mRetleng"></param>
    ''' <param name="mInput"></param>
    ''' <returns></returns>
    ''' <remarks>返回字符串</remarks>
    Overloads Shared Function Write(ByVal mRetleng As Integer, ByVal mInput As String) As String
        Dim RetDM As String
        Rs232.DiscardInBuffer()
        Rs232.Write(mInput + vbCr)
        RetDM = WaitResponse(mRetleng, DelayComm)

        If RetDM.Contains(">") Then
            Return RetDM
        Else
            Return String.Empty
            'Console.WriteLine(RetDM.ToString)
            ''st.Stop()
            'Console.WriteLine(st.ElapsedMilliseconds)
            ''st.Reset()
        End If
    End Function


    ''' <summary>
    ''' 只能@01 返回0F00 读取某一地址输入输出状态，返回数组
    ''' </summary>
    ''' <param name="mAddress"></param>
    ''' <returns></returns>
    ''' <remarks>返回数组</remarks>
    Overloads Shared Function Read(ByVal mAddress As Integer, Optional ByVal mRetLong As Integer = 6) As String()
        Dim mBuf As String
        Dim DObuf(1) As String

        DObuf(0) = String.Empty
        DObuf(1) = String.Empty
        'If mAddress < 1 OrElse mAddress > 256 Then
        '    Return DObuf
        'End If

        mBuf = Hex(mAddress)                 '转换成 16进制 
        If mBuf.Length = 1 Then              '对长度进行
            mBuf = "0" & mBuf
        End If

        Dim mInStr As String
        mInStr = "@" & mBuf      '返回值长度为8个字节$016也可

        Dim pRetStr As String
        pRetStr = Write(mRetLong, mInStr)

        If pRetStr.Length < mRetLong - 1 Then
            Return DObuf
        End If

        DObuf(0) = Mid(pRetStr, 3, 1)           '取出代表数字输出状态的字符
        DObuf(1) = Mid(pRetStr, 5, 1)           '取出代表数据输入状态的字符

        Return DObuf

    End Function

    ''' <summary>
    ''' 获取16进制字节某一位的状态
    ''' </summary>
    ''' <param name="mFlag"></param>
    ''' <param name="mWeiZhi"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Shared Function HexToFlag(ByVal mFlag As String, ByVal mWeiZhi As Integer) As Boolean
        Return IIf(Val("&H" & mFlag) And 2 ^ mWeiZhi, True, False)
    End Function
End Class

''#010001设置数字输出状态
''$016读数字输入输出状态