Shut down Windows
For various reasons you may require a shut down of Windows to happen programmaticall y. For instance if the installation of your program requires system reconfiguration . The following code will do this for you with options to Reboot, etc.
[code=vb]
'Module code - modShutdown
' Shutdown Flags
Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
Const SE_PRIVILEGE_EN ABLED = &H2
Const TokenPrivileges = 3
Const TOKEN_ASSIGN_PR IMARY = &H1
Const TOKEN_DUPLICATE = &H2
Const TOKEN_IMPERSONA TE = &H4
Const TOKEN_QUERY = &H8
Const TOKEN_QUERY_SOU RCE = &H10
Const TOKEN_ADJUST_PR IVILEGES = &H20
Const TOKEN_ADJUST_GR OUPS = &H40
Const TOKEN_ADJUST_DE FAULT = &H80
Const SE_SHUTDOWN_NAM E = "SeShutdownPriv ilege"
Const ANYSIZE_ARRAY = 1
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_ATTRIB UTES
'pLuid As Luid
pLuid As LARGE_INTEGER
Attributes As Long
End Type
Private Type TOKEN_PRIVILEGE S
PrivilegeCount As Long
Privileges(ANYS IZE_ARRAY) As LUID_AND_ATTRIB UTES
End Type
Private Declare Function InitiateSystemS hutdown Lib "advapi32.d ll" Alias "InitiateSystem ShutdownA" (ByVal lpMachineName As String, ByVal lpMessage As String, ByVal dwTimeout As Long, ByVal bForceAppsClose d As Long, ByVal bRebootAfterShu tdown As Long) As Long
Private Declare Function OpenProcessToke n Lib "advapi32.d ll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function GetCurrentProce ss Lib "kernel32" () As Long
Private Declare Function LookupPrivilege Value Lib "advapi32.d ll" Alias "LookupPrivileg eValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LARGE_INTEGER) As Long
Private Declare Function AdjustTokenPriv ileges Lib "advapi32.d ll" (ByVal TokenHandle As Long, ByVal DisableAllPrivi leges As Long, NewState As TOKEN_PRIVILEGE S, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGE S, ReturnLength As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNam eA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Public Function InitiateShutdow n(ByVal Machine As String, _
Optional Force As Variant, _
Optional Restart As Variant, _
Optional AllowLocalShutd own As Variant, _
Optional Delay As Variant, _
Optional Message As Variant) As Boolean
Dim hProc As Long
Dim OldTokenStuff As TOKEN_PRIVILEGE S
Dim OldTokenStuffLe n As Long
Dim NewTokenStuff As TOKEN_PRIVILEGE S
Dim NewTokenStuffLe n As Long
Dim pSize As Long
If IsMissing(Force ) Then Force = False
If IsMissing(Resta rt) Then Restart = True
If IsMissing(Allow LocalShutdown) Then AllowLocalShutd own = False
If IsMissing(Delay ) Then Delay = 0
If IsMissing(Messa ge) Then Message = ""
'Make sure the Machine-name doesn't start with '\\'
If InStr(Machine, "\\") = 1 Then
Machine = Right(Machine, Len(Machine) - 2)
End If
'check if it's the local machine that's going to be shutdown
If (LCase(GetMachi neName) = LCase(Machine)) Then
'may we shut this computer down?
If AllowLocalShutd own = False Then Exit Function
'open access token
If OpenProcessToke n(GetCurrentPro cess(), TOKEN_ADJUST_PR IVILEGES Or TOKEN_QUERY, hProc) = 0 Then
MsgBox "OpenProcessTok en Error: " & GetLastError()
Exit Function
End If
'retrieve the locally unique identifier to represent the Shutdown-privilege name
If LookupPrivilege Value(vbNullStr ing, SE_SHUTDOWN_NAM E, OldTokenStuff.P rivileges(0).pL uid) = 0 Then
MsgBox "LookupPrivileg eValue Error: " & GetLastError()
Exit Function
End If
NewTokenStuff = OldTokenStuff
NewTokenStuff.P rivilegeCount = 1
NewTokenStuff.P rivileges(0).At tributes = SE_PRIVILEGE_EN ABLED
NewTokenStuffLe n = Len(NewTokenStu ff)
pSize = Len(NewTokenStu ff)
'Enable shutdown-privilege
If AdjustTokenPriv ileges(hProc, False, NewTokenStuff, NewTokenStuffLe n, OldTokenStuff, OldTokenStuffLe n) = 0 Then
MsgBox "AdjustTokenPri vileges Error: " & GetLastError()
Exit Function
End If
'initiate the system shutdown
If InitiateSystemS hutdown("\\" & Machine, Message, Delay, Force, Restart) = 0 Then
Exit Function
End If
NewTokenStuff.P rivileges(0).At tributes = 0
'Disable shutdown-privilege
If AdjustTokenPriv ileges(hProc, False, NewTokenStuff, Len(NewTokenStu ff), OldTokenStuff, Len(OldTokenStu ff)) = 0 Then
Exit Function
End If
Else
'initiate the system shutdown
If InitiateSystemS hutdown("\\" & Machine, Message, Delay, Force, Restart) = 0 Then
Exit Function
End If
End If
InitiateShutdow n = True
End Function
Function GetMachineName( ) As String
Dim sLen As Long
'create a buffer
GetMachineName = Space(100)
sLen = 100
'retrieve the computer name
If GetComputerName (GetMachineName , sLen) Then
GetMachineName = Left(GetMachine Name, sLen)
End If
End Function
'Form code - frmShutdown
Private Sub cmdShutdownNow_ Click()
modShutdown.Ini tiateShutdown GetMachineName, True, False, True, 60, "Message to state reason for shutdown!"
End Sub
[/code]
For various reasons you may require a shut down of Windows to happen programmaticall y. For instance if the installation of your program requires system reconfiguration . The following code will do this for you with options to Reboot, etc.
[code=vb]
'Module code - modShutdown
' Shutdown Flags
Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
Const SE_PRIVILEGE_EN ABLED = &H2
Const TokenPrivileges = 3
Const TOKEN_ASSIGN_PR IMARY = &H1
Const TOKEN_DUPLICATE = &H2
Const TOKEN_IMPERSONA TE = &H4
Const TOKEN_QUERY = &H8
Const TOKEN_QUERY_SOU RCE = &H10
Const TOKEN_ADJUST_PR IVILEGES = &H20
Const TOKEN_ADJUST_GR OUPS = &H40
Const TOKEN_ADJUST_DE FAULT = &H80
Const SE_SHUTDOWN_NAM E = "SeShutdownPriv ilege"
Const ANYSIZE_ARRAY = 1
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_ATTRIB UTES
'pLuid As Luid
pLuid As LARGE_INTEGER
Attributes As Long
End Type
Private Type TOKEN_PRIVILEGE S
PrivilegeCount As Long
Privileges(ANYS IZE_ARRAY) As LUID_AND_ATTRIB UTES
End Type
Private Declare Function InitiateSystemS hutdown Lib "advapi32.d ll" Alias "InitiateSystem ShutdownA" (ByVal lpMachineName As String, ByVal lpMessage As String, ByVal dwTimeout As Long, ByVal bForceAppsClose d As Long, ByVal bRebootAfterShu tdown As Long) As Long
Private Declare Function OpenProcessToke n Lib "advapi32.d ll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function GetCurrentProce ss Lib "kernel32" () As Long
Private Declare Function LookupPrivilege Value Lib "advapi32.d ll" Alias "LookupPrivileg eValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LARGE_INTEGER) As Long
Private Declare Function AdjustTokenPriv ileges Lib "advapi32.d ll" (ByVal TokenHandle As Long, ByVal DisableAllPrivi leges As Long, NewState As TOKEN_PRIVILEGE S, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGE S, ReturnLength As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNam eA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Public Function InitiateShutdow n(ByVal Machine As String, _
Optional Force As Variant, _
Optional Restart As Variant, _
Optional AllowLocalShutd own As Variant, _
Optional Delay As Variant, _
Optional Message As Variant) As Boolean
Dim hProc As Long
Dim OldTokenStuff As TOKEN_PRIVILEGE S
Dim OldTokenStuffLe n As Long
Dim NewTokenStuff As TOKEN_PRIVILEGE S
Dim NewTokenStuffLe n As Long
Dim pSize As Long
If IsMissing(Force ) Then Force = False
If IsMissing(Resta rt) Then Restart = True
If IsMissing(Allow LocalShutdown) Then AllowLocalShutd own = False
If IsMissing(Delay ) Then Delay = 0
If IsMissing(Messa ge) Then Message = ""
'Make sure the Machine-name doesn't start with '\\'
If InStr(Machine, "\\") = 1 Then
Machine = Right(Machine, Len(Machine) - 2)
End If
'check if it's the local machine that's going to be shutdown
If (LCase(GetMachi neName) = LCase(Machine)) Then
'may we shut this computer down?
If AllowLocalShutd own = False Then Exit Function
'open access token
If OpenProcessToke n(GetCurrentPro cess(), TOKEN_ADJUST_PR IVILEGES Or TOKEN_QUERY, hProc) = 0 Then
MsgBox "OpenProcessTok en Error: " & GetLastError()
Exit Function
End If
'retrieve the locally unique identifier to represent the Shutdown-privilege name
If LookupPrivilege Value(vbNullStr ing, SE_SHUTDOWN_NAM E, OldTokenStuff.P rivileges(0).pL uid) = 0 Then
MsgBox "LookupPrivileg eValue Error: " & GetLastError()
Exit Function
End If
NewTokenStuff = OldTokenStuff
NewTokenStuff.P rivilegeCount = 1
NewTokenStuff.P rivileges(0).At tributes = SE_PRIVILEGE_EN ABLED
NewTokenStuffLe n = Len(NewTokenStu ff)
pSize = Len(NewTokenStu ff)
'Enable shutdown-privilege
If AdjustTokenPriv ileges(hProc, False, NewTokenStuff, NewTokenStuffLe n, OldTokenStuff, OldTokenStuffLe n) = 0 Then
MsgBox "AdjustTokenPri vileges Error: " & GetLastError()
Exit Function
End If
'initiate the system shutdown
If InitiateSystemS hutdown("\\" & Machine, Message, Delay, Force, Restart) = 0 Then
Exit Function
End If
NewTokenStuff.P rivileges(0).At tributes = 0
'Disable shutdown-privilege
If AdjustTokenPriv ileges(hProc, False, NewTokenStuff, Len(NewTokenStu ff), OldTokenStuff, Len(OldTokenStu ff)) = 0 Then
Exit Function
End If
Else
'initiate the system shutdown
If InitiateSystemS hutdown("\\" & Machine, Message, Delay, Force, Restart) = 0 Then
Exit Function
End If
End If
InitiateShutdow n = True
End Function
Function GetMachineName( ) As String
Dim sLen As Long
'create a buffer
GetMachineName = Space(100)
sLen = 100
'retrieve the computer name
If GetComputerName (GetMachineName , sLen) Then
GetMachineName = Left(GetMachine Name, sLen)
End If
End Function
'Form code - frmShutdown
Private Sub cmdShutdownNow_ Click()
modShutdown.Ini tiateShutdown GetMachineName, True, False, True, 60, "Message to state reason for shutdown!"
End Sub
[/code]
Comment