frmmain.frm

获取操作系统启动权限

         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   9240
      TabIndex        =   42
      Top             =   360
      Visible         =   0   'False
      Width           =   1395
   End
   Begin VB.Label Label18 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   0
      TabIndex        =   56
      Top             =   0
      Width           =   255
   End
   Begin VB.Label Label14 
      AutoSize        =   -1  'True
      Caption         =   "通讯端口"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   180
      Left            =   9180
      TabIndex        =   55
      Top             =   120
      Visible         =   0   'False
      Width           =   720
   End
   Begin VB.Label Label16 
      Caption         =   "客户端断接信息："
      Height          =   255
      Left            =   5280
      TabIndex        =   49
      Top             =   4320
      Width           =   4455
   End
   Begin VB.Label Label15 
      Caption         =   "客户端时实信息："
      Height          =   255
      Left            =   120
      TabIndex        =   48
      Top             =   4320
      Width           =   3615
   End
   Begin VB.Menu mnuFile 
      Caption         =   "菜单"
      Visible         =   0   'False
      Begin VB.Menu mnuShow 
         Caption         =   "显示主界面"
      End
      Begin VB.Menu mnuSep 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退出"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'开机
'定时重启
'关机
'退出程序

'监测部件发送给主机的关机命令
'数据表格不正确
'客户端断接

Dim bBuffer As Byte, bLength As Byte, gBufData() As Byte    '缓冲区大小，表格长度，缓冲区数据
Dim WithEvents TrayMeTemp As TrayMe
Attribute TrayMeTemp.VB_VarHelpID = -1
Dim iSendNoReceiveCount As Integer '发送但没有收到应答

Private Sub Check2_Click()
    tmrApp.Enabled = Check2.Value
    If tmrApp.Enabled = True Then Call tmrApp_Timer
End Sub

Private Sub Checkdog_Click()
    If Checkdog.Value = 0 Then
        bWriteDogTimeOut = False
        SaveSetting App.Title, "Dog", "WriteDogTimeOut", 0
    ElseIf Checkdog.Value = 1 Then
        SaveSetting App.Title, "Dog", "WriteDogTimeOut", 1
        bWriteDogTimeOut = True
    End If
End Sub

Private Sub chkRestart_Click()
    If chkRestart.Value = 0 Then
        txtRestartTime.Enabled = False
        updRestart.Enabled = False
        txtStart.Enabled = False
        UpDownStart.Enabled = False
        
        SaveSetting App.Title, "Restart", "Restart", -1
    ElseIf chkRestart.Value = 1 Then
        txtRestartTime.Enabled = True
        updRestart.Enabled = True
        If (updRestart.Value > 0) Then
            txtStart.Enabled = True
            UpDownStart.Enabled = True
        End If
        
        SaveSetting App.Title, "Restart", "Restart", updRestart.Value
    End If
End Sub

Private Sub cmdExitClient_Click()
    bIsActive = Not bIsActive
    If bIsActive = True Then
        cmdExitClient.Caption = "退出所有用户"
    Else
        cmdExitClient.Caption = "不退出所有用户"
    End If
End Sub

Private Sub cmdlog_Click()
    Dim FileName As String, FileNametmp As String
    FileName = App.Path & "\Log.txt"
    FileNametmp = App.Path & "\Logtmp.txt"
    FileCopy FileName, FileNametmp
    Shell "notepad.exe " & FileNametmp, vbMaximizedFocus
End Sub

Private Sub Cmdtest_Click()
    bIsReboot = True
    bIsActive = False
End Sub

Private Sub Combo1_Click()
    On Error Resume Next
    If mscWatchDog.PortOpen = True Then mscWatchDog.PortOpen = False
    mscWatchDog.Settings = Trim(Combo1.Text)
    If mscWatchDog.PortOpen = False Then mscWatchDog.PortOpen = True
End Sub

Private Sub Command1_Click()
    Call SetWatchDogArg(Abs(Check1.Value), UpDown1.Value, UpDown2.Value, _
                        UpDown5.Value, UpDown3.Value, UpDown4.Value, UpDown6.Value)
    lstSend.AddItem "设置外部WATCHDOG监测参数表格"
End Sub

Private Sub Command2_Click()
    Call ReadMonitorRunningStatusRequest
    lstSend.AddItem "读取监测部件当前运行状态请求"
End Sub

Private Sub Command3_Click()
    Call ReadMonitorRunningStatusRequest
    lstSend.AddItem "读取监测部件当前运行状态请求"
End Sub

Private Sub Command4_Click()
    Call tmrApp_Timer
End Sub

Private Function GetNumber(ByVal s As String) As Byte
    Select Case s
    Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
        GetNumber = CInt(s)
    Case "A"
        GetNumber = 10
    Case "B"
        GetNumber = 11
    Case "C"
        GetNumber = 12
    Case "D"
        GetNumber = 13
    Case "E"
        GetNumber = 14
    Case "F"
        GetNumber = 15
    Case Else
        GetNumber = 0
    End Select
End Function

Private Sub Command5_Click()
    Dim gBuff(1 To 1) As Byte
    Dim s As String
    On Error Resume Next
    s = Right(UCase(Trim(Text7.Text)), 2)
    If Len(s) = 1 Then
        gBuff(1) = GetNumber(s)
    Else
        gBuff(1) = GetNumber(Left(s, 1)) * 16 + GetNumber(Right(s, 1))
    End If
    DoEvents
    '''''
    mscWatchDog.Output = gBuff
    DoEvents
    lstSend.AddItem "单字节发送"
    Text7.SetFocus
End Sub

Private Sub cmdClear_Click()
    lstSend.Clear
    lstGet.Clear
    lstSend.AddItem "向硬件狗发送表格:"
    lstGet.AddItem "从硬件狗收到表格:"
End Sub

Private Sub Form_Load()
    Dim iComNo As Integer, iRestart As Integer, iLocalPort As Integer, itmp As Integer
    On Error Resume Next
    itmp = Val(GetSetting(App.Title, "Dog", "Break", 0))
    If (itmp < 0 Or itmp > 1) Then
        itmp = 0
    End If
    iBreak = itmp
    OptionBreak(iBreak).Value = True
    
    itmp = Val(GetSetting(App.Title, "Dog", "WriteDogTimeOut", 1))
    If (itmp = 0) Then
        bWriteDogTimeOut = False
        Checkdog.Value = 0
    Else
        bWriteDogTimeOut = True
        Checkdog.Value = 1
    End If
    
    itmp = Val(GetSetting(App.Title, "Dog", "ReStart", 1))
    If (itmp = 0) Then
        bRst = False
        OptionRst(0).Value = True
        OptionRst(1).Value = False
    Else
        bRst = True
        OptionRst(0).Value = False
        OptionRst(1).Value = True
    End If
    
    iSendNoReceiveCount = 0
    iComNo = Val(GetSetting(App.Title, "ComNo", "ComNo", 2))    '从注册表得到串口号
    updComNo.Value = iComNo
    iRestart = Val(GetSetting(App.Title, "Restart", "Restart", -1))  '从注册表得到重启时间
    If iRestart <> -1 Then
        chkRestart.Value = 1
        updRestart.Value = iRestart
    End If
    
    'lv add 041122
    Dim iStart As Integer
    iStart = Val(GetSetting(App.Title, "Start", "Start", 7))    '从注册表得到重启时间
    If iStart <> -1 Then
        UpDownStart.Value = iStart
    End If
    
    iLocalPort = Val(GetSetting(App.Title, "LocalPort", "LocalPort", 1111)) '从注册表得到网络端口
    wskChild.LocalPort = iLocalPort
    wskChild.Bind iLocalPort
    
    dRestart = Now
    
    Call cmdClear_Click
    tmrApp.Enabled = True
    Call tmrApp_Timer
    lstMsg.Clear
    lstMsg2.Clear
    
    '添加托盘
    Set TrayMeTemp = New TrayMe
    TrayMeTemp.ShowToolTip = "WatchDog"
    TrayMeTemp.Icon = Me.Icon
    TrayMeTemp.Show
    
    Dim Fnum As Integer, sLog As String, FileName As String
    sLog = Now & " 开机"
    Fnum = FreeFile()
    FileName = App.Path & "\Log.txt"
    Open FileName For Append As #Fnum
    Print #Fnum, sLog
    Close #Fnum
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode = 0 Then
        Me.Hide
        Me.WindowState = 0
        Cancel = True
    End If
End Sub

Private Sub Form_Resize()
    If Me.WindowState = 1 Then
        Me.Hide
        Me.WindowState = 0
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call SaveParam
    
    Dim Fnum As Integer, sLog As String, FileName As String
    sLog = Now & " 退出程序"
    Fnum = FreeFile()
    FileName = App.Path & "\Log.txt"
    Open FileName For Append As #Fnum
    Print #Fnum, sLog
    Close #Fnum
    
    End
End Sub

Private Sub SaveParam()
    On Error Resume Next
    If mscWatchDog.PortOpen = True Then mscWatchDog.PortOpen = False
    
    TrayMeTemp.Hide
    Set TrayMeTemp = Nothing
    
'    SaveSetting App.Title, "ComNo", "ComNo", updComNo.Value '保存串口号
'    If chkRestart.Value = 1 Then
'        SaveSetting App.Title, "Restart", "Restart", updRestart.Value
'    Else
'        SaveSetting App.Title, "Restart", "Restart", -1
'    End If
End Sub

Private Sub Label18_DblClick()
    cmdExitClient.Visible = Not cmdExitClient.Visible
    Text8.Visible = Not Text8.Visible
    Label14.Visible = Not Label14.Visible
    Cmdtest.Visible = Not Cmdtest.Visible
End Sub

Private Sub mnuExit_Click()
    Dialog.Show 1
    If Dialog.bCancel = False Then
        If Dialog.bExit = True Then
            tmrApp.Enabled = False
            Call SaveParam
            AdjustToken
            ExitWindowsEx EWX_FORCE + EWX_SHUTDOWN, 0
        End If
        Unload Me
    End If
End Sub

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

Private Sub mscWatchDog_OnComm()
    Dim gBuff() As Byte, bNumTemp As Byte
    Dim i As Integer
    
    On Error Resume Next
    Select Case mscWatchDog.CommEvent
    Case comEvReceive
        If mscWatchDog.InBufferCount < 1 Then Exit Sub
        gBuff = mscWatchDog.Input
        Dim s As String
        For i = LBound(gBuff) To UBound(gBuff)
            s = s & " " & Hex(gBuff(i))
            bBuffer = bBuffer + 1
            bNumTemp = gBuff(i)