简单的VB定时关机小程序
<p>简单的VB定时 关机 记时开始的时候可以发出声音</p><p>新建一个窗体FROM1 和一个 按钮 Command1</p><p>添加 一个 Timer1 控件 和 Label1</p><p>Dim ss, mm, hh As Integer</p><p> </p><p>Private qdtime '变量保存计时起点<br/>Private imglft As Integer '退出图标左坐标初值<br/>'下面为关机的 WIMDOWS API 函数声明<br/>Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long<br/> Enum HowExitConst<br/> EWX_FORCE = 4 '强制关机<br/> EWX_LOGOFF = 0 '注销<br/> EWX_REBOOT = 2 '重开机<br/> EWX_SHUTDOWN = 1 '可关机98 但在2000下关机最后出现“ 现在可以安全关机”的问题<br/> EWX_POWEROFF = 8 '可以关闭Windows NT/2000/XP:计算机的：</p><p> End Enum<br/> Const TOKEN_ADJUST_PRIVILEGES = &H20<br/> Const TOKEN_QUERY = &H8<br/> Const SE_PRIVILEGE_ENABLED = &H2<br/> Const ANYSIZE_ARRAY = 1<br/> Private Type LUID<br/> lowpart As Long<br/> highpart As Long<br/> End Type</p><p>Private Type LUID_AND_ATTRIBUTES<br/> pLuid As LUID<br/> Attributes As Long<br/>End Type</p><p>Private Type TOKEN_PRIVILEGES<br/> PrivilegeCount As Long<br/> Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES<br/>End Type</p><p>Private Declare Function GetCurrentProcess Lib "kernel32" () As Long</p><p>Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias _<br/> "LookupPrivilegeValueA" (ByVal lpSystemName As String, _<br/> ByVal lpName As String, lpLuid As LUID) As Long<br/> <br/>Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" _<br/> (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, _<br/> NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, _<br/> PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long<br/> <br/>Private Declare Function OpenProcessToken Lib "advapi32.dll" _<br/> (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, _<br/> TokenHandle As Long) As Long<br/> <br/> <br/>Private Sub AdjustToken() '关闭2000/XP前要先得到关机的特权<br/>Dim hdlProcessHandle As Long<br/>Dim hdlTokenHandle As Long<br/>Dim tmpLuid As LUID<br/>Dim tkp As TOKEN_PRIVILEGES<br/>Dim tkpNewButIgnored As TOKEN_PRIVILEGES<br/>Dim lBufferNeeded As Long<br/>hdlProcessHandle = GetCurrentProcess()<br/>OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), _<br/> hdlTokenHandle<br/>'Get the LUID for shutdown privilege.<br/>LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid<br/>tkp.PrivilegeCount = 1 ' One privilege to set<br/>tkp.Privileges(0).pLuid = tmpLuid<br/>tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED<br/>'Enable the shutdown privilege in the access token of this process.<br/>AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), _<br/> tkpNewButIgnored, lBufferNeeded<br/>End Sub</p><p><br/>Private Function hmstostring(ByVal h As Integer, ByVal m As Integer, ByVal s As Integer) As String<br/> Dim hhs, mms, sss As String<br/> If h < 10 Then<br/> hhs = "0" + Trim(Str(h))<br/> Else<br/> hhs = Trim(Str(h))<br/> End If<br/> If m < 10 Then<br/> mms = "0" + Trim(Str(m))<br/> Else<br/> mms = Trim(Str(m))<br/> End If<br/> If s < 10 Then<br/> sss = "0" + Trim(Str(s))<br/> Else<br/> sss = Trim(Str(s))<br/> End If<br/> hmstostring = hhs + "：" + mms + "：" + sss<br/>End Function<br/>Private Sub Command1_Click()<br/>Timer1.Enabled = False<br/>End Sub<br/>Private Sub Form_Load()<br/>valuetime = 5 '设置关机时间 /分钟<br/>Timer1.Enabled = True<br/>hh = Int(valuetime / 60) ' 转换时间格式<br/> mm = valuetime - hh * 60<br/> ss = 0<br/> Label1.Caption = hmstostring(hh, mm, ss)<br/>End Sub</p><p><br/>Private Sub Timer1_Timer()<br/> If ss < 1 Then<br/> If mm < 1 Then<br/> If hh < 1 Then<br/> Timer1.Interval = 0<br/> <br/> AdjustToken '关闭2000/XP前要先得到关机的特权<br/> Call ExitWindowsEx(EWX_POWEROFF, 0) '关机<br/> Exit Sub<br/> Else<br/> hh = hh - 1<br/> mm = 59<br/> ss = 60<br/> <br/> End If<br/> Else<br/> mm = mm - 1<br/> ss = 60<br/> End If<br/> Else<br/> ss = ss - 1<br/> Beep '发出声音<br/> End If<br/> Label1.Caption = hmstostring(hh, mm, ss)<br/> End Sub</p> 记得以前Asuka MM也写过一个,我找找........... 哎,上班了,中午吃饭时再来找找....
页:
[1]