| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 460 人关注过本帖
标题:一个菜鸟的问题!
只看楼主 加入收藏
bluemoonte
Rank: 1
等 级:新手上路
帖 子:156
专家分:0
注 册:2006-2-12
收藏
 问题点数:0 回复次数:5 
一个菜鸟的问题!
请问用vb实现计算机关机的代码怎么写啊?谢谢啊!
搜索更多相关主题的帖子: 计算机 
2006-02-27 09:50
Ver
Rank: 1
等 级:新手上路
帖 子:173
专家分:0
注 册:2006-2-8
收藏
得分:0 

API ExitWindowsEx


我用古老的咒语重温,吟唱灵魂序曲寻根 面对魔界的邪吻,不被污染的转身,维持纯白的象徵然后还原为人
2006-02-27 11:41
wsn
Rank: 2
等 级:新手上路
威 望:5
帖 子:321
专家分:0
注 册:2006-2-9
收藏
得分:0 
退出操作系统可以调用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

3、编译成EXE,然后退出VB运行该EXE程序。
另外,可以参考徐景周的Shutdown.zip例子。
关闭应用程序可以利用SendKeys语句向该程序发送Alt+F4键或利用Windows API的SendMessage函数发送WM_QUIT消息。

已婚男人!没事请勿打扰·老婆格言:①不准對她耍酷 ②不准讓她吃醋 ③吵架我要讓步 ④揍我我要挺住⊙⊙
2006-02-27 11:44
Ver
Rank: 1
等 级:新手上路
帖 子:173
专家分:0
注 册:2006-2-8
收藏
得分:0 
ok

我用古老的咒语重温,吟唱灵魂序曲寻根 面对魔界的邪吻,不被污染的转身,维持纯白的象徵然后还原为人
2006-02-27 11:49
bluemoonte
Rank: 1
等 级:新手上路
帖 子:156
专家分:0
注 册:2006-2-12
收藏
得分:0 
看的我头晕呀,但是我还是谢谢各位大哥大姐了,小弟先收了回去慢慢拜读!再次诚挚的感谢各位!
2006-02-27 14:07
shiyide
Rank: 2
等 级:新手上路
威 望:4
帖 子:297
专家分:0
注 册:2006-2-22
收藏
得分:0 
虽然看不懂! 但是我也收下了`


顶~!

学好编程,为中国的软件事业出一份力。
2006-03-03 17:25
快速回复:一个菜鸟的问题!
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.044436 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved