Option
Explicit
Private Const EWX_LogOff As Long = 0
Private Const EWX_SHUTDOWN As Long = 1
Private Const EWX_REBOOT As Long = 2
Private Const EWX_FORCE As Long = 4
Private Const EWX_POWEROFF As Long = 8
' The ExitWindowsEx function either logs off, shuts down, or shuts
' down and restarts the system.
Private Declare Function ExitWindowsEx Lib " user32 " (ByVal dwOptions As Long , ByVal dwReserved As Long ) As Long
' The GetLastError function returns the calling thread's last-error
' code value. The last-error code is maintained on a per-thread basis.
' Multiple threads do not overwrite each other's last-error code.
Private Declare Function GetLastError Lib " kernel32 " () As Long
Private Const mlngWindows95 = 0
Private Const mlngWindowsNT = 1
Public glngWhichWindows32 As Long
' The GetVersion function returns the operating system in use.
Private Declare Function GetVersion Lib " kernel32 " () As Long
Private Type LUID
UsedPart As Long
IgnoredForNowHigh32BitPart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
TheLuid As LUID
Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
TheLuid As LUID
Attributes As Long
End Type
' The GetCurrentProcess function returns a pseudohandle for the
' current process.
Private Declare Function GetCurrentProcess Lib " kernel32 " () As Long
' The OpenProcessToken function opens the access token associated with
' a process.
Private Declare Function OpenProcessToken Lib " advapi32 " (ByVal ProcessHandle As Long , ByVal DesiredAccess As Long , TokenHandle As Long ) As Long
' The LookupPrivilegeValue function retrieves the locally unique
' identifier (LUID) used on a specified system to locally represent
' the specified privilege name.
Private Declare Function LookupPrivilegeValue Lib " advapi32 " Alias " LookupPrivilegeValueA " (ByVal lpSystemName As String , ByVal lpName As String , lpLuid As LUID) As Long
' The AdjustTokenPrivileges function enables or disables privileges
' in the specified access token. Enabling or disabling privileges
' in an access token requires TOKEN_ADJUST_PRIVILEGES access.
Private Declare Function AdjustTokenPrivileges Lib " advapi32 " (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 Sub SetLastError Lib " kernel32 " (ByVal dwErrCode As Long )
Private Sub AdjustToken()
' ********************************************************************
' * This procedure sets the proper privileges to allow a log off or a
' * shut down to occur under Windows NT.
' ********************************************************************
Const TOKEN_ADJUST_PRIVILEGES = & H20
Const TOKEN_QUERY = & H8
Const SE_PRIVILEGE_ENABLED = & H2
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
' Set the error code of the last thread to zero using the
' SetLast Error function. Do this so that the GetLastError
' function does not return a value other than zero for no
' apparent reason.
SetLastError 0
' Use the GetCurrentProcess function to set the hdlProcessHandle
' variable.
hdlProcessHandle = GetCurrentProcess()
If GetLastError <> 0 Then
MsgBox " GetCurrentProcess error== " & GetLastError
End If
OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle
If GetLastError <> 0 Then
MsgBox " OpenProcessToken error== " & GetLastError
End If
' Get the LUID for shutdown privilege
LookupPrivilegeValue "" , " SeShutdownPrivilege " , tmpLuid
If GetLastError <> 0 Then
MsgBox " LookupPrivilegeValue error== " & GetLastError
End If
tkp.PrivilegeCount = 1
' One privilege to set
tkp.TheLuid = tmpLuid
tkp.Attributes = SE_PRIVILEGE_ENABLED
' Enable the shutdown privilege in the access token of this process
AdjustTokenPrivileges hdlTokenHandle, False , tkp, Len (tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded
If GetLastError <> 0 Then
MsgBox " AdjustTokenPrivileges error== " & GetLastError
End If
End Sub
Private Sub cmdLogoff_Click()
ExitWindowsEx (EWX_LogOff), & HFFFF
MsgBox " ExitWindowsEx's GetLastError " & GetLastError
End Sub
Private Sub cmdForceLogoff_Click()
ExitWindowsEx (EWX_LogOff Or EWX_FORCE), & HFFFF
MsgBox " ExitWindowsEx's GetLastError " & GetLastError
End Sub
Private Sub cmdShutdown_Click()
If glngWhichWindows32 = mlngWindowsNT Then
AdjustToken
MsgBox " Post-AdjustToken GetLastError " & GetLastError
End If
ExitWindowsEx (EWX_SHUTDOWN), & HFFFF
MsgBox " ExitWindowsEx's GetLastError " & GetLastError
End Sub
Private Sub cmdForceShutdown_Click()
If glngWhichWindows32 = mlngWindowsNT Then
AdjustToken
MsgBox " Post-AdjustToken GetLastError " & GetLastError
End If
ExitWindowsEx (EWX_SHUTDOWN Or EWX_FORCE), & HFFFF
MsgBox " ExitWindowsEx's GetLastError " & GetLastError
End Sub
Private Sub Form_Load()
' ********************************************************************
' * When the project starts, check the operating system used by
' * calling the GetVersion function.
' ********************************************************************
Dim lngVersion As Long
lngVersion = GetVersion()
If ((lngVersion And & H80000000) = 0 ) Then
glngWhichWindows32 = mlngWindowsNT
MsgBox " Running Windows NT "
Else
glngWhichWindows32 = mlngWindows95
MsgBox " Running Windows 95 "
End If
End Sub
Private Const EWX_LogOff As Long = 0
Private Const EWX_SHUTDOWN As Long = 1
Private Const EWX_REBOOT As Long = 2
Private Const EWX_FORCE As Long = 4
Private Const EWX_POWEROFF As Long = 8
' The ExitWindowsEx function either logs off, shuts down, or shuts
' down and restarts the system.
Private Declare Function ExitWindowsEx Lib " user32 " (ByVal dwOptions As Long , ByVal dwReserved As Long ) As Long
' The GetLastError function returns the calling thread's last-error
' code value. The last-error code is maintained on a per-thread basis.
' Multiple threads do not overwrite each other's last-error code.
Private Declare Function GetLastError Lib " kernel32 " () As Long
Private Const mlngWindows95 = 0
Private Const mlngWindowsNT = 1
Public glngWhichWindows32 As Long
' The GetVersion function returns the operating system in use.
Private Declare Function GetVersion Lib " kernel32 " () As Long
Private Type LUID
UsedPart As Long
IgnoredForNowHigh32BitPart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
TheLuid As LUID
Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
TheLuid As LUID
Attributes As Long
End Type
' The GetCurrentProcess function returns a pseudohandle for the
' current process.
Private Declare Function GetCurrentProcess Lib " kernel32 " () As Long
' The OpenProcessToken function opens the access token associated with
' a process.
Private Declare Function OpenProcessToken Lib " advapi32 " (ByVal ProcessHandle As Long , ByVal DesiredAccess As Long , TokenHandle As Long ) As Long
' The LookupPrivilegeValue function retrieves the locally unique
' identifier (LUID) used on a specified system to locally represent
' the specified privilege name.
Private Declare Function LookupPrivilegeValue Lib " advapi32 " Alias " LookupPrivilegeValueA " (ByVal lpSystemName As String , ByVal lpName As String , lpLuid As LUID) As Long
' The AdjustTokenPrivileges function enables or disables privileges
' in the specified access token. Enabling or disabling privileges
' in an access token requires TOKEN_ADJUST_PRIVILEGES access.
Private Declare Function AdjustTokenPrivileges Lib " advapi32 " (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 Sub SetLastError Lib " kernel32 " (ByVal dwErrCode As Long )
Private Sub AdjustToken()
' ********************************************************************
' * This procedure sets the proper privileges to allow a log off or a
' * shut down to occur under Windows NT.
' ********************************************************************
Const TOKEN_ADJUST_PRIVILEGES = & H20
Const TOKEN_QUERY = & H8
Const SE_PRIVILEGE_ENABLED = & H2
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
' Set the error code of the last thread to zero using the
' SetLast Error function. Do this so that the GetLastError
' function does not return a value other than zero for no
' apparent reason.
SetLastError 0
' Use the GetCurrentProcess function to set the hdlProcessHandle
' variable.
hdlProcessHandle = GetCurrentProcess()
If GetLastError <> 0 Then
MsgBox " GetCurrentProcess error== " & GetLastError
End If
OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle
If GetLastError <> 0 Then
MsgBox " OpenProcessToken error== " & GetLastError
End If
' Get the LUID for shutdown privilege
LookupPrivilegeValue "" , " SeShutdownPrivilege " , tmpLuid
If GetLastError <> 0 Then
MsgBox " LookupPrivilegeValue error== " & GetLastError
End If
tkp.PrivilegeCount = 1
' One privilege to set
tkp.TheLuid = tmpLuid
tkp.Attributes = SE_PRIVILEGE_ENABLED
' Enable the shutdown privilege in the access token of this process
AdjustTokenPrivileges hdlTokenHandle, False , tkp, Len (tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded
If GetLastError <> 0 Then
MsgBox " AdjustTokenPrivileges error== " & GetLastError
End If
End Sub
Private Sub cmdLogoff_Click()
ExitWindowsEx (EWX_LogOff), & HFFFF
MsgBox " ExitWindowsEx's GetLastError " & GetLastError
End Sub
Private Sub cmdForceLogoff_Click()
ExitWindowsEx (EWX_LogOff Or EWX_FORCE), & HFFFF
MsgBox " ExitWindowsEx's GetLastError " & GetLastError
End Sub
Private Sub cmdShutdown_Click()
If glngWhichWindows32 = mlngWindowsNT Then
AdjustToken
MsgBox " Post-AdjustToken GetLastError " & GetLastError
End If
ExitWindowsEx (EWX_SHUTDOWN), & HFFFF
MsgBox " ExitWindowsEx's GetLastError " & GetLastError
End Sub
Private Sub cmdForceShutdown_Click()
If glngWhichWindows32 = mlngWindowsNT Then
AdjustToken
MsgBox " Post-AdjustToken GetLastError " & GetLastError
End If
ExitWindowsEx (EWX_SHUTDOWN Or EWX_FORCE), & HFFFF
MsgBox " ExitWindowsEx's GetLastError " & GetLastError
End Sub
Private Sub Form_Load()
' ********************************************************************
' * When the project starts, check the operating system used by
' * calling the GetVersion function.
' ********************************************************************
Dim lngVersion As Long
lngVersion = GetVersion()
If ((lngVersion And & H80000000) = 0 ) Then
glngWhichWindows32 = mlngWindowsNT
MsgBox " Running Windows NT "
Else
glngWhichWindows32 = mlngWindows95
MsgBox " Running Windows 95 "
End If
End Sub