main.vb

广西百色247台电视发射机监控源代码.已经过实践

        Dim i As Integer
        trans.State = 1
        trans.CommStatus = 2
        If DataBuf Is Nothing Then Exit Sub
        MSComm1.Output = DataBuf
        Sleep(1000)
        Dim aBytes As Byte() = MSComm1.Input
        Dim iPnt As Int32
        iPnt = aBytes.Length
        If iPnt <= 0 Then
            'trans.State = 2   '''关机
            trans.bOpenClose = False
            Exit Sub
        Else
            isSendOk = True
            trans.State = 0
        End If
        If aBytes Is Nothing Then
        Else
            'isSendOk = True
            'ReceiveData(aBytes, iPnt)
            ' ReceiveData(DataBuf, trans, CmdType)
            SelectView(2, aBytes, trans, CmdType)
            trans.parse(aBytes, iPnt, CmdType)
        End If
        If trans.CommStatus = 1 Then
            trans.State = 0  '''通讯正常
        ElseIf trans.CommStatus = 2 Then
            trans.State = 1 '''通讯异常
        ElseIf trans.CommStatus = 0 Then
            trans.State = 3 '''正常
        ElseIf trans.CommStatus = 3 Then
            trans.State = 4 '''报警
        End If
        ''*******************************报警数据记录
        If CmdType = 6 And trans.State = 3 Then
            SysAlarm(trans)
            For i = 0 To trans.AmpCount - 1
                AmpAlarm(i, trans)
            Next
            If trans.Master.bBackupState = False Then
                RefAlarm(0, trans)
            Else
                RefAlarm(1, trans)
            End If
            SMSalarm(trans.CommStatus, trans)
        End If
        ''*******************************
    End Sub
    Private Sub KTsendOrReceive(ByVal trans As TransmitKT, ByVal CmdType As Integer, ByVal saveFlag As Boolean)
        Dim databuf(0) As Byte
        Dim x As Integer
        Dim iCount As Integer
        SendDataBuf = SendData(CmdType, trans.TraType, trans.strTransmitAddr, trans.Port, trans.PortPara, "00", "00", trans.TransmitType)
        '''显示请求数据
        'DataView(lsvmsg, "请求数据：" + strSendData)
        'SendDataLog(SendDataBuf, trans, CmdType)
        SelectView(1, SendDataBuf, trans, CmdType)
        Select Case trans.TraType
            Case 2, 5 '''凯腾、金网通
                Select Case CmdType
                    Case 6
                        KTsendRs232Data(SendDataBuf, trans, CmdType)
                    Case Else
                        isSendOk = False
                        iCount = 0
                        Do
                            iCount += 1
                            KTsendRs232Data(SendDataBuf, trans, CmdType)
                            If isSendOk = True Then
                                Exit Do
                            End If
                        Loop Until iCount = 3
                End Select
            Case 4 '''北广
                databuf(0) = trans.TransmitAddr
                MSComm1.Output = databuf
                Sleep(500)
                Dim aBytes As Byte() = MSComm1.Input
                Dim iPnt As Int32
                iPnt = aBytes.Length
                If UBound(aBytes) < 0 Then Exit Sub
                If iPnt >= 0 And aBytes(0) = trans.TransmitAddr Then
                    Select Case CmdType
                        Case 6
                            KTsendRs232Data(SendDataBuf, trans, CmdType)
                        Case Else
                            isSendOk = False
                            iCount = 0
                            Do
                                iCount += 1
                                KTsendRs232Data(SendDataBuf, trans, CmdType)
                                If isSendOk = True Then
                                    Exit Do
                                End If
                            Loop Until iCount = 3
                    End Select
                End If
        End Select
        '''保存修改记录
        TramDatabase(trans.TransmitID, trans.TransmitName, CmdType, trans.State, saveFlag, trans.Id)
    End Sub
    Public Sub KTsendOpenClose(ByVal trans As TransmitKT)
        Select Case Today.DayOfWeek
            Case DayOfWeek.Monday
                If trans.Monday(0) Is Nothing Then
                Else
                    If OnOffFlag(trans.Monday(0)) = True Then
                        KTsendOrReceive(trans, 3, False)
                    End If
                End If
                If trans.Monday(1) Is Nothing Then
                Else
                    If OnOffFlag(trans.Monday(1)) = True Then
                        KTsendOrReceive(trans, 4, False)
                    End If
                End If
            Case DayOfWeek.Tuesday
                If trans.Tuesday(0) Is Nothing Then
                Else
                    If OnOffFlag(trans.Tuesday(0)) = True Then
                        KTsendOrReceive(trans, 3, False)
                    End If
                End If
                If trans.Tuesday(1) Is Nothing Then
                Else
                    If OnOffFlag(trans.Tuesday(1)) = True Then
                        KTsendOrReceive(trans, 4, False)
                    End If
                End If
                If trans.Tuesday(2) Is Nothing Then
                Else
                    If OnOffFlag(trans.Tuesday(2)) = True Then
                        KTsendOrReceive(trans, 3, False)
                    End If
                End If
                If trans.Tuesday(3) Is Nothing Then
                Else
                    If OnOffFlag(trans.Tuesday(3)) = True Then
                        KTsendOrReceive(trans, 4, False)
                    End If
                End If
            Case DayOfWeek.Wednesday
                If trans.Wednesday(0) Is Nothing Then
                Else
                    If OnOffFlag(trans.Wednesday(0)) = True Then
                        KTsendOrReceive(trans, 3, False)
                    End If
                End If
                If trans.Wednesday(1) Is Nothing Then
                Else
                    If OnOffFlag(trans.Wednesday(1)) = True Then
                        KTsendOrReceive(trans, 4, False)
                    End If
                End If
            Case DayOfWeek.Thursday
                If trans.Thursday(0) Is Nothing Then
                Else
                    If OnOffFlag(trans.Thursday(0)) = True Then
                        KTsendOrReceive(trans, 3, False)
                    End If
                End If
                If trans.Thursday(1) Is Nothing Then
                Else
                    If OnOffFlag(trans.Thursday(1)) = True Then
                        KTsendOrReceive(trans, 4, False)
                    End If
                End If
            Case DayOfWeek.Friday
                If trans.Friday(0) Is Nothing Then
                Else
                    If OnOffFlag(trans.Friday(0)) = True Then
                        KTsendOrReceive(trans, 3, False)
                    End If
                End If
                If trans.Friday(1) Is Nothing Then
                Else
                    If OnOffFlag(trans.Friday(1)) = True Then
                        KTsendOrReceive(trans, 4, False)
                    End If
                End If
            Case DayOfWeek.Saturday
                If trans.Saturday(0) Is Nothing Then
                Else
                    If OnOffFlag(trans.Saturday(0)) = True Then
                        KTsendOrReceive(trans, 3, False)
                    End If
                End If
                If trans.Saturday(1) Is Nothing Then
                Else
                    If OnOffFlag(trans.Saturday(1)) = True Then
                        KTsendOrReceive(trans, 4, False)
                    End If
                End If
            Case DayOfWeek.Sunday
                If trans.Sunday(0) Is Nothing Then
                Else
                    If OnOffFlag(trans.Sunday(0)) = True Then
                        KTsendOrReceive(trans, 3, False)
                    End If
                End If
                If trans.Sunday(1) Is Nothing Then
                Else
                    If OnOffFlag(trans.Sunday(1)) = True Then
                        KTsendOrReceive(trans, 4, False)
                    End If
                End If
        End Select
    End Sub
    Public Sub KTsendControlCmd(ByVal trans As TransmitKT)
        Dim QueryString As String
        Dim ds As DataSet
        Dim i As Integer
        Dim ResNum As Integer
        Dim controlType As Integer
        QueryString = "select * from controlCmd where response=0 and hostAffirm=0 and equNum=" & Trim(trans.TransmitID)
        ds = search.query(QueryString)
        If ds.Tables(0).Rows.Count > 0 Then
            ResNum = ds.Tables(0).Rows.Count - 1
            For i = 0 To ResNum
                controlType = ds.Tables(0).Rows(i).Item("cmdType")
                trans.Id = ds.Tables(0).Rows(i).Item("id")
                KTsendOrReceive(trans, controlType, True)
            Next
        End If
        ds = Nothing
    End Sub
    '************************************************************************串口初始化
    Private Function InitComPort(ByVal CommPort As Integer, ByVal Settings As String) As Boolean
        If CommPort > 0 And Len(Settings) > 0 Then
            If MSComm1.PortOpen = True Then
                MSComm1.PortOpen = False
            End If
            With MSComm1
                .CommPort = CommPort
                .Handshaking = MSCommLib.HandshakeConstants.comNone
                .RThreshold = 1
                .Settings = Settings
                .SThreshold = 0
                .PortOpen = True
                .InputMode = MSCommLib.InputModeConstants.comInputModeBinary
            End With
            InitComPort = True
        End If
    End Function
    'Public Function InitComPort(ByVal Port As Integer, ByVal Settings As String, ByVal oRS232 As Rs232) As Boolean
    '    Dim SettingPara() As String
    '    If oRS232.IsOpen = True Then
    '        oRS232.Close()
    '    End If
    '    SettingPara = Send.GetDevaddrArray(Settings, ",")
    '    With oRS232
    '        .Port = Port
    '        .BaudRate = SettingPara(0)
    '        .DataBit = 8
    '        Select Case Val(SettingPara(3))
    '            Case 1
    '                .StopBit = Rs232.DataStopBit.StopBit_1
    '            Case 2
    '                .StopBit = Rs232.DataStopBit.StopBit_2
    '        End Select
    '        Select Case SettingPara(1)
    '            Case "n"
    '                .Parity = Rs232.DataParity.Parity_None
    '            Case "o"
    '                .Parity = Rs232.DataParity.Parity_Odd
    '            Case "e"
    '                .Parity = Rs232.DataParity.Parity_Even
    '        End Select
    '        .Timeout = 500
    '        '.WorkingMode = CType(Rs232.Mode.NonOverlapped, Rs232.Mode)
    '    End With
    '    oRS232.Open()
    '    InitComPort = True
    'End Function
    Private Sub SendDataLog(ByVal buf() As Byte, ByVal L As Integer)
        Dim send As String
        Dim i As Integer
        If buf Is Nothing Then Exit Sub
        send = ""
        If UBound(buf) >= 0 Then
            For i = 0 To L - 1
                send = send + CStr(IIf(Len(Hex(buf(i))) = 2, Hex(buf(i)), "0" + Hex(buf(i)))) + " "
            Next
            DataView(lsvmsg, "请求数据：" + send)
            Application.DoEvents()
        End If
    End Sub
    Private Sub ReceiveData(ByVal buf() As Byte, ByVal L As Integer)
        Dim receive As String
        Dim i As Integer
        If buf Is Nothing Then Exit Sub
        receive = ""
        If UBound(buf) >= 0 Then
            For i = 0 To L - 1
                receive = receive