如何用VB设计一个定时关机程序?请附上编码~

分类: 电脑/网络 >>程序设计 >>其他编程语言

解析:

下面是我愿来写的关机程序游碰可以适用于98/xp/2000,你可以拷来用.关机和重起函数我写好了，你自己调用即可。现在 *** 作系统多为2000或xp,所以需要特别注意的是应该先得到关机的特权:(你要想弄懂下面的程序,要有调用api函数的知识......)

其中:前面一些Public Declare都是api函数的声明.

Public Sub AdjustToken()子程序用来取得关机特权.

Public Sub Shutdown() '是关机子程序

Public Sub Reboot() '是重启子程序

*********************代码开始了:*****************

Public Structure LUID

Dim UsedPart As Integer

Dim IgnoredForNowHigh32BitPart As Integer

End Structure

Public Structure LUID_AND_ATTRIBUTES

Dim TheLuid As LUID

Dim Attributes As Integer

End Structure

Public Structure TOKEN_PRIVILEGES

Dim PrivilegeCount As Integer

Dim TheLuid As LUID

Dim Attributes As Integer

End Structure

'强制关机函数

Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Integer, ByVal dwReserved As Integer) As Integer

'GetLastError函数返回本线程的最后一次错误代码。错误代码是按照线程

'储存的，多线程也不会覆盖其他线程的错误代码。

Public Declare Function GetLastError Lib "kernel32" () As Integer

'GetCurrentProcess函数返回当前进程的一个句柄。

Public Declare Function GetCurrentProcess Lib "kernel32" () As Integer

'OpenProcessToken函数打开一个进程的访问代号。

Public Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Integer, ByVal DesiredAccess As Integer, ByRef TokenHandle As Integer) As Integer

'LookupPrivilegeValue函数获得本地唯一的标示符(LUID)，用于在特定的系统中

'表示特定的优先权。

'UPGRADE_WARNING: 结构 LUID 可能要求封送处理属性作为此声明语句中的参数传递。 单击以获得更多信息:“ms-helpMS.VSCC.2003/moner/redir/redirect?keyword="vbup1050"”

Public Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA"(ByVal lpSystemName As String, ByVal lpName As String, ByRef lpLuid As LUID) As Integer

'AdjustTokenPrivileges函数使能搜首或者禁用指定访问记号的优先权。

'使能或者禁用优先权需要TOKEN_ADJUST_PRIVILEGES访问权限。

'UPGRADE_WARNING: 结构 TOKEN_PRIVILEGES 可能要求封送处理属性作为此声明语句中的参数传递。 单击以获得更多神漏谈信息:“ms-helpMS.VSCC.2003/moner/redir/redirect?keyword="vbup1050"”

'UPGRADE_WARNING: 结构 TOKEN_PRIVILEGES 可能要求封送处理属性作为此声明语句中的参数传递。 单击以获得更多信息:“ms-helpMS.VSCC.2003/moner/redir/redirect?keyword="vbup1050"”

Public Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Integer, ByVal DisableAllPrivileges As Integer, ByRef NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Integer, ByRef PreviousState As TOKEN_PRIVILEGES, ByRef ReturnLength As Integer) As Integer

Public Declare Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Integer)

'********************************************************************

'* 这个过程设置正确的优先权，以允许在Windows NT下关机或者重新启动。

'********************************************************************

Public Sub AdjustToken()

Const TOKEN_ADJUST_PRIVILEGES As Short = &H20s

Const TOKEN_QUERY As Short = &H8s

Const SE_PRIVILEGE_ENABLED As Short = &H2s

Dim hdlProcessHandle As Integer

Dim hdlTokenHandle As Integer

Dim tmpLuid As LUID

Dim tkp As TOKEN_PRIVILEGES

Dim tkpNewButIgnored As TOKEN_PRIVILEGES

Dim lBufferNeeded As Integer

'使用SetLastError函数设置错误代码为0。

'这样做，GetLastError函数如果没有错误会返回0

'''''''SetLastError 0

'GetCurrentProcess函数设置 hdlProcessHandle变量

hdlProcessHandle = GetCurrentProcess()

''''' If GetLastError <>0 Then

''''' MsgBox "GetCurrentProcess error==" &GetLastError

''''' End If

OpenProcessToken(hdlProcessHandle, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hdlTokenHandle)

''''' If GetLastError <>0 Then

''''' MsgBox "OpenProcessToken error==" &GetLastError

''''' End If

' 获得关机优先权的LUID

LookupPrivilegeValue("", "SeShutdownPrivilege", tmpLuid)

'''''If GetLastError <>0 Then

'''''MsgBox "LookupPrivilegeValue error==" &GetLastError

'''''End If

tkp.PrivilegeCount = 1 ' 设置一个优先权

'UPGRADE_WARNING: 未能解析对象 tkp.TheLuid 的默认属性。 单击以获得更多信息:“ms-helpMS.VSCC.2003/moner/redir/redirect?keyword="vbup1037"”

tkp.TheLuid = tmpLuid

tkp.Attributes = SE_PRIVILEGE_ENABLED

' 对当前进程使能关机优先权

AdjustTokenPrivileges(hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded)

'''''If GetLastError <>0 Then

'''''MsgBox "AdjustTokenPrivileges error==" &GetLastError

'''''End If

End Sub

Public Sub Shutdown() '关机子程序

'******************根据windows版本来关机************************

If glngWhichWindows32 = mlngWindowsNT Then

AdjustToken() '调用取得优先权子程序

End If

ExitWindowsEx(EWX_SHUTDOWN Or EWX_FORCE, &HFFFFs)

'*****************************************************************

End Sub

Public Sub Reboot() '重启子程序

'******************根据windows版本来关机************************

If glngWhichWindows32 = mlngWindowsNT Then

AdjustToken() '调用取得优先权子程序

End If

ExitWindowsEx(EWX_REBOOT Or EWX_FORCE, &HFFFFs)

'*****************************************************************

End Sub

Dim

RTime,

strTime,

NHour,

NMinute,

WSH,

bl

Set

WSH

=

CreateObject("WScript.Shell")

bl

=

MsgBox("要执行关机 *** 作，还是重启 *** 作？",

vbYesNo

+

vbSystemModal,

"关机重启")

If

bl

=

vbYes

Then

RTime

=

InputBox("请输入关机时间(格式

时:分

如22:12)",

"时间",

"23:20")

Else

RTime

=

InputBox("请输入重启时间(格式

时:分

如22:12)",

"时间",

"23:20")

End

If

strTime

=

Split(RTime,

":")

'以冒号（：）分割RTime中的内容，并以数组形式存入吵搏变量strTime

NHour

=

CInt(strTime(0))

'获取strTime中的第一位数据并转换为整型数据，本例为23

NMinute

=

CInt(strTime(1))

Do

While

True

If

(Hour(Now)

=

NHour)

And

(Minute(Now)

=

NMinute)

And

bl

=

vbYes

Then

WScript.Sleep

2000

'延迟2秒

WSH.SendKeys

"(^{esc})"

'模仿按下键盘上的CTRL+Esc键

WScript.Sleep

2000

WSH.SendKeys

"{RIGHT}"

'模仿按下键盘上的向右移方向键

WScript.Sleep

2000

WSH.SendKeys

"{ENTER}"

'模仿按下键盘上的Enter键

Set

WSH

=

Nothing

Exit

Do

ElseIf

(Hour(Now)

=

NHour)

And

(Minute(Now)

=

NMinute)

And

bl

=

vbNo

Then

WScript.Sleep

2000

'延迟2秒

WSH.SendKeys

"(^{esc})"

'模仿按下键盘上的CTRL+Esc键

WScript.Sleep

2000

WSH.SendKeys

"{RIGHT}"

'模仿按下键盘上的向卖碰闷右移方向键

WScript.Sleep

2000

WSH.SendKeys

"{RIGHT}"

WScript.Sleep

2000

WSH.SendKeys

"{UP}"

WScript.Sleep

2000

WSH.SendKeys

"{ENTER}"

'模仿按下键盘上的Enter键

Set

WSH

=

Nothing

Exit

Do

Else

WScript.Sleep

1000

End

If

Loop

说明：1、本程序的关机，重启，是利用模仿按下键盘键执行的，所以时间到时，如果还动鼠标时，有可能会执行不成功

2、如果能想出时间一到马上禁止中弯使用鼠标，就很完美，100%成功

3、因为是模仿按键，不同系统的关机，重启，所在的位置可能不一样，所以有可能要根据自己的系统做相应的修改或添加模仿按键，向下键

{DOWN}

向左键

{LEFT}

向右键

{RIGHT}

向上键

{UP}，即通过方向钱把光标移到关机或重启按钮上，然后确认

4、我的是WIN7系统，以上代码在我这里运行成功

5、dos或批处理应该也能，只是，要到的交互命令，兼容性不好，比如，Choice命令，在WIN

XP里运行很正常，在我的WIN7里运行却不行

6、DOS

下的有Shutdown命令，专门用来关机，重启的，但兼容还是不好，不是每个系统都能用它

直接 用vb的time函数就可以了，返回的是系统的当前时间，比如“3:08:54”你比较这个字符串和你设定的就可以了清游。

Dim MyTime

MyTime = Time

hour(mytime) '获取时间中的小时

Minute(mytime)'获取时间中的分钟慎正困

Second(mytime)’获取时间中的秒

有了这些，你就可以自己随意判断、安排了宽念

---