Option Explicit

Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2

Const ANYSIZE_ARRAY = 1

Type LUID
  LowPart As Long
  HighPart As Long
End Type

Type LUID_AND_ATTRIBUTES
  pLuid As LUID
  Attributes As Long
End Type

Type TOKEN_PRIVILEGES
  PrivilegeCount As Long
  Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Declare Function GetCurrentProcess Lib "kernel32" () As Long
Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLUID As LUID) As Long
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

Declare Function SetSystemPowerState Lib "kernel32" (ByVal fSuspend As Long, ByVal fForce As Long) As Long

Private Sub SetShutdownPrivilege()
    Dim lpLUID        As LUID
    Dim lpToken       As TOKEN_PRIVILEGES
    Dim lpPrevToken   As TOKEN_PRIVILEGES
    Dim hToken&, r&

    r = OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken)
    r = LookupPrivilegeValue(vbNullString, "SeShutdownPrivilege", lpLUID)
   
    With lpToken
      .PrivilegeCount = 1
      .Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
      .Privileges(0).pLuid = lpLUID
    End With
   
    r = AdjustTokenPrivileges(hToken, False, lpToken, 4 + (12 * lpToken.PrivilegeCount), lpPrevToken, 4 + (12 * lpPrevToken.PrivilegeCount))
End Sub

Sub SuspendSystem()
  Call SetShutdownPrivilege
  Call SetSystemPowerState(True, False)
End Sub

Tipe LUID