VB Code:
  1. Private Const EWX_LogOff As Long = 0
  2.     Private Const EWX_SHUTDOWN As Long = 1
  3.     Private Const EWX_REBOOT As Long = 2
  4.     Private Const EWX_FORCE As Long = 4
  5.     Private Const EWX_POWEROFF As Long = 8
  6.  
  7. 'The ExitWindowsEx function either logs off, shuts down, or shuts
  8. 'down and restarts the system.
  9.  
  10. Private Declare Function ExitWindowsEx Lib "user32" _
  11.     (ByVal dwOptions As Long, _
  12.     ByVal dwReserved As Long) As Long
  13.  
  14. 'The GetLastError function returns the calling thread's last-error
  15. 'code value. The last-error code is maintained on a per-thread basis.
  16. 'Multiple threads do not overwrite each other's last-error code.
  17. Private Declare Function GetLastError Lib "kernel32" () As Long
  18.  
  19. Private Const mlngWindows95 = 0
  20. Private Const mlngWindowsNT = 1
  21. Public glngWhichWindows32 As Long
  22. 'The GetVersion function returns the operating system in use.
  23. Private Declare Function GetVersion Lib "kernel32" () As Long
  24.  
  25. Private Type LUID
  26.     UsedPart As Long
  27.     IgnoredForNowHigh32BitPart As Long
  28. End Type
  29.  
  30. Private Type LUID_AND_ATTRIBUTES
  31.     TheLuid As LUID
  32.     Attributes As Long
  33. End Type
  34. Private Type TOKEN_PRIVILEGES
  35.     PrivilegeCount As Long
  36.     TheLuid As LUID
  37.     Attributes As Long
  38. End Type
  39. 'The GetCurrentProcess function returns a pseudohandle for the
  40. 'current process.
  41. Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
  42. 'The OpenProcessToken function opens the access token associated with
  43. 'a process.
  44. Private Declare Function OpenProcessToken Lib "advapi32" _
  45.     (ByVal ProcessHandle As Long, _
  46.     ByVal DesiredAccess As Long, _
  47.     TokenHandle As Long) As Long
  48. 'The LookupPrivilegeValue function retrieves the locally unique
  49. 'identifier (LUID) used on a specified system to locally represent
  50. 'the specified privilege name.
  51. Private Declare Function LookupPrivilegeValue Lib "advapi32" _
  52.     Alias "LookupPrivilegeValueA" _
  53.     (ByVal lpSystemName As String, _
  54.     ByVal lpName As String, _
  55.     lpLuid As LUID) As Long
  56. 'The AdjustTokenPrivileges function enables or disables privileges
  57. 'in the specified access token. Enabling or disabling privileges
  58. 'in an access token requires TOKEN_ADJUST_PRIVILEGES access.
  59. Private Declare Function AdjustTokenPrivileges Lib "advapi32" _
  60.     (ByVal TokenHandle As Long, _
  61.     ByVal DisableAllPrivileges As Long, _
  62.     NewState As TOKEN_PRIVILEGES, _
  63.     ByVal BufferLength As Long, _
  64.     PreviousState As TOKEN_PRIVILEGES, _
  65.     ReturnLength As Long) As Long
  66.     Private Declare Sub SetLastError Lib "kernel32" _
  67.     (ByVal dwErrCode As Long)
  68. Private Sub AdjustToken()
  69. '********************************************************************
  70. '* This procedure sets the proper privileges to allow a log off or a
  71. '* shut down to occur under Windows NT.
  72. '********************************************************************
  73. Const TOKEN_ADJUST_PRIVILEGES = &H20
  74. Const TOKEN_QUERY = &H8
  75. Const SE_PRIVILEGE_ENABLED = &H2
  76. Dim hdlProcessHandle As Long
  77. Dim hdlTokenHandle As Long
  78. Dim tmpLuid As LUID
  79. Dim tkp As TOKEN_PRIVILEGES
  80. Dim tkpNewButIgnored As TOKEN_PRIVILEGES
  81. Dim lBufferNeeded As Long
  82. 'Set the error code of the last thread to zero using the
  83. 'SetLast Error function. Do this so that the GetLastError
  84. 'function does not return a value other than zero for no
  85. 'apparent reason.
  86.     SetLastError 0
  87. 'Use the GetCurrentProcess function to set the hdlProcessHandle
  88. 'variable.
  89.     hdlProcessHandle = GetCurrentProcess()
  90.     If GetLastError <> 0 Then
  91.         systemMessage.AddItem "GetCurrentProcess Error==" & GetLastError
  92.     End If
  93.     OpenProcessToken hdlProcessHandle, _
  94.         (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle
  95.     If GetLastError <> 0 Then
  96.         systemMessage.AddItem "OpenProcessToken Error==" & GetLastError
  97.     End If
  98. 'Get the LUID for shutdown privilege
  99.     LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
  100.     If GetLastError <> 0 Then
  101.         systemMessage.AddItem "LookupPrivilegeValue Error==" & GetLastError
  102.     End If
  103.     tkp.PrivilegeCount = 1    ' One privilege to set
  104.     tkp.TheLuid = tmpLuid
  105.     tkp.Attributes = SE_PRIVILEGE_ENABLED
  106. 'Enable the shutdown privilege in the access token of this process
  107.     AdjustTokenPrivileges hdlTokenHandle, _
  108.     False, _
  109.     tkp, _
  110.     Len(tkpNewButIgnored), _
  111.     tkpNewButIgnored, _
  112.     lBufferNeeded
  113.     If GetLastError <> 0 Then
  114.         systemMessage.AddItem "AdjustTokenPrivileges Error==" & GetLastError
  115.     End If
  116. End Sub
  117. Private Sub cmdLogoff_Click()
  118.     ExitWindowsEx (EWX_LogOff), &HFFFF
  119.     systemMessage.AddItem "ExitWindowsEx's GetLastError " & GetLastError
  120. End Sub
  121. Private Sub cmdForceLogoff_Click()
  122.     ExitWindowsEx (EWX_LogOff Or EWX_FORCE), &HFFFF
  123.     systemMessage.AddItem "ExitWindowsEx's GetLastError " & GetLastError
  124. End Sub
  125. Private Sub cmdShutdown_Click()
  126.     If glngWhichWindows32 = mlngWindowsNT Then
  127.         AdjustToken
  128.         systemMessage.AddItem "Post-AdjustToken GetLastError " & GetLastError
  129.     End If
  130.     ExitWindowsEx (EWX_SHUTDOWN), &HFFFF
  131.     systemMessage.AddItem "ExitWindowsEx's GetLastError " & GetLastError
  132. End Sub
  133. Private Sub cmdForceShutdown_Click()
  134.     If glngWhichWindows32 = mlngWindowsNT Then
  135.         AdjustToken
  136.         systemMessage.AddItem "Post-AdjustToken GetLastError " & GetLastError
  137.     End If
  138.     ExitWindowsEx (EWX_SHUTDOWN Or EWX_FORCE), &HFFFF
  139.     systemMessage.AddItem "ExitWindowsEx's GetLastError " & GetLastError
  140. End Sub
  141. Private Sub exit_Click()
  142.     End
  143. End Sub
  144. Private Sub Form_Load()
  145. '********************************************************************
  146. '* When the project starts, check the operating system used by
  147. '* calling the GetVersion function.
  148. '********************************************************************
  149. Dim lngVersion As Long
  150.     lngVersion = GetVersion()
  151.     If ((lngVersion And &H80000000) = 0) Then
  152.         glngWhichWindows32 = mlngWindowsNT
  153.         systemType.Text = "Windows NT"
  154.     Else
  155.         glngWhichWindows32 = mlngWindows95
  156.         systemType.Text = "Windows 95"
  157.     End If
  158. End Sub