Shut Down Computer

[Katrina]

Does anyone know how to shut down the computer through VB?

THanks,
Katrina

 

[StCyrM]

Hi Katrina

This is quite simple to do...here's the code to do it..It has been plucked form
a VB app, but it should work withing Access. Give it a try.

Private Declare Sub keybd_event Lib "USER32" (ByVal bVk As Byte, ByVal bScan As
Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const VK_CONTROL = &H11
Const KEYEVENTF_KEYUP = &H2
Const VK_ESCAPE = &H1B
Const ATTR_NORMAL = 0
Const ATTR_READONLY = 1
Const ATTR_HIDDEN = 2
Const ATTR_SYSTEM = 4
Const ATTR_VOLUME = 8
Const ATTR_DIRECTORY = 16
Const ATTR_ARCHIVE = 32


Private Sub Command5_Click()
Call keybd_event(VK_CONTROL, 0, 0, 0)
Call keybd_event(VK_ESCAPE, 0, 0, 0)
Call keybd_event(VK_ESCAPE, 0, KEYEVENTF_KEYUP, 0)
Call keybd_event(VK_CONTROL, 0, KEYEVENTF_KEYUP, 0)
End Sub

Hope this helps.

Best regards

Maurice St-Cyr
Micro Systems Consultants, Inc

 

[Guest]

Or, you could use this from mvps.org/access:

Option Compare Database
Option Explicit

'******************** Code Start **************************
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'

Private Declare Function apiExitWindowsEx Lib "user32" _
Alias "ExitWindowsEx" _
(ByVal uFlags As Long, ByVal dwReserved As Long) _
As Long

Private Declare Function apiExitWindows _
Lib "user32" _
Alias "ExitWindowsEx" _
(ByVal dwOptions As Long, _
ByVal dwReserved As Long) _
As Long

'Const for the dwOptions
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
Private Const EWX_FORCEIFHUNG As Long = 10

'Because you can't use the AdjustToken in W9x
'you must check what the system is
Private Declare Function apiGetVersion _
Lib "Kernel32.dll" _
Alias "GetVersion" _
() As Long

Private Const OS_NT = 0
Private Const OS_W9x = 1

Private Type LUID
LowPart As Long
HighPart As Long 'unused
End Type

'This one was obtained from a KB article,
'still need to understand what is going on
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
pLuid As LUID
Attributes As Long
End Type

'This is the way that this UDT is defined on the WINNT.h
'Private Const ANYSIZE_ARRAY = 1
'Type TOKEN_PRIVILEGES
' PrivilegeCount As Long
' Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
'End Type
'Private Type LUID_AND_ATTRIBUTES
' pLuid As LUID
' Attributes As Long
'End Type

'Const for the Attributes of the
TOKEN_PRIVILEGES/LUID_AND_ATTRIBUTES
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const SE_PRIVILEGE_ENABLED_BY_DEFAULT = &H1
Private Const SE_PRIVILEGE_USED_FOR_ACCESS = &H80000000

'First we need to get a processHandle to pass
'to the API that get the TokenHandle
Private Declare Function apiGetCurrentProcess _
Lib "Kernel32.dll" _
Alias "GetCurrentProcess" _
() As Long

'Get the TokenHandle
Private Declare Function apiOpenProcessToken _
Lib "advapi32.dll" _
Alias "OpenProcessToken" _
(ByVal ProcessHandle As Long, _
ByVal DesiredAccess As Long, _
TokenHandle As Long) _
As Long
'Const used in the DesiredAccess, Not from the WIN32API
but from WINNT.h
'--- const Used in some of the tokens ---
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
'--- End
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
'Required to query an access token.
Private Const TOKEN_QUERY = &H8
'Required to change the default owner, primary group, or
DACL of an access token.
Private Const TOKEN_ADJUST_DEFAULT = &H80
'Required to adjust the attributes of the groups in an
access token.
Private Const TOKEN_ADJUST_GROUPS = &H40
'Required to duplicate an access token.
Private Const TOKEN_DUPLICATE = &H2
'Required to attach an impersonation access token to a
process.
Private Const TOKEN_IMPERSONATE = &H4
'Required to query the source of an access token.
Private Const TOKEN_QUERY_SOURCE = &H10
'Don't Known what does ---Start
Private Const TOKEN_ASSIGN_PRIMARY = &H1
Private Const TOKEN_ADJUST_SESSIONID = &H100
'---End
'Combines STANDARD_RIGHTS_EXECUTE and TOKEN_IMPERSONATE.
Private Const TOKEN_EXECUTE = STANDARD_RIGHTS_EXECUTE And
TOKEN_IMPERSONATE
'Combines STANDARD_RIGHTS_READ and TOKEN_QUERY.
Private Const TOKEN_READ = STANDARD_RIGHTS_READ And
TOKEN_QUERY
'Combines STANDARD_RIGHTS_WRITE, TOKEN_ADJUST_PRIVILEGES,
TOKEN_ADJUST_GROUPS, and TOKEN_ADJUST_DEFAULT.
Private Const TOKEN_WRITE = STANDARD_RIGHTS_WRITE And
TOKEN_ADJUST_PRIVILEGES And TOKEN_ADJUST_GROUPS And
TOKEN_ADJUST_DEFAULT
'Combines all possible access rights for a token.
Private Const TOKEN_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED
And _
TOKEN_ASSIGN_PRIMARY And _
TOKEN_DUPLICATE And _
TOKEN_IMPERSONATE And _
TOKEN_QUERY And _
TOKEN_QUERY_SOURCE And _
TOKEN_ADJUST_PRIVILEGES And _
TOKEN_ADJUST_GROUPS And _
TOKEN_ADJUST_SESSIONID And _
TOKEN_ADJUST_DEFAULT

'I need this one to get the LUID for the privilege i want
to obtain
Private Declare Function apiLookupPrivilegeValue _
Lib "advapi32.dll" _
Alias "LookupPrivilegeValueA" _
(ByVal lpSystemName As String, _
ByVal lpname As String, _
lpLuid As LUID) _
As Long
'Const for the lpname
Private Const SE_SHUTDOWN_NAME = "SeShutdownPrivilege"

'This is to set the shutdown privileges to the process
Private Declare Function apiAdjustTokenPrivileges _
Lib "advapi32.dll" _
Alias "AdjustTokenPrivileges" _
(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

Sub ShutdownWindows()
Dim lngRet As Long
Dim lngOSVersion As Long

lngOSVersion = GetOS_Version()
If lngOSVersion = OS_NT Then
Debug.Print lngOSVersion & "NT"
SetPermissionToken
Else
Debug.Print lngOSVersion & "W9x"
End If
lngRet = apiExitWindowsEx(EWX_LogOff And EWX_FORCEIFHUNG,
0)

End Sub

Private Function GetOS_Version() As Byte
Dim lngVer As Long

lngVer = apiGetVersion()
If ((lngVer And &H80000000) = 0) Then
GetOS_Version = 0
Else
GetOS_Version = 1
End If

End Function

Private Sub SetPermissionToken()
Dim lngRet As Long
Dim hProcess As Long
Dim hToken As Long
Dim udtLUID_get As LUID
Dim udtTokenP_old As TOKEN_PRIVILEGES
Dim udtTokenP_new As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long

hProcess = apiGetCurrentProcess()
lngRet = apiOpenProcessToken(hProcess, _
TOKEN_ADJUST_PRIVILEGES Or
TOKEN_QUERY, _
hToken)
lngRet = apiLookupPrivilegeValue(vbNullString, _
SE_SHUTDOWN_NAME, _
udtLUID_get)
With udtTokenP_new
.PrivilegeCount = 1
.pLuid = udtLUID_get
.Attributes = SE_PRIVILEGE_ENABLED
End With
lngRet = apiAdjustTokenPrivileges(hToken, _
False, _
udtTokenP_new, _
Len(udtTokenP_old), _
udtTokenP_old, _
lBufferNeeded)
End Sub