Option Explicit
Private Type LARGE_INTEGER
LowPart As Long
HighPart As Long
End Type
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(0 To 0) As LUID_AND_ATTRIBUTES
End Type
Private Declare Function GetCurrentProcess Lib "kernel32" () 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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetTokenInformation Lib "advapi32.dll" (ByVal TokenHandle As Long, TokenInformationClass As Integer, TokenInformation As Any, ByVal TokenInformationLength As Long, ReturnLength As Long) 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 LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Const SE_SHUTDOWN_NAME As String = "SeShutdownPrivilege"
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Private Const TOKEN_ASSIGN_PRIMARY = &H1
Private Const TOKEN_DUPLICATE = (&H2)
Private Const TOKEN_IMPERSONATE = (&H4)
Private Const TOKEN_QUERY = (&H8)
Private Const TOKEN_QUERY_SOURCE = (&H10)
Private Const TOKEN_ADJUST_PRIVILEGES = (&H20)
Private Const TOKEN_ADJUST_GROUPS = (&H40)
Private Const TOKEN_ADJUST_DEFAULT = (&H80)
Private Const TOKEN_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or TOKEN_ASSIGN_PRIMARY Or TOKEN_DUPLICATE Or TOKEN_IMPERSONATE Or TOKEN_QUERY Or _
TOKEN_QUERY_SOURCE Or TOKEN_ADJUST_PRIVILEGES Or TOKEN_ADJUST_GROUPS Or TOKEN_ADJUST_DEFAULT)
Private Const TOKEN_READ = (STANDARD_RIGHTS_READ Or TOKEN_QUERY)
Private Const TOKEN_WRITE = (STANDARD_RIGHTS_WRITE Or TOKEN_ADJUST_PRIVILEGES Or TOKEN_ADJUST_GROUPS Or TOKEN_ADJUST_DEFAULT)
Private Const TOKEN_EXECUTE = (STANDARD_RIGHTS_EXECUTE)
Private Const TokenDefaultDacl = 6, TokenGroups = 2
Private Const TokenImpersonationLevel = 9, TokenOwner = 4
Private Const TokenPrimaryGroup = 5, TokenPrivileges = 3
Private Const TokenSource = 7, TokenStatistics = 10
Private Const TokenType = 8, TokenUser = 1
Private Declare Function InitiateSystemShutdown Lib "advapi32.dll" Alias "InitiateSystemShutdownA" (ByVal lpMachineName As String, ByVal lpMessage As String, ByVal dwTimeout As Long, ByVal bForceAppsClosed As Long, ByVal bRebootAfterShutdown As Long) As Long
Private Declare Function AbortSystemShutdown Lib "advapi32.dll" Alias "AbortSystemShutdownA" (ByVal lpMachineName As String) As Long
'Purpose : Starts a timed remote shut down
'Inputs : sMachineNetworkName The name of the network machine. If sMachineNetworkName
' is an empty string the function shuts down the local computer
' lTimeOut The time in seconds to display the shutdown dialog. While this
' dialog box is displayed, the shutdown can be stopped by the ShutDownAbort function
' sMessageTitle The message sent to the remote machine during the shutdown
' bForceAppsToClose Specifies whether applications with unsaved changes are to be forcibly closed.
' If this parameter is TRUE, such applications are closed. If this parameter is FALSE,
' a dialog box is displayed prompting the user to close the applications
' bReboot Specifies whether the computer is to restart immediately after shutting down.
' If this parameter is TRUE, the computer is to restart. If this parameter is FALSE,
' the system flushes all caches to disk, clears the screen, and displays a message
' indicating that it is safe to power down.
'Notes : To shut down the local computer, the calling process must have the SE_SHUTDOWN_NAME privilege. To shut down a remote computer,
' the calling process must have the SE_REMOTE_SHUTDOWN_NAME privilege on the remote computer. By default, users can enable the
' SE_SHUTDOWN_NAME privilege on the computer they are logged onto, and administrators can enable the SE_REMOTE_SHUTDOWN_NAME privilege on remote computers.
Public Function ShutDownTimedBegin(sMachineNetworkName As String, Optional ByVal lTimeOut As Long = 60, Optional ByVal sMessageTitle As String = "Your Machine is going to be Shutdown", Optional ByVal bForceAppsToClose As Boolean = False, Optional ByVal bReboot As Boolean = True) As Boolean
Dim lRet As Long
On Error Resume Next
'Make sure we have enabled the privilege to shutdown
'for this process
If zEnableShutDown(sMessageTitle) = True Then
'carry out timed shutdown
lRet = InitiateSystemShutdown(sMachineNetworkName, sMessageTitle, lTimeOut, bForceAppsToClose, bReboot)
If lRet Then
'Succeeded
ShutDownTimedBegin = True
Else
'Failed
ShutDownTimedBegin = False
End If
Else
'Failed
ShutDownTimedBegin = False
End If
On Error GoTo 0
End Function
'Purpose : Aborts a shut down process
'Inputs : sMachineNetworkName The name of the network machine
Public Function ShutDownAbort(ByVal sMachineNetworkName As String) As Long
ShutDownAbort = AbortSystemShutdown(sMachineNetworkName)
End Function
Private Function zEnableShutDown(ByRef sMsg As String) As Boolean
Dim tLUID As LUID
Dim hProcess As Long
Dim hToken As Long
Dim tTP As TOKEN_PRIVILEGES, tTPOld As TOKEN_PRIVILEGES
Dim lTpOld As Long
Dim lR As Long
'Under NT we must enable the SE_SHUTDOWN_NAME privilege in the
'process we're trying to shutdown from, otherwise a call to
'try to shutdown has no effect
'Find the LUID of the Shutdown privilege token
lR = LookupPrivilegeValue(vbNullString, SE_SHUTDOWN_NAME, tLUID)
If (lR <> 0) Then
'Get the current process handle
hProcess = GetCurrentProcess
If (hProcess <> 0) Then
'Open the token for adjusting and querying (if we can - user may not have rights)
lR = OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken)
If (lR <> 0) Then
'Adjust the shutdown priviledges
With tTP
.PrivilegeCount = 1
With .Privileges(0)
.Attributes = SE_PRIVILEGE_ENABLED
.pLuid.HighPart = tLUID.HighPart
.pLuid.LowPart = tLUID.LowPart
End With
End With
'Now allow this process to shutdown the system
lR = AdjustTokenPrivileges(hToken, 0, tTP, Len(tTP), tTPOld, lTpOld)
If (lR <> 0) Then
zEnableShutDown = True
Else
'You do not have the privileges to shutdown this system
zEnableShutDown = False
End If
CloseHandle hToken
Else
'You do not have the privileges to shutdown this system
zEnableShutDown = False
End If
Else
'Can't enable shutdown (Can't determine the current process)
zEnableShutDown = False
End If
Else
'Can't enable shutdown (Can't find the SE_SHUTDOWN_NAME privilege value)
zEnableShutDown = False
End If
End Function
Reply With Quote
