系统退出.frm

台达通讯。并且在实际应用中还挺好的。大家可使用啊

VERSION 5.00
Begin VB.Form Form_tui 
   BackColor       =   &H80000013&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "关闭Windows"
   ClientHeight    =   3525
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   6210
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Moveable        =   0   'False
   Picture         =   "系统退出.frx":0000
   ScaleHeight     =   3525
   ScaleWidth      =   6210
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command3 
      Caption         =   "帮助(&H)"
      Height          =   315
      Left            =   4920
      TabIndex        =   3
      Top             =   3030
      Width           =   1125
   End
   Begin VB.CommandButton Command2 
      Caption         =   "取消"
      Height          =   315
      Left            =   3720
      TabIndex        =   2
      Top             =   3030
      Width           =   1125
   End
   Begin VB.ComboBox Combo1 
      BackColor       =   &H00800000&
      ForeColor       =   &H00FFFFFF&
      Height          =   300
      Left            =   1040
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   1630
      Width           =   3895
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定"
      Height          =   315
      Left            =   2500
      TabIndex        =   0
      Top             =   3030
      Width           =   1125
   End
End
Attribute VB_Name = "Form_tui"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
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
Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Private Type LUID
  UsedPart As Long
  IgnoredForNowHigh32BitPart As Long
End Type
Private Type TOKEN_PRIVILEGES
  PrivilegeCount As Long
  TheLuid As LUID
  Attributes As Long
End Type
Private Declare Function GetUserName& Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long)
Private Declare Function WinHelp Lib "user32.dll" Alias "WinHelpA" (ByVal hWndMain As Long, ByVal lpHelpFile As String, ByVal uCommand As Long, dwData As Any) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Const HELP_CONTENTS = &H3&
Const EWX_LOGOFF = 0 '注销
Const EWX_SHUTDOWN = 1 '待机
Const EWX_REBOOT = 2 '重新启动
Const EWX_WAIT = 16
Const EWX_FORCE = 4 '终止没有响应的进程
Const EWX_POWEROFF = 8 '关闭电源
Dim UserName As String
Private Sub Form_Load()
  Dim hProcessHandle As Long
  Dim hTokenHandle As Long
  Dim tmpLuid As LUID
  Dim tkpNew As TOKEN_PRIVILEGES
  Dim tkpPrevious As TOKEN_PRIVILEGES
  Dim lBufferNeeded As Long
 '获取当前进程的一个伪句柄
  hProcessHandle = GetCurrentProcess()
  OpenProcessToken hProcessHandle, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hTokenHandle

' Get the LUID for the shutdown privilege
  LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid

  tkpNew.PrivilegeCount = 1 ' One privilege to set
  tkpNew.TheLuid = tmpLuid
  tkpNew.Attributes = SE_PRIVILEGE_ENABLED

' Enable the shutdown privilege in the access token of this process.
  lBufferNeeded = 0
'允许当前应用程序有关闭操作系统的权限
  AdjustTokenPrivileges hTokenHandle, False, tkpNew, Len(tkpPrevious), tkpPrevious, lBufferNeeded
Dim strRetu As String * 256, ctr As String
'获得用户名
  GetUserName strRetu, 255
  UserName = Left(strRetu, InStr(strRetu, Chr(0)) - 1)
  UserName = UserName & ctr
'设置下拉列表框选项
'  Combo1.AddItem "注销 " & UserName
  Combo1.AddItem "关机"
  Combo1.AddItem "重新启动"
'  Combo1.AddItem "等待"
  Combo1.Text = "关机"
  Combo1.ForeColor = &HFFFFFF
'窗体定位
  Me.ScaleHeight = 3540
  Me.ScaleWidth = 6240
  Me.Left = (Screen.Width - Me.Width) / 2
  Me.Top = (Screen.Height - Me.Height) / 3.009
End Sub
Private Sub Command1_Click()
  If Combo1.Text = "注销 " & UserName Then
   ExitWindowsEx EWX_FORCE, 0
  End If
  If Combo1.Text = "关机" Then
   ExitWindowsEx EWX_FORCE Or EWX_POWEROFF, 0
  End If
  If Combo1.Text = "重新启动" Then
   ExitWindowsEx EWX_FORCE Or EWX_REBOOT, 0
  End If
  If Combo1.Text = "等待" Then
   ExitWindowsEx EWX_WAIT, 0
  End If
End Sub
Private Sub Command2_Click()
  form_zhu.Enabled = True
  form_zhu.Visible = True
  Unload Form_tui
End Sub
Private Sub Command3_Click()
'   WinHelp Me.hWnd, "winhlp32.hlp", HELP_CONTENTS, ByVal 0
   Form_shuo.Visible = True
   Form_shuo.Enabled = True
End Sub
Private Sub Combo1_DropDown()
 Combo1.ForeColor = &H0
 Combo1.BackColor = &HFFFFFF
End Sub


''Editer:戴国宏
''Date:2001-07-10
''E-Mail: [e-mail]
''利用API函数模拟 Win95/98/NT 的注销、重启、关闭计算机
'Option Explicit
'
'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 )
'
'Private 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 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(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
'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
''测试系统类型，如果运行在NT下不用此过程
'Public Function IsWinNT() As Boolean
'    Dim myOS As OSVERSIONINFO
'    myOS.dwOSVersionInfoSize = Len(myOS)
'    GetVersionEx myOS
'    IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
'End Function
''授权当前应用程序的关闭操作系统权限
'Private 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
'' 关闭计算机
'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)
'    Dim ret As Long
'    Dim Flags As Long
'    Flags = EWX_REBOOT
'    If Force Then Flags = Flags + EWX_FORCE
'    If IsWinNT Then EnableShutDown
'    ExitWindowsEx Flags, 0
'End Sub
''注销当前用户
'Public Sub LogOffNT(Force As Boolean)
'    Dim ret As Long
'    Dim Flags As Long
'    Flags = EWX_LOGOFF
'    If Force Then Flags = Flags + EWX_FORCE
'    ExitWindowsEx Flags, 0
'End Sub
'Private Sub Command1_Click()
'    LogOffNT True
'End Sub
'Private Sub Command2_Click()
'    RebootNT True
'End Sub
'Private Sub Command3_Click()
'    ShutDownNT True
'End Sub