以下是我来写的关机程序希望适用于98/xp/2000。 可以复印使用。 关机和重启函数写了。 自己叫就行了。 现在,操作系统有很多2000和xp,因此需要特别注意的是获得关闭特权: (要理解以下程序,需要调用api函数的知识。 () )。
其中:之前的几个公共解码器都是api函数的声明。
Public Sub AdjustToken (子程序用于获取关闭权限。
公共子关机'是关机的子程序
公共辅助重新引导'是重新启动子程序
*代码为: * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
公共结构luid
dim用户部件as integer
dimignoredfornowhigh 32 bitpartasinteger
最终结构
publicstructureluid _ and _ attributes
Dim TheLuid As LUID
Dim Attributes As Integer
最终结构
publicstructuretoken _ privileges
dim权限计数as integer
Dim TheLuid As LUID
Dim Attributes As Integer
最终结构
'强制关闭函数
publicdeclarefunctionexitwindowsexlib ' user32 ' (byvaluflagsasinteger,ByVal dwReserved As Integer ) as integer
' GetLastError函数返回此线程的最后一个错误代码。 错误代码是每个线程的
'保存的多线程也不涵盖其他线程的错误代码。
publicdeclarefunctiongetlasterrorlib ' kernel32 ' () As Integer
' GetCurrentProcess函数返回当前进程的句柄。
publicdeclarefunctiongetcurrentprocesslib ' kernel32 ' () As Integer
' OpenProcessToken函数打开进程的访问号。
publicdeclarefunctionopenprocesstokenlib ' advapi32 ' (byvalprocesshandleasinteger,ByVal DesiredAccess As Integer,byreftoken
' LookupPrivilegeValue函数获取特定系统使用的本地唯一标识符(LUID )
'表示特定的优先顺序。
' UPGRADE_WARNING:结构LUID可能需要将封装处理属性作为此声明语句的参数传递。 单击可获取详细信息:“ms-help ://ms.vscc.2003/commoner/redir/redirect.htm? keyword='vbup1050 ' "
publicdeclarefunctionlookupprivilegevaluelib ' advapi32 ' alias ' lookupprivilegevaluea ' (byvallpsystemnameasstring,byvalll
' AdjustTokenPrivileges函数启用或禁用指定访问令牌的优先级。
'要启用或禁用优先级,您必须具有TOKEN_ADJUST_PRIVILEGES权限。
' UPGRADE_WARNING:结构TOKEN_PRIVILEGES可能需要将封装处理属性作为此声明语句的参数传递。 单击可获取详细信息:“ms-help ://ms.vscc.2003/commoner/redir/redirect.htm? keyword='vbup1050 ' "
' UPGRADE_WARNING:结构TOKEN_PRIVILEGES可能需要将封装处理属性作为此声明语句的参数传递。 单击可获取详细信息:“ms-help ://ms.vscc.2003/commoner/redir/redirect.htm? keyword='vbup1050 ' "
publicdeclarefunctionadjusttokenprivilegeslib ' advapi32 ' (byvaltokenhandleasinteger,byvaldisablealllprivilegesasinteger,)
r, ByRef NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Integer, ByRef PreviousState As TOKEN_PRIVILEGES, ByRef ReturnLength As Integer) As IntegerPublic 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-help://MS.VSCC.2003/commoner/redir/redirect.htm?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