by Ajander Singh (1 Submission)
Category: Windows API Call/Explanation
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 22nd January 2004
Date Added: Mon 8th February 2021
Rating: (1 Votes)
'This following code demostrate how to shutdown, reboot, lock workstation NT and hibernate system if supported
API Declarations
Option Explicit
'System Contants
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const TokenPrivileges = 3
Private Const ANYSIZE_ARRAY = 1
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_SHUTDOWN_NAME = "SeShutdownPrivilege"
'Shutdown constants
Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
'Platform constants
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32s = 0
'OS version data structure
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Dim typOS As OSVERSIONINFO
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
TheLuid As LUID
Attributes As Long
'Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function SetSuspendState Lib "Powrprof.dll" (ByVal Hibernate As Integer, ByVal ForceCritical As Integer, ByVal DisableWakeEvent As Integer) As Integer
Private Declare Function IsPwrHibernateAllowed Lib "Powrprof.dll" () As Integer
Private Declare Function LockWorkStation Lib "user32" () As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () 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 Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Dim hProcessHandle As Long
Dim hTokenHandle As Long
Dim tmpLuid As LUID
Dim tkp As TOKEN_PRIVILEGES
Dim tkpNewButIgnored As TOKEN_PRIVILEGES
Dim lbuffer As Long
hProcessHandle = GetCurrentProcess()
OpenProcessToken hProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hTokenHandle
LookupPrivilegeValue "", "seShutdownPrivilege", tmpLuid
With tkp
.PrivilegeCount = 1
.TheLuid = tmpLuid
.Attributes = SE_PRIVILEGE_ENABLED
End With
AdjustTokenPrivileges hTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lbuffer
End Sub
'this funstion can log off from your system
Public Sub LogOff()
Dim ans As Integer
Dim rc As Long
ans = MsgBox("Are you sure you want to LogOff", vbSystemModal + vbYesNo + vbQuestion + vbDefaultButton2, "Log Off")
If ans = vbYes Then
rc = ExitWindowsEx(EWX_LOGOFF, 0&)
End If
End Sub
'this function can rebboot your local system
Public Sub Reboot()
Dim ans As Integer
Dim rc As Long
ans = MsgBox("Hay!! You are going to reboot this system!" & vbCrLf & _
"Are You sure ? ", vbQuestion + vbYesNo + vbSystemModal + vbDefaultButton2, "System Reboot")
If ans = vbYes Then
AllowTokenShutdown
rc = ExitWindowsEx(EWX_REBOOT, 0&)
End If
End Sub
Public Sub ShutDown() ' Shut Down Your System
Dim ans As Integer
Dim rc As Long
ans = MsgBox("Hay!! You are going to Shuting Down this system!" & vbCrLf & _
"Are You sure ? ", vbQuestion + vbYesNo + vbSystemModal + vbDefaultButton2, "System ShutDown")
If ans = vbYes Then
AllowTokenShutdown
rc = ExitWindowsEx(EWX_SHUTDOWN, 0&)
End If
End Sub
Public Function LockComputer() ' Lock Computer
Dim OsWinNt As Boolean
Dim rc As Long
OsWinNt = OsVer
If OsWinNt = True Then
rc = LockWorkStation
Else
MsgBox "This is only for Windows NT Not for this OS", vbInformation + vbSystemModal, "Lock Error"
End If
End Function
Public Function Hibernate()
Dim rc As Integer
Dim ans As Integer
ans = MsgBox("Hay! You are going to Hibernate your system" & vbCrLf & "Are you sure " _
, vbQuestion + vbYesNo + vbDefaultButton2 + vbSystemModal, "Hibernate")
If ans = vbYes Then
If IsPwrHibernateAllowed <> 0 Then
rc = SetSuspendState(1, 0, 0)
Else
MsgBox "Your Computer doesn't support hibernation." & _
vbCrLf & "This may be due to system setting or simply a computer bios does not support hibernation." & _
vbCrLf & vbCrLf & " Thanks For Using It!", vbCritical + vbSystemModal, "Hibernate Error"
End If
End If
End Function
Public Function OsVer() As Boolean
typOS.dwOSVersionInfoSize = Len(typOS)
GetVersionEx typOS
OsVer = typOS.dwPlatformId = VER_PLATFORM_WIN32_NT
End Function
No comments have been posted about 'This following code demostrate how to shutdown, reboot, lock workstation NT and hibernate system i. Why not be the first to post a comment about 'This following code demostrate how to shutdown, reboot, lock workstation NT and hibernate system i.