VB定时关机代码

来源：互联网发布：js随机函数编辑：程序博客网时间：2024/05/16 10:22

VB定时关机代码

简单的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)

0 0