爱尚共享网

VB6关机注销重启(切断电源)

爱尚共享网2020-07-25学习资料 154 0A+A-

以下代码请不要用调试模式来测试,一定要生成EXE文件之后再测试,测试之前请关闭其它正在运行的程序以及备份您的重要文件,若因为该程序造成的损失本人不负责!

1、新建一个工程,窗口命名为frmMain,再添加一个类模块Power.cls,再在Power.cls里添加以下代码

Option Explicit
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 OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle 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 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
'以上为API函数声明
Private Declare Function RtlAdjustPrivilege Lib "ntdll.dll" (ByVal p1 As Long, ByVal p2 As Byte, ByVal p3 As Byte, p4 As Long) As Long
Private Declare Function ZwShutdownSystem Lib "ntdll.dll" (ByVal p1 As Long) As Long
'以上为直接断电声明

Private Const EWX_FORCE As Long = 4 '强制结束进程
Public Enum EnumExitWindows
WE_LOGOFF = 0     '注销
WE_SHUTDOWN = 1   '关机
WE_REBOOT = 2     '重启
WE_POWEROFF = 8   '强制结束进程并关机
End Enum
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 Sub GetAdmin()
    Const TOKEN_ADJUST_PRIVILEGES = &H20
    Const TOKEN_QUERY = &H8
    Const SE_PRIVILEGE_ENABLED = &H2
    Dim hdlProcessHandle As Long
    Dim hdlTokenHandle As Long
    Dim tmpLuid As LUID
    Dim tkp As TOKEN_PRIVILEGES
    Dim tkpNewButIgnored As TOKEN_PRIVILEGES
    Dim lBufferNeeded As Long
    hdlProcessHandle = GetCurrentProcess()
    OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or _
       TOKEN_QUERY), hdlTokenHandle
' 获得系统特权
    LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
    tkp.PrivilegeCount = 1    ' One privilege to set
    tkp.TheLuid = tmpLuid
    tkp.Attributes = SE_PRIVILEGE_ENABLED
    AdjustTokenPrivileges hdlTokenHandle, False, _
    tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded
End Sub

Public Sub ExitWindows(ByVal aOption As EnumExitWindows)

GetAdmin

Select Case aOption
    Case EnumExitWindows.WE_LOGOFF '注销
      ExitWindowsEx (EnumExitWindows.WE_LOGOFF Or EWX_FORCE), &HFFFF
    Case EnumExitWindows.WE_REBOOT '重启
      ExitWindowsEx (EnumExitWindows.WE_SHUTDOWN Or EWX_FORCE Or EnumExitWindows.WE_REBOOT), &HFFFF
    Case EnumExitWindows.WE_SHUTDOWN '关机
      ExitWindowsEx (EnumExitWindows.WE_SHUTDOWN Or EWX_FORCE), &HFFFF
    Case EnumExitWindows.WE_POWEROFF '强制结束进程并关机
      ExitWindowsEx (EnumExitWindows.WE_POWEROFF Or EWX_FORCE), &HFFFF
End Select
End Sub

Public Sub DoShutDown() '切断电源
    Dim p4 As Long, ret As Long
    ret = RtlAdjustPrivilege(&H13, 1, 1, p4)
    If ret = &HC000007C Then
        ret = RtlAdjustPrivilege(&H13, 1, 0, p4)
    End If
    ret = ZwShutdownSystem(2)
End Sub

2、切换到frmMain设计窗口,添加两个按钮控件,分别命名为cmdAgree(确定)和cmdExit(取消)

添加一个Frame容器,再在Frame里添加4个OptionButton控件,分别命名为
optShutdown(关机)
optReboot(重新启动)
optLogoff(注销)
optClosePower(切断电源)
再添加一个CheckBox控件命名为chkForce(强制结束进程)
最后在窗口任意地方添加一个Timer控件,设置Interval值为10

3、在frmMain代码窗口中添加以下代码:

Option Explicit
Private Sub cmdAgree_Click()
Dim cExitWindows As New Power
    If optShutdown.Value Then
        If Me.chkForce.Value = 1 Then '如果选择了强制选项
            If MsgBox("您确定要强行关闭计算机吗?", vbOKCancel + vbQuestion, "操作确认") = vbOK Then
                cExitWindows.ExitWindows WE_POWEROFF
            Else
                Exit Sub
            End If
        Else '没有选择强制选项
            If MsgBox("您确定要正常关闭计算机吗?", vbOKCancel + vbQuestion, "操作确认") = vbOK Then
                cExitWindows.ExitWindows WE_SHUTDOWN
            Else
                Exit Sub
            End If
        End If
    ElseIf optLogoff.Value Then
        If MsgBox("您确定要注销当前用户吗?", vbOKCancel + vbQuestion, "操作确认") = vbOK Then
            cExitWindows.ExitWindows WE_LOGOFF
        Else
            Exit Sub
        End If
    ElseIf optReboot.Value Then
        If MsgBox("您确定要重启计算机吗?", vbOKCancel + vbQuestion, "操作确认") = vbOK Then
            cExitWindows.ExitWindows WE_REBOOT
        Else
            Exit Sub
        End If
    ElseIf optClosePower.Value Then
        If MsgBox("您确定要直接关闭电源吗?" & vbCrLf & "此操作会丢失未保存的数据!" & vbCrLf & "具有一写的危险性,请慎重!", vbOKCancel + vbQuestion, "操作确认") = vbOK Then
            cExitWindows.DoShutDown
        Else
            Exit Sub
        End If
    End If
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub Timer1_Timer()
    If Me.optShutdown.Value Then
        Me.chkForce.Enabled = True
    Else
        Me.chkForce.Enabled = False
    End If
End Sub

4、保存工程,生成可执行文件即可。

成品图如下:

各位试验的时候最好关掉其它应用程序,或者停止其它应用程序对数据的操作,以免丢失数据。

如果试验最后那个切断电源的功能,最好先备份C盘或者在虚拟机里面测试。

本人测试的时候第一次重启就蓝屏了,第二次才能正常进入系统。


发表评论