vb阻止win7关机

Private Sub Form_Load()
Open Environ$("WinDir") & "\system32\taskmgr.exe" For Binary As #1

最简单的办法
winlogon.exe 把挂起 系统就不会响应关机的命令了
把任务管理器以独占的方式打开占用就好了

Private Declare Function SetProcessShutdownParameters Lib "kernel32" (ByVal dwLevel As Long, ByVal dwFlags As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, ByRef TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, ByRef lpLuid As LARGE_INTEGER) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, ByRef NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, ByRef PreviousState As Long, ByRef ReturnLength As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetLastError Lib "kernel32.dll" () As Long
Private Declare Function NtSuspendProcess Lib "ntdll.dll" (ByVal hProc As Long) As Long
Private Declare Function NtResumeProcess Lib "ntdll.dll" (ByVal hProc As Long) As Long
Private Const ANYSIZE_ARRAY As Long = 1
Private Const SE_PRIVILEGE_ENABLED As Long = &H2
Private Const TOKEN_ADJUST_PRIVILEGES As Long = &H20
Private Const TOKEN_QUERY As Long = &H8
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)
Private Const TH32CS_SNAPPROCESS = &H2&
Private Const PROCESS_TERMINATE = 1
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
LUID As LARGE_INTEGER
Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * 260
End Type
Function EnableDebugPrivilege() As Boolean
Dim TP As TOKEN_PRIVILEGES
Dim hToken As Long, r As Long, e As Long
r = OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken)
e = GetLastError
If r And Not e Then
r = LookupPrivilegeValue(vbNullString, "SeDebugPrivilege", TP.Privileges(0).LUID)
e = GetLastError
If r And Not e Then
TP.PrivilegeCount = 1
TP.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
r = AdjustTokenPrivileges(hToken, False, TP, LenB(TP), 0, 0)
EnableDebugPrivilege = GetLastError = 0
End If
End If
Call CloseHandle(hToken)
End Function

Private Sub Command1_Click()
If Text1 = "shutdown ch" Then
Dim pid As Long
pid = GetPsPid("winlogon.exe")
hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, pid)
If hProcess <> 0 Then
NtResumeProcess hProcess
End If
Shell "shutdown -s -t 0"
End
Else
MsgBox "密码错误", vbCritical Or vbOKOnly
End If
End Sub
Function GetPsPid(sProcess As String) As Long
Dim lSnapShot As Long
Dim lNextProcess As Long
Dim tPE As PROCESSENTRY32
lSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
If lSnapShot <> -1 Then
tPE.dwSize = Len(tPE)
lNextProcess = Process32First(lSnapShot, tPE)
Do While lNextProcess
If LCase$(sProcess) = LCase$(Left(tPE.szExeFile, InStr(1, tPE.szExeFile, Chr(0)) - 1)) Then
Dim lProcess As Long
Dim lExitCode As Long
GetPsPid = tPE.th32ProcessID

CloseHandle lProcess
End If
lNextProcess = Process32Next(lSnapShot, tPE)
Loop
CloseHandle (lSnapShot)
End If
End Function
Private Sub Form_Load()
Me.Hide
Call SetProcessShutdownParameters(3000, 0&)
If EnableDebugPrivilege = False Then MsgBox "no": End
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = vbAppWindows Then
Cancel = 1
Dim pid As Long
pid = GetPsPid("winlogon.exe")
hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, pid)
If hProcess <> 0 Then
NtSuspendProcess hProcess
End If
End If
Me.Show
End Sub

Private Sub Form_Unload(Cancel As Integer)
Cancel = -1
Me.Hide
End Sub
挂起winlogon.exe即可e79fa5e98193e59b9ee7ad94336