frmmain.frm

获取操作系统启动权限

            Select Case bBuffer
            Case 1, 2, 3, 4
                If bNumTemp <> &HAA Then
                    '4字节同步字符不正确
                    bBuffer = 0
                    bLength = 0
                    Exit Sub
                End If
            Case 5
                '得到表格长度
                bLength = bNumTemp
                ReDim gBufData(1 To bLength)
                gBufData(1) = bLength
                If gBufData(1) >= 15 Then gBufData(1) = 3
            Case Else
                gBufData(bBuffer - 4) = bNumTemp
                If bBuffer >= bLength + 4 Then
                    Call DoOrder
                    bBuffer = 0
                    bLength = 0
                End If
            End Select
        Next i
    End Select
End Sub

Private Sub DoOrder()
    Dim i As Integer, bXor As Byte
    Dim sLog As String, FileName As String

    '除同步字符外的表格中其他字符的字节和为零
    sLog = ""
    bXor = gBufData(1)
    For i = (2) To (bLength)
        bXor = bXor Xor gBufData(i)
    Next i
    If bXor <> 0 Then
        Exit Sub
    End If
    Select Case gBufData(2)
    Case HostQueryAck       '监测部件应答主机 0xaa 0xaa 0xaa 0xaa 0x02 0x02
        sLog = Now & " 监测部件应答主机 "
        iSendNoReceiveCount = 0
        bIsConnect = True
        lstGet.AddItem sLog
        sLog = ""
    Case HostShutDownCmd    '监测部件发送给主机的关机命令  0xaa 0xaa 0xaa 0xaa 0x02 0x03
        sLog = Now & " 监测部件发送给主机的关机命令 "
        lstGet.AddItem sLog
        iSendNoReceiveCount = 0
        bIsReboot = False
        bIsActive = False
    Case RunningStatusData  '监测部件当前运行状态数据表格
    Case Else
        sLog = Now & " 数据表格不正确 "
        lstGet.AddItem sLog
    End Select
    
    Dim Fnum As Integer
    If sLog <> "" Then
        Fnum = FreeFile()
        FileName = App.Path & "\Log.txt"
        Open FileName For Append As #Fnum
        Print #Fnum, sLog
        Close #Fnum
    End If
End Sub


'lv add 060825 未和硬件狗连接的处理方式 原来不处理
Private Sub OptionBreak_Click(Index As Integer)
    If OptionBreak(0).Value = True Then
        iBreak = 0
    ElseIf OptionBreak(1).Value = True Then
        iBreak = 1
    End If
    SaveSetting App.Title, "Dog", "Break", iBreak
End Sub

Private Sub OptionRst_Click(Index As Integer)
    If OptionRst(0).Value = True Then
        bRst = False
        OptionRst(1).Value = False
        SaveSetting App.Title, "Dog", "ReStart", 0
    Else
        bRst = True
        OptionRst(0).Value = False
        SaveSetting App.Title, "Dog", "ReStart", 1
    End If
End Sub

Private Sub tmrApp_Timer()
    Dim gBuff(0 To 0) As Byte
    Dim i As Integer
    Static isTimeout As Integer
    Dim sLog As String
    Dim Fnum As Integer, FileName As String
    
    On Error Resume Next
    If bIsActive = True Then
        If chkRestart.Value = 1 Then
            Dim distance As Integer '启动间隔
            distance = updRestart.Value
            If DateDiff("d", dRestart, Now) >= distance Then
                If (distance > 0 And Hour(Time) = UpDownStart.Value) Then
                    Fnum = FreeFile()
                    FileName = App.Path & "\Log.txt"
                    Open FileName For Append As #Fnum
                    If (bRst = True) Then
                        Print #Fnum, Now & " 定时重启 "
                    Else
                        Print #Fnum, Now & " 定时关机 "
                    End If
                    Close #Fnum
                    bIsReboot = bRst 'True lv change 060309 因为没有通知硬件看门狗软件重启,可能会在软件启动时硬件看门狗又断电重启
                    bIsActive = False
                    isTimeout = 0
                    Exit Sub
                End If
            End If
        End If
        '主机查询表格
'        For i = 0 To 3
'            gBuff(i) = &HAA
'        Next i
'        gBuff(4) = 3
        gBuff(0) = HostQueryCmd
'        gBuff(6) = gBuff(4) Xor gBuff(5)
        DoEvents
        '''''
        mscWatchDog.Output = gBuff
        DoEvents
        If lstSend.ListCount >= 10 Then cmdClear.Value = True
        sLog = "主机查询表格 " & Date & " " & Time
        lstSend.AddItem sLog
        
        If (bWriteDogTimeOut = True) Then
            If (iSendNoReceiveCount > 3) Then
                Fnum = FreeFile()
                FileName = App.Path & "\Log.txt"
                sLog = Now & " :硬件狗连续3次没有应答"
                Open FileName For Append As #Fnum
                Print #Fnum, sLog
                Close #Fnum
                iSendNoReceiveCount = 0
            End If
            iSendNoReceiveCount = iSendNoReceiveCount + 1
        End If
        
'        Fnum = FreeFile()
'        FileName = App.Path & "\Log.txt"
'        Open FileName For Append As #Fnum
'        Print #Fnum, sLog
'        Close #Fnum
        
        'Dog超时计时
        Dim adTemp As ActiveDog
        For i = 1 To colDogs.Count
            Set adTemp = colDogs.Item(i)
            adTemp.iTimeOut = adTemp.iTimeOut + 1
            If adTemp.iTimeOut >= DOG_TIMEOUT Then
                adTemp.iTimeOut = 0
                If lstMsg2.ListCount >= 10 Then lstMsg2.Clear
                sLog = Now & " 标识为" & adTemp.sDogKey & ":" & adTemp.GetDogName & "的客户端断接"
                lstMsg2.AddItem sLog
                
                'If (adTemp.GetDogName <> "号牌识别软件") Then 'lv test
                    Fnum = FreeFile()
                    FileName = App.Path & "\Log.txt"
                    Open FileName For Append As #Fnum
                    Print #Fnum, sLog
                    Close #Fnum
    
                    If bIsConnect = True Then '如果和硬件狗连接就重启计算机
                        bIsReboot = bRst 'True lv change 060309 因为没有通知硬件看门狗软件重启,可能会在软件启动时硬件看门狗又断电重启
                        bIsActive = False
                        isTimeout = 0
                    Else
                        If (iBreak = 0) Then
                            bIsReboot = True
                            bIsActive = False
                            isTimeout = 0
                        End If
                    End If
                'End If
            End If
        Next i
    Else
        '退出前计时
        isTimeout = isTimeout + 1
        If isTimeout >= 6 Then
            tmrApp.Enabled = False
            Call SaveParam
            
            Fnum = FreeFile()
            FileName = App.Path & "\Log.txt"
            Open FileName For Append As #Fnum
            Print #Fnum, Now & " 关机 "
            Close #Fnum
            
            AdjustToken
            If bIsReboot = True Then
                ExitWindowsEx EWX_REBOOT, 0
            Else
                ExitWindowsEx EWX_FORCE + EWX_SHUTDOWN, 0
            End If
            Unload Me
        End If
    End If
    If lstMsg.ListCount >= 10 Then lstMsg.Clear
    'lstMsg.AddItem "客户端共：" & colDogs.Count & "个"
    TextSum.Text = colDogs.Count & "个"
End Sub

'设置外部WATCHDOG监测参数表格
Public Sub SetWatchDogArg(ByVal bWatchDogState As Byte, ByVal bMaxWatchDogCount As Byte, _
                          ByVal bAutoReStartInterval As Byte, ByVal bHostMonitorDelay As Byte, _
                          ByVal bPowerLostDelay As Byte, ByVal bHostShutDownDelay As Byte, _
                          ByVal bPowerHostDelay As Byte)
    Dim gBuff(0 To 13) As Byte
    Dim i As Integer
    
    On Error Resume Next
    If bAutoReStartInterval > 30 Then Exit Sub
    If bHostMonitorDelay < 1 Or bHostMonitorDelay > 30 Then Exit Sub
    If bPowerLostDelay < 1 Or bPowerLostDelay > 60 Then Exit Sub
    If bPowerHostDelay < 1 Or bPowerHostDelay > 60 Then Exit Sub
    
    For i = 0 To 3
        gBuff(i) = &HAA
    Next i
    gBuff(4) = 10
    gBuff(5) = SetMonitorArg
    gBuff(6) = bWatchDogState
    gBuff(7) = bMaxWatchDogCount
    gBuff(8) = bAutoReStartInterval
    gBuff(9) = bHostMonitorDelay
    gBuff(10) = bPowerLostDelay
    gBuff(11) = bHostShutDownDelay
    gBuff(12) = bPowerHostDelay
    gBuff(13) = gBuff(4)
    For i = 5 To 12
        gBuff(13) = gBuff(13) Xor gBuff(i)
    Next i
    DoEvents
    '''''
    mscWatchDog.Output = gBuff
    DoEvents
End Sub

'读取外部WATCHDOG监测参数请求
Public Sub ReadWatchDogArgRequest()
    Dim gBuff(0 To 13) As Byte
    Dim i As Integer
    
    On Error Resume Next
    For i = 0 To 3
        gBuff(i) = &HAA
    Next i
    gBuff(4) = 3
    gBuff(5) = GetMonitorArg
    gBuff(6) = gBuff(4) Xor gBuff(5)
    DoEvents
    '''''
    mscWatchDog.Output = gBuff
    DoEvents
End Sub

'读取监测部件当前运行状态请求
Public Sub ReadMonitorRunningStatusRequest()
    Dim gBuff(0 To 13) As Byte
    Dim i As Integer
    
    On Error Resume Next
    For i = 0 To 3
        gBuff(i) = &HAA
    Next i
    gBuff(4) = 3
    gBuff(5) = GetRunningStatus
    gBuff(6) = gBuff(4) Xor gBuff(5)
    DoEvents
    '''''
    mscWatchDog.Output = gBuff
    DoEvents
End Sub

Private Sub TrayMeTemp_leftBtnUp()
    Me.Show
    Me.WindowState = 0
End Sub

Private Sub TrayMeTemp_rigthBtnDown()
    PopupMenu mnuFile
End Sub

Private Sub txtComNo_Change()
    updComNo.Value = Val(txtComNo.Text)
    SaveSetting App.Title, "ComNo", "ComNo", updComNo.Value '保存串口号
End Sub

Private Sub txtComNo_KeyPress(KeyAscii As Integer)
    If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
End Sub

Private Sub txtRestartTime_Change()
    If (Val(txtRestartTime) > 0) Then
        txtStart.Enabled = True
    Else
        txtStart.Enabled = False
    End If
    updRestart.Value = Val(txtRestartTime.Text)
    SaveSetting App.Title, "Restart", "Restart", updRestart.Value
End Sub

Private Sub txtRestartTime_KeyPress(KeyAscii As Integer)
    If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
End Sub

Private Sub txtStart_Change()
    If (txtStart.Text > 23) Then
        txtStart.Text = 7
    End If
    UpDownStart.Value = Val(txtStart.Text)
    SaveSetting App.Title, "start", "start", UpDownStart.Value
End Sub

Private Sub txtStart_KeyPress(KeyAscii As Integer)
    If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
End Sub

Private Sub updComNo_Change()
    On Error GoTo E
    If mscWatchDog.PortOpen = True Then mscWatchDog.PortOpen = False
    mscWatchDog.CommPort = updComNo.Value
    mscWatchDog.PortOpen = True
    SaveSetting App.Title, "ComNo", "ComNo", updComNo.Value '保存串口号
    Me.Caption = "WatchDog 断接15分钟重启 串口打开成功！"
    Exit Sub
E:
    'MsgBox "串口无法打开！", vbCritical + vbOKOnly, "错误"
    Me.Caption = "WatchDog 断接15分钟重启 串口无法打开,可能没有此串口或被别的程序占用！"
End Sub

Private Sub UpDownStart_Change()
    SaveSetting App.Title, "start", "start", UpDownStart.Value
End Sub

Private Sub updRestart_Change()
    SaveSetting App.Title, "Restart", "Restart", updRestart.Value
End Sub

Private Sub wskChild_DataArrival(ByVal bytesTotal As Long)
    Dim gBuff() As Byte, i As Integer
    
    On Error Resume Next
    If bytesTotal <= 0 Then Exit Sub
    ReDim gBuff(0 To bytesTotal)
    wskChild.GetData gBuff, vbByte
    If UBound(gBuff) <> 4 Then Exit Sub
    For i = 0 To 3
        If gBuff(i) <> 85 Then Exit Sub
    Next i
    Select Case gBuff(4)
    Case 1  '重启命令
        gBuff(4) = 2    '应答重启命令
        wskChild.SendData gBuff
        
        bIsReboot = True
        bIsActive = False
    Case 3  '通讯命令
        gBuff(4) = 4    '应答通讯命令
        wskChild.SendData gBuff
    End Select
End Sub