1,486
社区成员
发帖
与我相关
我的任务
分享一个愚蠢的API调用问题----如何重起计算机。
我就想调用API实现重新启动或者关闭计算机，写了下面的代码，都不好用，不知道为什么。
Private Sub Command4_Click()
Shell "rundll32.exe user.exe,exitwindowsexec", vbHide
Shell "rundll32.exe user.exe,restartwindows"
Shell "rundll32.exe user.exe,exitwindows"
End Sub
什么原因呢？
应该怎么实现，请大虾们给些指点！谢谢！
Private Sub Command4_Click()
Shell "rundll32.exe user.exe,exitwindowsexec", vbHide
Shell "rundll32.exe user.exe,restartwindows"
Shell "rundll32.exe user.exe,exitwindows"
End Sub
什么原因呢？
应该怎么实现，请大虾们给些指点！谢谢！
...全文
请发表友善的回复…
发表回复
viena 2003-09-23
- 打赏
- 举报
//为时2天，无其他方案的话结帖
楼主哪里去了？三天了，还不结贴？
楼主哪里去了？三天了，还不结贴？
viena 2003-09-22
- 打赏
- 举报
用WMI，知道超级管理员密码，可以对远程计算机(当然包括本机)进行任何远程管理操作，包括关机。VB怎样用WMI我不会。用.NET吧，再简单不过了，好像是SYSTEM.MANAGEMENT名字空间，只要几行就够了。
hcj2002 2003-09-22
- 打赏
- 举报
在FAQ中有如何用API关闭系统的。
suntt 2003-09-20
- 打赏
- 举报
哈哈win2k关机没有办法的事
cmcx 2003-09-19
- 打赏
- 举报
嘿嘿，我也很意外！
先谢了上面几位，看kmzs的语气是有更简单的咯？！
继续等待简单解决办法，为时2天，无其他方案的话结帖。
Windows is now shuting down , Please Wait ...
先谢了上面几位，看kmzs的语气是有更简单的咯？！
继续等待简单解决办法，为时2天，无其他方案的话结帖。
Windows is now shuting down , Please Wait ...
kmzs 2003-09-10
- 打赏
- 举报
这么点事怎么写了这么长？
liul17 2003-09-10
- 打赏
- 举报
给你个简单的
Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const ANYSIZE_ARRAY = 1
Private Const VER_PLATFORM_WIN32_NT = 2 '操作系统类型( 2-NT )
Dim ret As Long
Dim Flags As Long
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long '结构的大小（148）<在正式调用函数之前，必须先将这个结构的dwOSVersionInfoSize字段设为结构的大小（148）>
dwMajorVersion As Long '主版本号
dwMinorVersion As Long '次版本号
dwBuildNumber As Long '生成号
dwPlatformId As Long '操作系统类型( 1-95/98 ; 2-NT )
szCSDVersion As String * 128 '版本号(形如'第几版')
End Type
'获取当前进程的一个伪句柄
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
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 Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
' API
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cbuttons As Long, ByVal dwExtraInfo As Long)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
' 关闭计算机
Public Sub ShutDownNT(Force As Boolean)
Dim ret As Long
Dim Flags As Long
Flags = EWX_SHUTDOWN
If Force Then Flags = Flags + EWX_FORCE
If IsWinNT Then EnableShutDown
ExitWindowsEx Flags, 0
End Sub
'重启计算机
Public Sub RebootNT(Force As Boolean)
Flags = EWX_REBOOT
If Force Then Flags = Flags + EWX_FORCE
If IsWinNT Then EnableShutDown
ExitWindowsEx Flags, 0
End Sub
'授权当前应用程序的关闭操作系统权限
Public Sub EnableShutDown()
Dim hProc As Long
Dim hToken As Long
Dim mLUID As LUID
Dim mPriv As TOKEN_PRIVILEGES
Dim mNewPriv As TOKEN_PRIVILEGES
hProc = GetCurrentProcess() '获取当前进程的一个伪句柄
OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken
LookupPrivilegeValue "", "SeShutdownPrivilege", mLUID
mPriv.PrivilegeCount = 1
mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
mPriv.Privileges(0).pLuid = mLUID
'允许当前应用程序有关闭操作系统的权限
AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount)
End Sub
Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const ANYSIZE_ARRAY = 1
Private Const VER_PLATFORM_WIN32_NT = 2 '操作系统类型( 2-NT )
Dim ret As Long
Dim Flags As Long
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long '结构的大小（148）<在正式调用函数之前，必须先将这个结构的dwOSVersionInfoSize字段设为结构的大小（148）>
dwMajorVersion As Long '主版本号
dwMinorVersion As Long '次版本号
dwBuildNumber As Long '生成号
dwPlatformId As Long '操作系统类型( 1-95/98 ; 2-NT )
szCSDVersion As String * 128 '版本号(形如'第几版')
End Type
'获取当前进程的一个伪句柄
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
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 Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
' API
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cbuttons As Long, ByVal dwExtraInfo As Long)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
' 关闭计算机
Public Sub ShutDownNT(Force As Boolean)
Dim ret As Long
Dim Flags As Long
Flags = EWX_SHUTDOWN
If Force Then Flags = Flags + EWX_FORCE
If IsWinNT Then EnableShutDown
ExitWindowsEx Flags, 0
End Sub
'重启计算机
Public Sub RebootNT(Force As Boolean)
Flags = EWX_REBOOT
If Force Then Flags = Flags + EWX_FORCE
If IsWinNT Then EnableShutDown
ExitWindowsEx Flags, 0
End Sub
'授权当前应用程序的关闭操作系统权限
Public Sub EnableShutDown()
Dim hProc As Long
Dim hToken As Long
Dim mLUID As LUID
Dim mPriv As TOKEN_PRIVILEGES
Dim mNewPriv As TOKEN_PRIVILEGES
hProc = GetCurrentProcess() '获取当前进程的一个伪句柄
OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken
LookupPrivilegeValue "", "SeShutdownPrivilege", mLUID
mPriv.PrivilegeCount = 1
mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
mPriv.Privileges(0).pLuid = mLUID
'允许当前应用程序有关闭操作系统的权限
AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount)
End Sub
holy520 2003-09-10
- 打赏
- 举报
ewx_reboot
api
api
viena 2003-09-08
- 打赏
- 举报
呵呵，其中包括注销、[强制]重启和关机。你只要复制到你的工程中直接使用就可以了。如果是win98下关机没有这么麻烦，直接调用ExitWindowsEx()就可以了，但在WIN2000下必须先取得相应的权限。
jlum99 2003-09-08
- 打赏
- 举报
上面的代码适用与2000，NT，XP，98系统就用不了了。
cmcx 2003-09-08
- 打赏
- 举报
哭了！搭眼一看就吓了一大跳。还没仔细看。
但我想问问，关个机用这么麻烦吗？
原来一句话搞不定啊？呵呵~~~
晕菜了，建两个模块？然后怎么调用啊？传个什么参数？
那个错误处理……也是只针对重起和关机的？
嘿嘿，好愚蠢的问题哈？真的不太懂，因为刚学，所以……别生气啊！
但我想问问，关个机用这么麻烦吗？
原来一句话搞不定啊？呵呵~~~
晕菜了，建两个模块？然后怎么调用啊？传个什么参数？
那个错误处理……也是只针对重起和关机的？
嘿嘿，好愚蠢的问题哈？真的不太懂，因为刚学，所以……别生气啊！
viena 2003-09-08
- 打赏
- 举报
重启Reboot False
关机Shutdown False
强制重启Reboot True
强制关机Shutdown True
强制不提示保存
关机Shutdown False
强制重启Reboot True
强制关机Shutdown True
强制不提示保存
viena 2003-09-08
- 打赏
- 举报
错误处理模块
' *********************************************
' API_ERR.BAS -- Copyright (c) Slightly Tilted Software
' By: L.J. Johnson Date: 12-01-1996
' Comments: Contains only ReturnApiErrString()
' *********************************************
Option Explicit
DefInt A-Z
' ---------------------------------------------
' Used for Event logging
' ---------------------------------------------
Private Const mconstModName = "A_Service2.modAPI_Error"
' -------------------------------------------------
' Used to get error messages directly from the
' system instead of hard-coding them
' -------------------------------------------------
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
' --------------------------------------------------------
' Status Codes
' --------------------------------------------------------
Public Const INVALID_HANDLE_VALUE = -1&
Public Const ERROR_SUCCESS = 0&
' -------------------------------------------------
' API_ERR.BAS / ReturnApiErrString
'
' Passed an API error number, return an error
' string
'
' Comments: Takes an API error number, and returns
' a descriptive text string of the error
' Inputs: xlngError is the number returned from
' the API error
' Outputs: Function returns the error string
'
' The original code appeared in Keith Pleas' article
' in VBPJ, April 1996 (OLE Expert column). Thanks,
' Keith.
' -------------------------------------------------
Public Function ReturnApiErrString(ErrorCode As Long) As String
On Error Resume Next
Dim strBuffer As String
' ----------------------------------------------
' Allocate the string, then get the system to
' tell us the error message associated with
' this error number
' ----------------------------------------------
strBuffer = String$(256, 0)
FormatMessage FORMAT_MESSAGE_FROM_SYSTEM _
Or FORMAT_MESSAGE_IGNORE_INSERTS, 0&, _
ErrorCode, 0&, strBuffer, Len(strBuffer), 0&
' ----------------------------------------------
' Strip the last null, then the last CrLf pair if
' it exists
' ----------------------------------------------
strBuffer = Left$(strBuffer, InStr(strBuffer, vbNullChar) - 1)
If Right$(strBuffer, 2) = vbCrLf Then
strBuffer = Mid$(strBuffer, 1, Len(strBuffer) - 2)
End If
' ----------------------------------------------
' Set the return value
' ----------------------------------------------
ReturnApiErrString = strBuffer
On Error GoTo 0
End Function
' *********************************************
' API_ERR.BAS -- Copyright (c) Slightly Tilted Software
' By: L.J. Johnson Date: 12-01-1996
' Comments: Contains only ReturnApiErrString()
' *********************************************
Option Explicit
DefInt A-Z
' ---------------------------------------------
' Used for Event logging
' ---------------------------------------------
Private Const mconstModName = "A_Service2.modAPI_Error"
' -------------------------------------------------
' Used to get error messages directly from the
' system instead of hard-coding them
' -------------------------------------------------
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
' --------------------------------------------------------
' Status Codes
' --------------------------------------------------------
Public Const INVALID_HANDLE_VALUE = -1&
Public Const ERROR_SUCCESS = 0&
' -------------------------------------------------
' API_ERR.BAS / ReturnApiErrString
'
' Passed an API error number, return an error
' string
'
' Comments: Takes an API error number, and returns
' a descriptive text string of the error
' Inputs: xlngError is the number returned from
' the API error
' Outputs: Function returns the error string
'
' The original code appeared in Keith Pleas' article
' in VBPJ, April 1996 (OLE Expert column). Thanks,
' Keith.
' -------------------------------------------------
Public Function ReturnApiErrString(ErrorCode As Long) As String
On Error Resume Next
Dim strBuffer As String
' ----------------------------------------------
' Allocate the string, then get the system to
' tell us the error message associated with
' this error number
' ----------------------------------------------
strBuffer = String$(256, 0)
FormatMessage FORMAT_MESSAGE_FROM_SYSTEM _
Or FORMAT_MESSAGE_IGNORE_INSERTS, 0&, _
ErrorCode, 0&, strBuffer, Len(strBuffer), 0&
' ----------------------------------------------
' Strip the last null, then the last CrLf pair if
' it exists
' ----------------------------------------------
strBuffer = Left$(strBuffer, InStr(strBuffer, vbNullChar) - 1)
If Right$(strBuffer, 2) = vbCrLf Then
strBuffer = Mid$(strBuffer, 1, Len(strBuffer) - 2)
End If
' ----------------------------------------------
' Set the return value
' ----------------------------------------------
ReturnApiErrString = strBuffer
On Error GoTo 0
End Function
viena 2003-09-08
- 打赏
- 举报
关机函数模块
Option Explicit
Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Const EWX_POWEROFF As Long = 8&
Private Const EWX_FORCE As Long = 4&
Private Const EWX_REBOOT As Long = 2&
Private Const EWX_LOGOFF As Long = 0&
Private Const EWX_SHUTDOWN As Long = 1&
Private Const ERROR_SUCCESS As Long = 0&
Private Const ERROR_NOT_ALL_ASSIGNED As Long = 1300&
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 Any, 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
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Const TOKEN_QUERY As Long = &H8&
Private Const TOKEN_ADJUST_PRIVILEGES As Long = &H20&
Private Const SE_PRIVILEGE_ENABLED As Long = &H2
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
Privileges As LUID_AND_ATTRIBUTES
End Type
Public Sub LogOff()
Dim p_lngRtn As Long
Dim p_lngFlags As Long
p_lngFlags = EWX_LOGOFF
p_lngRtn = ExitWindowsEx(p_lngFlags, 0&)
End Sub
Public Sub Reboot(ByVal xi_blnForce As Boolean)
Dim p_lngRtn As Long
Dim p_lngFlags As Long
Dim p_lngToken As Long
Dim p_lngBufLen As Long
Dim p_lngLastErr As Long
Dim p_typLUID As LUID
Dim p_typTokenPriv As TOKEN_PRIVILEGES
Dim p_typPrevTokenPriv As TOKEN_PRIVILEGES
p_lngRtn = OpenProcessToken(GetCurrentProcess(), _
TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, _
p_lngToken)
If p_lngRtn = 0 Then
' Failed
Debug.Print ReturnApiErrString(Err.LastDllError)
Exit Sub
End If
p_lngRtn = LookupPrivilegeValue(0&, "SeShutdownPrivilege", p_typLUID)
If p_lngRtn = 0 Then
' Failed
Debug.Print ReturnApiErrString(Err.LastDllError)
Exit Sub
End If
p_typTokenPriv.PrivilegeCount = 1
p_typTokenPriv.Privileges.Attributes = SE_PRIVILEGE_ENABLED
p_typTokenPriv.Privileges.pLuid = p_typLUID
p_lngRtn = AdjustTokenPrivileges(p_lngToken, False, _
p_typTokenPriv, Len(p_typPrevTokenPriv), _
p_typPrevTokenPriv, p_lngBufLen)
If p_lngRtn = 0 Then
' Failed
Debug.Print Err.LastDllError, ReturnApiErrString(Err.LastDllError)
Exit Sub
Else
p_lngLastErr = Err.LastDllError
If p_lngLastErr = ERROR_SUCCESS Then
' Everything is OK
ElseIf p_lngLastErr = ERROR_NOT_ALL_ASSIGNED Then
Debug.Print "Not all privileges assigned."
Else
Debug.Print p_lngLastErr, ReturnApiErrString(p_lngLastErr)
End If
End If
If xi_blnForce = False Then
p_lngFlags = EWX_REBOOT
Else
p_lngFlags = EWX_REBOOT Or EWX_FORCE
End If
p_lngRtn = ExitWindowsEx(p_lngFlags, 0&)
End Sub
Public Sub Shutdown(ByVal xi_blnForce As Boolean)
Dim p_lngRtn As Long
Dim p_lngFlags As Long
Dim p_lngToken As Long
Dim p_lngBufLen As Long
Dim p_lngLastErr As Long
Dim p_typLUID As LUID
Dim p_typTokenPriv As TOKEN_PRIVILEGES
Dim p_typPrevTokenPriv As TOKEN_PRIVILEGES
p_lngRtn = OpenProcessToken(GetCurrentProcess(), _
TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, _
p_lngToken)
If p_lngRtn = 0 Then
' Failed
Debug.Print ReturnApiErrString(Err.LastDllError)
Exit Sub
End If
p_lngRtn = LookupPrivilegeValue(0&, "SeShutdownPrivilege", p_typLUID)
If p_lngRtn = 0 Then
' Failed
Debug.Print ReturnApiErrString(Err.LastDllError)
Exit Sub
End If
p_typTokenPriv.PrivilegeCount = 1
p_typTokenPriv.Privileges.Attributes = SE_PRIVILEGE_ENABLED
p_typTokenPriv.Privileges.pLuid = p_typLUID
p_lngRtn = AdjustTokenPrivileges(p_lngToken, False, _
p_typTokenPriv, Len(p_typPrevTokenPriv), _
p_typPrevTokenPriv, p_lngBufLen)
If p_lngRtn = 0 Then
' Failed
Debug.Print Err.LastDllError, ReturnApiErrString(Err.LastDllError)
Exit Sub
Else
p_lngLastErr = Err.LastDllError
If p_lngLastErr = ERROR_SUCCESS Then
' Everything is OK
ElseIf p_lngLastErr = ERROR_NOT_ALL_ASSIGNED Then
Debug.Print "Not all privileges assigned."
Else
Debug.Print p_lngLastErr, ReturnApiErrString(p_lngLastErr)
End If
End If
If xi_blnForce = False Then
p_lngFlags = EWX_SHUTDOWN Or EWX_POWEROFF
Else
p_lngFlags = EWX_SHUTDOWN Or EWX_POWEROFF Or EWX_FORCE
End If
p_lngRtn = ExitWindowsEx(p_lngFlags, 0&)
End Sub
Option Explicit
Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Const EWX_POWEROFF As Long = 8&
Private Const EWX_FORCE As Long = 4&
Private Const EWX_REBOOT As Long = 2&
Private Const EWX_LOGOFF As Long = 0&
Private Const EWX_SHUTDOWN As Long = 1&
Private Const ERROR_SUCCESS As Long = 0&
Private Const ERROR_NOT_ALL_ASSIGNED As Long = 1300&
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 Any, 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
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Const TOKEN_QUERY As Long = &H8&
Private Const TOKEN_ADJUST_PRIVILEGES As Long = &H20&
Private Const SE_PRIVILEGE_ENABLED As Long = &H2
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
Privileges As LUID_AND_ATTRIBUTES
End Type
Public Sub LogOff()
Dim p_lngRtn As Long
Dim p_lngFlags As Long
p_lngFlags = EWX_LOGOFF
p_lngRtn = ExitWindowsEx(p_lngFlags, 0&)
End Sub
Public Sub Reboot(ByVal xi_blnForce As Boolean)
Dim p_lngRtn As Long
Dim p_lngFlags As Long
Dim p_lngToken As Long
Dim p_lngBufLen As Long
Dim p_lngLastErr As Long
Dim p_typLUID As LUID
Dim p_typTokenPriv As TOKEN_PRIVILEGES
Dim p_typPrevTokenPriv As TOKEN_PRIVILEGES
p_lngRtn = OpenProcessToken(GetCurrentProcess(), _
TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, _
p_lngToken)
If p_lngRtn = 0 Then
' Failed
Debug.Print ReturnApiErrString(Err.LastDllError)
Exit Sub
End If
p_lngRtn = LookupPrivilegeValue(0&, "SeShutdownPrivilege", p_typLUID)
If p_lngRtn = 0 Then
' Failed
Debug.Print ReturnApiErrString(Err.LastDllError)
Exit Sub
End If
p_typTokenPriv.PrivilegeCount = 1
p_typTokenPriv.Privileges.Attributes = SE_PRIVILEGE_ENABLED
p_typTokenPriv.Privileges.pLuid = p_typLUID
p_lngRtn = AdjustTokenPrivileges(p_lngToken, False, _
p_typTokenPriv, Len(p_typPrevTokenPriv), _
p_typPrevTokenPriv, p_lngBufLen)
If p_lngRtn = 0 Then
' Failed
Debug.Print Err.LastDllError, ReturnApiErrString(Err.LastDllError)
Exit Sub
Else
p_lngLastErr = Err.LastDllError
If p_lngLastErr = ERROR_SUCCESS Then
' Everything is OK
ElseIf p_lngLastErr = ERROR_NOT_ALL_ASSIGNED Then
Debug.Print "Not all privileges assigned."
Else
Debug.Print p_lngLastErr, ReturnApiErrString(p_lngLastErr)
End If
End If
If xi_blnForce = False Then
p_lngFlags = EWX_REBOOT
Else
p_lngFlags = EWX_REBOOT Or EWX_FORCE
End If
p_lngRtn = ExitWindowsEx(p_lngFlags, 0&)
End Sub
Public Sub Shutdown(ByVal xi_blnForce As Boolean)
Dim p_lngRtn As Long
Dim p_lngFlags As Long
Dim p_lngToken As Long
Dim p_lngBufLen As Long
Dim p_lngLastErr As Long
Dim p_typLUID As LUID
Dim p_typTokenPriv As TOKEN_PRIVILEGES
Dim p_typPrevTokenPriv As TOKEN_PRIVILEGES
p_lngRtn = OpenProcessToken(GetCurrentProcess(), _
TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, _
p_lngToken)
If p_lngRtn = 0 Then
' Failed
Debug.Print ReturnApiErrString(Err.LastDllError)
Exit Sub
End If
p_lngRtn = LookupPrivilegeValue(0&, "SeShutdownPrivilege", p_typLUID)
If p_lngRtn = 0 Then
' Failed
Debug.Print ReturnApiErrString(Err.LastDllError)
Exit Sub
End If
p_typTokenPriv.PrivilegeCount = 1
p_typTokenPriv.Privileges.Attributes = SE_PRIVILEGE_ENABLED
p_typTokenPriv.Privileges.pLuid = p_typLUID
p_lngRtn = AdjustTokenPrivileges(p_lngToken, False, _
p_typTokenPriv, Len(p_typPrevTokenPriv), _
p_typPrevTokenPriv, p_lngBufLen)
If p_lngRtn = 0 Then
' Failed
Debug.Print Err.LastDllError, ReturnApiErrString(Err.LastDllError)
Exit Sub
Else
p_lngLastErr = Err.LastDllError
If p_lngLastErr = ERROR_SUCCESS Then
' Everything is OK
ElseIf p_lngLastErr = ERROR_NOT_ALL_ASSIGNED Then
Debug.Print "Not all privileges assigned."
Else
Debug.Print p_lngLastErr, ReturnApiErrString(p_lngLastErr)
End If
End If
If xi_blnForce = False Then
p_lngFlags = EWX_SHUTDOWN Or EWX_POWEROFF
Else
p_lngFlags = EWX_SHUTDOWN Or EWX_POWEROFF Or EWX_FORCE
End If
p_lngRtn = ExitWindowsEx(p_lngFlags, 0&)
End Sub
