Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) 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 Long, ReturnLength As Long) As Long
Private Declare Function GetTokenInformation Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal TokenInformationClass As Long, TokenInformation As Any, ByVal TokenInformationLength As Long, ReturnLength 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 OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () 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 Type LARGE_INTEGER
lowpart As Long
highpart As Long
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(0) As LUID_AND_ATTRIBUTES
End Type
Dim Opt As Long
Private Sub Shutdown(Optional Mode As Long = EWX_POWEROFF)
Dim lAPIReturn As Long
Dim tTOKPRI As TOKEN_PRIVILEGES
Dim tLUID As LUID
Dim tLarInt As LARGE_INTEGER
Dim lRequired As Long
Dim hTokHan As Long
Dim hProcess As Long
If LookupPrivilegeValue(vbNullString, SE_SHUTDOWN_NAME, tLarInt) = 0 Then
MsgBox "Get LUID error!", vbOKOnly, "Error"
Exit Sub
End If
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 ExitWindowsEx Lib "user32" (ByVal _
dwOptions As Long, ByVal dwReserved As Long) As Long
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 EWX_SHUTDOWN = 1
Const EWX_POWEROFF=8'常数
Private Sub AdjustToken()
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
' Get the LUID for shutdown privilege.
LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
tkp.PrivilegeCount = 1 ' One privilege to set
tkp.TheLuid = tmpLuid
tkp.Attributes = SE_PRIVILEGE_ENABLED
' Enable the shutdown privilege in the access token of this process.
AdjustTokenPrivileges hdlTokenHandle, False, _
tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded
对象 属性 设置
Text1 Text 空
Option1(0) Caption 在指定时间关机
(时间格式:00:00:00)
Index 0
Option1(1) Caption 延迟指定的时间关机
Index 0
Command1 Caption 确定
Timer1 Interval 15000(精确到1/4分钟,如要更精确可减少该值)
Enabled False
增加代码如下:
标准模块:
Option Explicit
Public Const EWX_SHUTDOWN = 1 '关闭系统
Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, _
ByVal dwReserved As Long) As Long
窗体模块:
Option Explicit
Dim txtTime '保存输入时间
Dim nowTime '保存实时时间
Dim oldTime '保存开始定时时间
Private Sub Command1_Click()
oldTime = Time
If Not IsDate(Text1.Text) Then '用IsData函数判断输入的时间格式
MsgBox "你所输入的不是时间格式,请重试!", , "Wrong"
Else
txtTime = TimeValue(Text1.Text)
End If
Timer1.Enabled = True '启动定时器
Me.WindowState = 1 '最小化窗体
End Sub
Private Sub Timer1_Timer()
nowTime = Time
If Option1(0).Value Then
If DateDiff("s", nowTime, txtTime) Then
If DateDiff("s", nowTime, txtTime) < 0 Then
'用DateDiff函数判断是否到时间了
If Not ExitWindowsEx(EWX_SHUTDOWN, 0) Then
MsgBox "无法关闭计算机"
End If
End If
ElseIf DateDiff("s", nowTime, oldTime + txtTime) < 0 Then
If Not ExitWindowsEx(EWX_SHUTDOWN, 0) Then
MsgBox "无法关闭计算机"
End If
End If
End If
End Sub
Private Sub Command1_Click()
oldTime = Time
If Not IsDate(Text1.Text) Then '用IsData函数判断输入的时间格式
MsgBox "你所输入的不是时间格式,请重试!", , "Wrong"
Else
txtTime = TimeValue(Text1.Text)
Timer1.Enabled = True '启动定时器
Me.WindowState = 1 '最小化窗体
End If
End Sub
这是定时关机代码