modstart.bas

获取操作系统启动权限

Attribute VB_Name = "modStart"
Option Explicit
Public iBreak As Integer
Public bRst As Boolean
Public Const HostQueryCmd = 1       '主机查询监测部件
Public Const HostQueryAck = 2       '监测部件应答查询
Public Const HostShutDownCmd = 3    '主机关机命令
'以上命令通过与主机通信的RS232端口进行通信
''''''''''''''''''''''''''''''''''''''''''
'以下命令通过设置端口进行
Public Const SetMonitorArg = 4      '设置监测参数
Public Const GetMonitorArg = 5      '读取监测参数
Public Const GetRunningStatus = 16  '读取监测部件当前运行状态。
Public Const RunningStatusData = 17 '监测部件当前运行状态回送表格

Public Const DOG_TIMEOUT = 90    'Dog超时 15分钟
Private Const SW_SHOWNORMAL = 1

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal Hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal Hwnd As Long) As Long

Public colDogs As Collection
Public bIsActive As Boolean
Public bIsReboot As Boolean

Public bIsConnect As Boolean    '是否与外部狗连接
Public dRestart As Date         '程序启动时间
Public bWriteDogTimeOut As Boolean '记录硬件狗应答超时

'''''''''''''''''''''''''''''''''''''''''
'重启计算机
Enum HowExitConst
    EWX_FORCE = 4 ' 强制关机
    EWX_LOGOFF = 0 ' 登出
    EWX_REBOOT = 2 ' 重开机
    EWX_SHUTDOWN = 1 ' 关机
    EWX_POWEROFF = 8
End Enum

Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Const ANYSIZE_ARRAY = 1

Private Type LUID
    lowpart As Long
    highpart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
    pLuid As LUID
    Attributes As Long
End Type

Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long

Public Sub AdjustToken() '获得2000控制权
    Dim hdlProcessHandle As Long
    Dim hdlTokenHandle As Long
    Dim tmpLuid As LUID
    Dim tkp As TOKEN_PRIVILEGES
    Dim tkpNewButIgnored As TOKEN_PRIVILEGES
    Dim lBufferNeeded As Long
    hdlProcessHandle = GetCurrentProcess()
    OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle
    'Get the LUID for shutdown privilege.
    LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
    tkp.PrivilegeCount = 1 ' One privilege to set
    tkp.Privileges(0).pLuid = tmpLuid
    tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
    'Enable the shutdown privilege in the access token of this process.
    AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), _
    tkpNewButIgnored, lBufferNeeded
End Sub


Public Sub WiteLog(ByRef str As String)
    Dim Fnum As Integer, FileName As String
    Fnum = FreeFile()
    FileName = App.Path & "\Log.txt"
    Open FileName For Append As #Fnum
    Print #Fnum, Now & " " & str
    Close #Fnum
End Sub

Sub Main()
    Dim WinWnd As Long, s As String
    On Error Resume Next
    App.Title = ""
    s = "WatchDogServer"
    WinWnd = FindWindow(vbNullString, s)
    If WinWnd <> 0 Then
       ShowWindow WinWnd, SW_SHOWNORMAL
       SetForegroundWindow WinWnd
       End
    End If
    App.Title = s
    
    Set colDogs = New Collection
    bIsActive = True
    
    Load frmMain
End Sub