Windows2000/WindowsXP下编程(VB)实现关机

于 2006-07-27 23:58:00 发布
阅读量1.1k 收藏
点赞数
文章标签： vb windows 编程 token attributes function

1。Shell下也可用如下命令实现：Rundll32.exe user.exe,exitwindows

2。VB代码实现：

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


 

/' *******************************************************
/' Routine Name : (PUBLIC in MODULE) Function ReturnApiErrString
/' Written By   : L.J. Johnson
/' Programmer   : L.J. Johnson [Slightly Tilted Software]
/' Date Writen  : 01/16/1999 -- 12:56:46
/' Inputs       : ErrorCode:Long - Number returned from API error
/' Outputs      : N/A
/' Description  : 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                   /' Don/'t accept an error here
   Dim p_strBuffer                     As String
   Dim p_lngHwndModule                 As Long
   Dim p_lngFlags                      As Long
  
   /' ------------------------------------------
   /' Separate handling for network errors
   /' netmsg.dll
   /' ------------------------------------------
   If ErrorCode >= NERR_BASE And _
      ErrorCode <= MAX_NERR Then
      
      p_lngHwndModule = LoadLibraryEx(lpLibFileName:="netmsg.dll", _
                        hFile:=0&, _
                        dwFlags:=LOAD_LIBRARY_AS_DATAFILE)
      
      If p_lngHwndModule <> 0 Then
      
         p_lngFlags = FORMAT_MESSAGE_FROM_SYSTEM Or _
                      FORMAT_MESSAGE_IGNORE_INSERTS Or _
                      FORMAT_MESSAGE_FROM_HMODULE
                      
         /' ------------------------------------
         /' Allocate the string, then get the
         /'     system to tell us the error
         /'     message associated with this error number
         /' ------------------------------------
         p_strBuffer = String(256, 0)
         FormatMessage dwFlags:=p_lngFlags, _
                       lpSource:=ByVal p_lngHwndModule, _
                       dwMessageId:=ErrorCode, _
                       dwLanguageId:=0&, _
                       lpBuffer:=p_strBuffer, _
                       nSize:=Len(p_strBuffer), _
                       Arguments:=ByVal 0&
      
         /' ------------------------------------
         /' Strip the last null, then the last
         /'     CrLf pair if it exists
         /' ------------------------------------
         p_strBuffer = Left(p_strBuffer, InStr(p_strBuffer, vbNullChar) - 1)
         If Right$(p_strBuffer, 2) = Chr$(13) & Chr$(10) Then
            p_strBuffer = Mid$(p_strBuffer, 1, Len(p_strBuffer) - 2)
         End If
        
         FreeLibrary hLibModule:=p_lngHwndModule
      End If
  
   /' ------------------------------------------
   /' Separate handling for Wininet error
   /' Wininet.dll
   /' ------------------------------------------
   ElseIf ErrorCode >= INTERNET_ERROR_BASE And _
      ErrorCode <= INTERNET_ERROR_LAST Then
      
      /' ---------------------------------------
      /' Load the library
      /' ---------------------------------------
      p_lngHwndModule = LoadLibraryEx(lpLibFileName:="Wininet.dll", _
                        hFile:=0&, _
                        dwFlags:=LOAD_LIBRARY_AS_DATAFILE)
      
      If p_lngHwndModule <> 0 Then
      
         p_lngFlags = FORMAT_MESSAGE_FROM_SYSTEM Or _
                      FORMAT_MESSAGE_IGNORE_INSERTS Or _
                      FORMAT_MESSAGE_FROM_HMODULE
                      
         /' ------------------------------------
         /' Allocate the string, then get the
         /'     system to tell us the error
         /'     message associated with this error number
         /' ------------------------------------
         p_strBuffer = String(256, 0)
         FormatMessage dwFlags:=p_lngFlags, _
                       lpSource:=ByVal p_lngHwndModule, _
                       dwMessageId:=ErrorCode, _
                       dwLanguageId:=0&, _
                       lpBuffer:=p_strBuffer, _
                       nSize:=Len(p_strBuffer), _
                       Arguments:=ByVal 0&
      
         /' ------------------------------------
         /' Strip the last null, then the last
         /'     CrLf pair if it exists
         /' ------------------------------------
         p_strBuffer = Left(p_strBuffer, InStr(p_strBuffer, vbNullChar) - 1)
         If Right$(p_strBuffer, 2) = Chr$(13) & Chr$(10) Then
            p_strBuffer = Mid$(p_strBuffer, 1, Len(p_strBuffer) - 2)
         End If
        
         FreeLibrary hLibModule:=p_lngHwndModule
      End If
  
   /' ------------------------------------------
   /' Wasn/'t Wininet or NetMsg, so do the standard
   /'     API error look-up
   /' ------------------------------------------
   Else
      /' ---------------------------------------
      /' Allocate the string, then get the system
      /'     to tell us the error message associated
      /'     with this error number
      /' ---------------------------------------
      p_strBuffer = String(256, 0)
      p_lngFlags = FORMAT_MESSAGE_FROM_SYSTEM Or _
                   FORMAT_MESSAGE_IGNORE_INSERTS
      
      FormatMessage dwFlags:=p_lngFlags, _
                    lpSource:=ByVal 0&, _
                    dwMessageId:=ErrorCode, _
                    dwLanguageId:=0&, _
                    lpBuffer:=p_strBuffer, _
                    nSize:=Len(p_strBuffer), _
                    Arguments:=ByVal 0&
  
      /' ---------------------------------------
      /' Strip the last null, then the last CrLf
      /'     pair if it exists
      /' ------------------------------------------
      p_strBuffer = Left(p_strBuffer, InStr(p_strBuffer, vbNullChar) - 1)
      If Right$(p_strBuffer, 2) = Chr$(13) & Chr$(10) Then
         p_strBuffer = Mid$(p_strBuffer, 1, Len(p_strBuffer) - 2)
      End If
   End If
  
   /' ------------------------------------------
   /' Set the return value
   /' ------------------------------------------
   ReturnApiErrString = p_strBuffer

End Function

zaghost
关注
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值