shutdown.bas

星子行主机控制系统用于主机管理,方便远程操作,通信等功能.更 方便用于局域网,管理速度快,连接简单方便.注意:星子行连接可用 于带路由主机与带路由主机之间连接,非路由与非路由之间连接.带

Attribute VB_Name = "shutdown"

Option Explicit
 
Private Declare Function SetSystemPowerState Lib "kernel32" (ByVal fSuspend As Long, ByVal fForce As Long) _
       As Long
Private 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 GetCurrentProcessId 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
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation _
       As OSVERSIONINFO) As Long
         
Private Enum HowExitConst
       EWX_LOGOFF = 0
       EWX_SHUTDOWN = 1
       EWX_REBOOT = 2
       EWX_FORCE = 4
       EMX_POWEROFF = 8
End Enum
 
Private Type OSVERSIONINFO
             dwOSVersionInfoSize    As Long
             dwMajorVersion    As Long
             dwMinorVersion    As Long
             dwBuildNumber    As Long
             dwPlatformId    As Long
             szCSDVersion    As String * 128
             osName    As Integer
End Type
 
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2
Private 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
 
 
Private Sub AdjustToken()        '获取系统权限
 
On Error Resume Next
 
       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
       LookupPrivilegevalue "", "SeShutdownPrivilege", tmpLuid
       tkp.PrivilegeCount = 1
       tkp.Privileges(0).pLuid = tmpLuid
       tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
       AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewbutIgnored), tkpNewbutIgnored, lBufferNeeded
 
End Sub
 
 
Private Sub Halt()      '关机
       Dim method   As HowExitConst
       method = EWX_SHUTDOWN + EWX_FORCE + EMX_POWEROFF
       Call AdjustToken
       Call ExitWindowsEx(method, 0)
       End Sub
 
Private Sub Logon()      '注销
       Dim method   As HowExitConst
       method = EWX_LOGOFF
       Call AdjustToken
       Call ExitWindowsEx(method, 0)
       End Sub
 
Private Sub Restart()      '重启
       Dim method   As HowExitConst
       method = EWX_REBOOT
       Call AdjustToken
       Call ExitWindowsEx(method, 0)
End Sub
 
'    获得    Windows    操作系统的版本
'    OSVERSIONINFO    结构中的    osName    返回操作系统的名称
Private Function GetWindowsVersion() As OSVERSIONINFO
 
       Dim ver   As OSVERSIONINFO
 
       ver.dwOSVersionInfoSize = 148
       GetVersionEx ver
 
       With ver
               Select Case .dwPlatformId
         
               Case 1
                       Select Case .dwMinorVersion
                 
                       Case 0
                               .osName = 1    '  "Windows    95"
                                 
                       Case 10
                               .osName = 2    '  "Windows    98"
                                 
                       Case 90
                               .osName = 3    '"Windows    Mellinnium"
                                 
                       End Select
                                 
               Case 2
         
                       Select Case .dwMajorVersion
                         
                       Case 3
                               .osName = 4    '"Windows    NT    3.51"
                         
                       Case 4
                               .osName = 5    '"Windows    NT    4.0"
                         
                       Case 5
                               If .dwMinorVersion = 0 Then
                                       .osName = 6    '"Windows    2000"
                               Else
                                       .osName = 7    '"Windows    XP"
                               End If
                         
                       End Select
                                   
               End Select
       End With
 
       GetWindowsVersion = ver
 
End Function
 
Public Sub Pull_The_Plug()      '注销
 
       Dim I   As OSVERSIONINFO
 
       I = GetWindowsVersion()
 
       Select Case I.osName
               Case 1 To 3     '
                       Call ExitWindowsEx(EWX_LOGOFF, 0)
               Case 4 To 7
                       Call Logon
       End Select
         
End Sub
 
Public Sub Log_Off_Current_User()        '关机
 
       Dim I   As OSVERSIONINFO
 
       I = GetWindowsVersion()
 
       Select Case I.osName
               Case 1 To 3     '
                       Call ExitWindowsEx(EWX_SHUTDOWN + EWX_FORCE + EMX_POWEROFF, 0)
               Case 4 To 7
                       Call Halt
       End Select
 
End Sub
 
Public Sub Reboot_Computer()          '重启
 
       Dim I   As OSVERSIONINFO
 
       I = GetWindowsVersion()
 
       Select Case I.osName
               Case 1 To 3     '
                       Call ExitWindowsEx(EWX_REBOOT, 0)
               Case 4 To 7
                       Call Restart
       End Select
 
End Sub