我想作一个自动定时关机程序,不知道其中的关机怎么实现?
解决方案 »
- 看到很多控件的属性是“设计时不可用运行时只读”,请问这是什么意思?
- 我只有这么多分了!!!
- 怎样对已知文件夹中的文件进行查找??
- 怎样用字符串连接sql服务器快?-------求命,!
- VB中的类
- 新手笨问题3!关于存储过程返回的记录集无法绑定到datagrid的问题求教
- 怎样执行一个指定的程序,不用shell,用api怎么实现 ?
- 请问怎样用一句代码将整个菜单数组的属性改变
- 没有学过windows窗口机制,想学windows的api 用什么书好?
- excelVBA中出现“不能进入中断模式”
- 怎么判断一个文本文件是否存在极里面有无数据?
- 引用类时:”名称已与存在的模块或工程,对象冲突”咋回事啊?
Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Const SHUTDOWN = 1
Const REBOOT = 2
Const LOGOFF = 0
Dim sh As Long
Dim counter As Integer
Dim n As IntegerPrivate Sub Check1_Click()
If Check1.Value = 1 Then
Label3(0).Caption = "小时"
End If
End SubPrivate Sub Check2_Click()
If Check2.Value = 1 Then
Label3(0).Caption = "点"
End If
End SubPrivate Sub Combo1_click()
Combo1.BackColor = &H800000
Combo1.ForeColor = &HFFFFFF
Select Case Combo1.ListIndex
Case 0
Label2.Caption = "结束会话,关闭Windows,以便安全关闭电源。"
Case 1
Label2.Caption = "结束会话,关闭Windows,然后重新启动。"
Case 2
Label2.Caption = "结束会话,用户重新登陆。"
End Select
End SubPrivate Sub Combo1_DropDown()
Combo1.BackColor = &HFFFFFF
Combo1.ForeColor = &H0
End SubPrivate Sub Command1_Click()
Dim str As String
If Command2.Enabled = True Then
Select Case Combo1.ListIndex
Case 0
shutdown1
Case 1
reboot1
Case 2
logoff1
End Select
Else
If Check1.Value = 0 And Check2.Value = 0 And Check3.Value = 0 Then
Select Case Combo1.ListIndex
Case 0
shutdown1
Case 1
reboot1
Case 2
logoff1
End Select
Else
If Check1.Value = 0 And Check2.Value = 0 Then
str = MsgBox("你还有设置漏选!", 48, "错误")
End If
End If
n = Val(Text1.Text) * 3600 + Val(Text2.Text) * 60 + Val(Text3.Text)
If Check2.Value = 1 Then
If Text1.Text = "" Then
Text1.Text = "0"
End If
If Text2.Text = "" Then
Text2.Text = "0"
End If
If Text3.Text = "" Then
Text3.Text = "0"
End If
End If
If Check1.Value = 1 Then
If Val(Text3.Text) > 60 Or Val(Text2.Text) > 60 Then
MsgBox "填入的数据错误,要重填!", 48, "错误"
n = 0
Exit Sub
End If
If Text1.Text <> "0" And Text2.Text = "0" Then
Text2.Text = "60"
End If
If Text2.Text <> "0" And Text3.Text = "0" Then
Text3.Text = "60"
End If
End If
Timer1.Enabled = True
End If
End SubPrivate Sub Command2_Click()
Dim str As String
If Combo1.Text = "" Then
str = MsgBox("请选择操作类型!", 0, "错误")
Exit Sub
End If
Frame1.Visible = True
Command2.Enabled = False
End SubPrivate Sub Command3_Click()
End
End SubPrivate Sub Command4_Click()
Call ShellAbout(hwnd, "关闭Windows", "本软件由 HydeKong 制作!" & vbCrLf & "谢谢使用!", Me.Icon)
End SubPrivate Sub Command5_Click()
If Timer1.Enabled = True Then
Timer1.Enabled = False
End If
Text1.Text = 0
Text2.Text = 0
Text3.Text = 0
End SubPrivate Sub Form_Load()
Frame1.Visible = False
Label2.Caption = ""
Combo1.AddItem "关机"
Combo1.AddItem "重新启动"
Combo1.AddItem "注销"
counter = 0
Timer1.Enabled = False
End SubPrivate Sub shutdown1()
sh = ExitWindowsEx(SHUTDOWN, dwReserved)
End SubPrivate Sub reboot1()
sh = ExitWindowsEx(REBOOT, dwReserved)
End SubPrivate Sub logoff1()
sh = ExitWindowsEx(LOGOFF, dwReserved)
End SubPrivate Sub Text1_KeyPress(KeyAscii As Integer)
Key = Chr(KeyAscii)
If KeyAscii <> 8 And Key < "0" Or Key > "9" Then
MsgBox "请填入数字!"
End If
End SubPrivate Sub Text2_KeyPress(KeyAscii As Integer)
Key = Chr(KeyAscii)
If KeyAscii <> 8 And Key < "0" Or Key > "9" Then
MsgBox "请填入数字!"
End If
End SubPrivate Sub Text3_KeyPress(KeyAscii As Integer)
Key = Chr(KeyAscii)
If KeyAscii <> 8 And Key < "0" Or Key > "9" Then
MsgBox "请填入数字!"
End If
End SubPrivate Sub Timer1_Timer()
counter = counter + 1
If Check1.Value = 1 Then
If Text1.Text <> 0 And Text2.Text = "60" Then
Text1.Text = Text1.Text - "1"
End If
If Text2.Text <> 0 And Text3.Text = "60" Then
Text2.Text = Text2.Text - "1"
End If
If Text3.Text <> 0 Then
Text3.Text = Text3.Text - "1"
End If
If Text2.Text = "0" And Text1.Text <> "0" Then
Text2.Text = "60"
End If
If Text3.Text = "0" And Text2.Text <> "0" Then
Text3.Text = "60"
End If
End If
Dim ch As String
If Check3.Value = 1 Then
If n > 300 Then
If n - counter = 300 Then
Dim rtn
rtn = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3)
ch = MsgBox("还有5分钟就要关机,是否继续执行?", 48 + vbYesNo, "提醒")
If ch = vbNo Then
Timer1.Enabled = False
rtn = SetWindowPos(Me.hwnd, -2, 0, 0, 0, 0, 3)
counter = 0
Exit Sub
Else
MsgBox "请做好数据保存,就要关机了!", 48, "提醒"
End If
End If
End If
End If
If (n - counter) = 0 Then
Select Case Combo1.ListIndex
Case 0
shutdown1
Case 1
reboot1
Case 2
logoff1
End Select
End If
End Sub
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
Private Type OSVERSIONINFO ' 148 Bytes
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Dim lpVersionInfo As OSVERSIONINFO
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
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 Const EWX_SHUTDOWN As Long = 1
Private Const EWX_FORCE As Long = 4
Private Const EWX_REBOOT = 2
Private Const EWX_POWEROFF As Long = 8 '关闭电源
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 LongPrivate Sub AdjustToken() '对于WinNT/2K 必须获得控制权,才能有权做自动关闭系统和电源等事务
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, lBufferNeededEnd Sub'退出windows,关闭计算机
Public Function ExitWindows() As Boolean
On Error Resume Next
lpVersionInfo.dwOSVersionInfoSize = Len(lpVersionInfo)
GetVersionEx lpVersionInfo
With lpVersionInfo
If .dwPlatformId = VER_PLATFORM_WIN32_NT Then
AdjustToken
ExitWindowsEx EWX_POWEROFF, &HFFFF
Else
ExitWindowsEx EWX_SHUTDOWN, &HFFFF
End If
End With
ExitWindows = True
End Function