VB 6.0 中可以对Win NT win XP win2000 win7同时实现关机吗? 最好有代码

VB 6.0 中可以对Win NT win XP win2000 win7同时实现关机吗? 最好有代码,第1张

以下引用别人的:http://zhidao.baidu.com/question/3764263.html

退出 *** 作系统可以调用Windows API的ExitWindowsEx函数。在Win9x下,只要简单地调用ExitWindowsEx函数就可以实现关机或者重新启动。但是在Win 2000/XP下调用ExitWindowsEx函数时,还需要先调用AdjustTokenPrivileges函数。下面的例子在Win9x和Win 2000/XP下都可以使用。请参考程序中的注释。

例子:

1、建立一个窗体,在上面放置4个按钮,按钮设置如下:

控件 控件名 Caption属性

---------------------------------------------------

CommandButton cmdLogoff 注销

CommandButton cmdForceLogoff 强制注销

CommandButton cmdShutdown 关机

CommandButton cmdForceShutdown 强制关机

2、将下面的代码加入窗体中:

Option Explicit

Private Const EWX_LogOff As Long = 0

Private Const EWX_SHUTDOWN As Long = 1

Private Const EWX_REBOOT As Long = 2

Private Const EWX_FORCE As Long = 4

Private Const EWX_POWEROFF As Long = 8

'ExitWindowsEx函数可以退出登录、关机或者重新启动系统

Private Declare Function ExitWindowsEx Lib "user32" _

(ByVal dwOptions As Long, _

ByVal dwReserved As Long) As Long

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

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

Private Declare Function GetLastError Lib "kernel32" () As Long

Private Const mlngWindows95 = 0

Private Const mlngWindowsNT = 1

Public glngWhichWindows32 As Long

' GetVersion返回 *** 作系统的版本。

Private Declare Function GetVersion Lib "kernel32" () As Long

Private Type LUID

UsedPart As Long

IgnoredForNowHigh32BitPart As Long

End Type

Private Type LUID_AND_ATTRIBUTES

TheLuid As LUID

Attributes As Long

End Type

Private Type TOKEN_PRIVILEGES

PrivilegeCount As Long

TheLuid As LUID

Attributes As Long

End Type

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

Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

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

Private Declare Function OpenProcessToken Lib "advapi32" _

(ByVal ProcessHandle As Long, _

ByVal DesiredAccess As Long, _

TokenHandle As Long) As Long

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

'表示特定的优先权

Private Declare Function LookupPrivilegeValue Lib "advapi32" _

Alias "LookupPrivilegeValueA" _

(ByVal lpSystemName As String, _

ByVal lpName As String, _

lpLuid As LUID) As Long

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

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

Private Declare Function AdjustTokenPrivileges Lib "advapi32" _

(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 Sub SetLastError Lib "kernel32" _

(ByVal dwErrCode As Long)

Private Sub AdjustToken()

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

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

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

Const TOKEN_ADJUST_PRIVILEGES = &H20

Const TOKEN_QUERY = &H8

Const SE_PRIVILEGE_ENABLED = &H2

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

'使用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 ' 设置一个优先权

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

Private Sub cmdLogoff_Click()

ExitWindowsEx (EWX_LogOff), &HFFFF

MsgBox "ExitWindowsEx's GetLastError " &GetLastError

End Sub

Private Sub cmdForceLogoff_Click()

ExitWindowsEx (EWX_LogOff Or EWX_FORCE), &HFFFF

MsgBox "调用ExitWindowsEx函数后的GetLastError " &GetLastError

End Sub

Private Sub cmdShutdown_Click()

If glngWhichWindows32 = mlngWindowsNT Then

AdjustToken

MsgBox "调用AdjustToken后的GetLastError " &GetLastError

End If

ExitWindowsEx (EWX_SHUTDOWN), &HFFFF

MsgBox "调用ExitWindowsEx函数后的GetLastError " &GetLastError

End Sub

Private Sub cmdForceShutdown_Click()

If glngWhichWindows32 = mlngWindowsNT Then

AdjustToken

MsgBox "调用AdjustToken后的GetLastError " &GetLastError

End If

ExitWindowsEx (EWX_SHUTDOWN Or EWX_FORCE), &HFFFF

MsgBox "ExitWindowsEx's GetLastError " &GetLastError

End Sub

Private Sub Form_Load()

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

'* 当项目启动时,调用GetVersion检查 *** 作系统。

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

Dim lngVersion As Long

lngVersion = GetVersion()

If ((lngVersion And &H80000000) = 0) Then

glngWhichWindows32 = mlngWindowsNT

MsgBox "在Windows NT或Windows 2000下运行"

Else

glngWhichWindows32 = mlngWindows95

MsgBox "在Windows 95/98/Me下运行"

End If

End Sub

'OK添加两个按钮,把下面代码直接复制粘贴进代码输入框把原来的代码全部覆盖,F5就可以了。

Private sub Form_load()

command1.caption="关机"

command2.caption="重启"

Private Sub command1_click()

Shell "cmd /c" &"shutdown -s -t 0"

End Sub '关机代码,0代表时间,就是几秒后关机

Private Sub command2_click()

Shell "cmd /c" &"shutdown -r -t 0"

End Sub '重启代码


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/tougao/7897879.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-04-11
下一篇 2023-04-11

发表评论

登录后才能评论

评论列表(0条)

保存