VB关机程序代码整理

VB关机程序代码整理 B关机程序代码整理 [ 2009-3-6 21:47:00 | By: 木剑 ] 设计其一 4个Label 2个text 2个command 2个timer 其他属性根据自己喜欢再 设计 Public a As Integer，b As Integer Private Sub Command1_Click() a = Text1.Text b = Text2.Text If a > 23 Or b > 59 Then MsgBox ("输入有误，请重新输入") Timer1.Enabled = True Me.Caption = "你要关机的时间是" & a & "时" & b & "分" End Sub Private Sub Command2_Click() End End Sub Private Sub Form_Load() Command1.Caption = "确定" Command2.Caption = "停止" Label1.Caption = "时" Label2.Caption = "分" Label3.Caption = "关机时间为:" Label4.Caption = "等待......" Text1.Text = "" Text2.Text = "" Timer1.Enabled = False Timer2.Enabled = True Timer2.Interval = 1000 Timer1.Interval = 1000 End Sub Private Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii = 8 Then Exit Sub If KeyAscii > 57 Or KeyAscii < 48 Then KeyAscii = 0 End Sub Private Sub Text2_KeyPress(KeyAscii As Integer) If KeyAscii = 8 Then Exit Sub If KeyAscii > 57 Or KeyAscii < 48 Then KeyAscii = 0 End Sub Private Sub Timer1_Timer() If Label4.Left < 0 Then Label4.Left = Form1.Width Label4.Left = Label4.Left - 200 If Hour(Time) = a And Minute(Time) = b Then Timer1.Enabled = False Shell ("c:\windows\system32\shutdown.exe /s /t 0") End If End Sub Private Sub Timer2_Timer() Me.Cls Print "现在时间是:" & Time End Sub VB定时关机代码 2 简单的VB定时 关机 记时开始的时候可以发出声音 新建一个窗体FROM1 和一个 按钮 Command1 添加 一个 Timer1 控件 和 Label1 Dim ss, mm, hh As Integer Private qdtime '变量保存计时起点 Private imglft As Integer '退出图标左坐标初值 '下面为关机的 WIMDOWS API 函数声明 Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long Enum HowExitConst EWX_FORCE = 4 '强制关机 EWX_LOGOFF = 0 '注销 EWX_REBOOT = 2 '重开机 EWX_SHUTDOWN = 1 '可关机98 但在2000下关机最后出现“ 现在可以安全 关机”的问题 EWX_POWEROFF = 8 '可以关闭Windows NT/2000/XP:计算机的: End Enum Const TOKEN_ADJUST_PRIVILEGES = &H20 Const TOKEN_QUERY = &H8 Const SE_PRIVILEGE_ENABLED = &H2 Const ANYSIZE_ARRAY = 1 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 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 Private Declare Function OpenProcessToken Lib "advapi32.dll" _ (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, _ TokenHandle As Long) As Long Private Sub AdjustToken() '关闭2000/XP前要先得到关机的特权 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.Privileges(0).pLuid = tmpLuid tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED 'Enable the shutdown privilege in the access token of this process. AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), _ tkpNewButIgnored, lBufferNeeded End Sub Private Function hmstostring(ByVal h As Integer, ByVal m As Integer, ByVal s As Integer) As String Dim hhs, mms, sss As String If h < 10 Then hhs = "0" + Trim(Str(h)) Else hhs = Trim(Str(h)) End If If m < 10 Then mms = "0" + Trim(Str(m)) Else mms = Trim(Str(m)) End If If s < 10 Then sss = "0" + Trim(Str(s)) Else sss = Trim(Str(s)) End If hmstostring = hhs + ":" + mms + ":" + sss End Function Private Sub Command1_Click() Timer1.Enabled = False End Sub Private Sub Form_Load() valuetime = 5 '设置关机时间 /分钟 Timer1.Enabled = True hh = Int(valuetime / 60) ' 转换时间格式 mm = valuetime - hh * 60 ss = 0 Label1.Caption = hmstostring(hh, mm, ss) End Sub Private Sub Timer1_Timer() If ss < 1 Then If mm < 1 Then If hh < 1 Then Timer1.Interval = 0 AdjustToken '关闭2000/XP前要先得到关机的特权 Call ExitWindowsEx(EWX_POWEROFF, 0) '关机 Exit Sub Else hh = hh - 1 mm = 59 ss = 60 End If Else mm = mm - 1 ss = 60 End If Else ss = ss - 1 Beep '发出声音 End If Label1.Caption = hmstostring(hh, mm, ss) End Sub