VB关机程序代码整理

admin管理员组

文章数量:1532709

2024年3月6日发(作者：)

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 =

b =

If a > 23 Or b > 59 Then MsgBox ("输入有误，请重新输入")

d = True

n = "你要关机的时间是" & a & "时" & b & "分"

End Sub

Private Sub Command2_Click()

End

End Sub

Private Sub Form_Load()

n = "确定"

n = "停止"

n = "时"

n = "分"

n = "关机时间为："

n = "等待......"

= ""

= ""

d = False

d = True

al = 1000

al = 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 < 0 Then =

= - 200

If Hour(Time) = a And Minute(Time) = b Then

d = False

Shell ("c: /s /t 0")

End If

End Sub

Private Sub Timer2_Timer()

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 "" Alias _

"LookupPrivilegeValueA" (ByVal lpSystemName As String, _

ByVal lpName As String, lpLuid As LUID) As Long

Private Declare Function AdjustTokenPrivileges Lib "" _

(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 "" _

(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

egeCount = 1 ' One privilege to set

eges(0).pLuid = tmpLuid

eges(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()

d = False

End Sub

Private Sub Form_Load()

valuetime = 5 '设置关机时间 /分钟

d = True

hh = Int(valuetime / 60) ' 转换时间格式

mm = valuetime - hh * 60

ss = 0

n = hmstostring(hh, mm, ss)

End Sub

Private Sub Timer1_Timer()

If ss < 1 Then

If mm < 1 Then

If hh < 1 Then

al = 0

AdjustToken

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

'关闭2000/XP前要先得到关机的特权 '关机

Else

ss = ss - 1

Beep '发出声音

End If

n = hmstostring(hh, mm, ss)

End Sub

本文标签： 关机时间喜欢