怎么用vb做一个的关机程序。

[davyyan]

我想知道用VB做的一个关机程序代码点写，不是象WINDOWS关机那样选择性的程序，而是退出窗口即自动关机的。

[youchenglong]

转载：这是个强力关机的，就像关电源，嘿嘿
一般来说,关机或Logff後,Windows会传依序送出WM_QUERYENDSESSION的讯息给每个
Process,如果中间有一个Process不能顺利结束(例如：Word修改後未存档,而出现是
否存档,但我们按取消),这时该讯息执行的结果会传回False(0),这时Windows也就
不再继续送WM_QUERYENDSESSION给下一个Proccess。反之,如果所有的Process都可以
顺利结束(也就是每个送出的WM_QUERYENDSESSION都传回True),那才代表可以顺利结束。

不管WM_QUERYENDSESSION最後的结果是可以顺利结束或不能顺利结束,Windows会再送
一个WM_ENDSESSION的讯息给所有的Process,而wParam的内容便是指出是否可以顺利
结束(True表可以,False表不行,在vb中则Check wParam = 0 表False ,<> 0表True)
,说到这里大概就知道该如何做啦,程式如下：
'以下在Form
Private Sub Form_Load()
Dim ret As Long
'记录原本的Window Procedure的位址
preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
'设定form的window Procedure到wndproc
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf wndproc)
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim ret As Long
'取消Message的截取,而使之又只送往原来的Window Procedure
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)
'这里只是要看看用关机的方式结束程式时,会不会执行到这里
Dim fno As Long
fno = FreeFile
Open "c:\tt2" For Append As fno
Print #fno, "ccc" + vbCrLf
Close #fno
End Sub

'以下在.Bas
Option Explicit

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long

Public Const GWL_WNDPROC = (-4)
Public Const WM_ENDSESSION = &H16
Public Const WM_QUERYENDSESSION = &H11

Public preWinProc As Long

Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_QUERYENDSESSION Then
Debug.Print "QryEnd", wParam, lParam
Else
If Msg = WM_ENDSESSION Then
If wParam <> 0 Then '代表将顺利关机或LogOff,这时便得做正常结束程式的动作
Dim fno As Long
Open "c:\ttt" For Output As #1
Print #1, "hahcccc5"
Close #1
End If
End If
End If
'将之送往原来的Window Procedure
wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function

[Girl1983]

http://tech.163.com/tm/010718/010718_26982.html

[用户 昵称]

try this
----------------------------------------------------------------------
退出操作系统可以调用Windows API的ExitWindowsEx函数。
例子：
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

'The ExitWindowsEx function either logs off, shuts down, or shuts
'down and restarts the system.
Private Declare Function ExitWindowsEx Lib "user32" _
(ByVal dwOptions As Long, _
ByVal dwReserved As Long) As Long

'The GetLastError function returns the calling thread's last-error
'code value. The last-error code is maintained on a per-thread basis.
'Multiple threads do not overwrite each other's last-error code.
Private Declare Function GetLastError Lib "kernel32" () As Long

Private Const mlngWindows95 = 0
Private Const mlngWindowsNT = 1

Public glngWhichWindows32 As Long

'The GetVersion function returns the operating system in use.
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

'The GetCurrentProcess function returns a pseudohandle for the
'current process.
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

'The OpenProcessToken function opens the access token associated with
'a process.
Private Declare Function OpenProcessToken Lib "advapi32" _
(ByVal ProcessHandle As Long, _
ByVal DesiredAccess As Long, _
TokenHandle As Long) As Long

'The LookupPrivilegeValue function retrieves the locally unique
'identifier (LUID) used on a specified system to locally represent
'the specified privilege name.
Private Declare Function LookupPrivilegeValue Lib "advapi32" _
Alias "LookupPrivilegeValueA" _
(ByVal lpSystemName As String, _
ByVal lpName As String, _
lpLuid As LUID) As Long

'The AdjustTokenPrivileges function enables or disables privileges
'in the specified access token. Enabling or disabling privileges
'in an access token requires TOKEN_ADJUST_PRIVILEGES access.
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()

'********************************************************************
'* This procedure sets the proper privileges to allow a log off or a
'* shut down to occur under 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

'Set the error code of the last thread to zero using the
'SetLast Error function. Do this so that the GetLastError
'function does not return a value other than zero for no
'apparent reason.
SetLastError 0

'Use the GetCurrentProcess function to set the hdlProcessHandle
'variable.
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

'Get the LUID for shutdown privilege
LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid

If GetLastError <> 0 Then
MsgBox "LookupPrivilegeValue error==" & GetLastError
End If

tkp.PrivilegeCount = 1 ' One privilege to set
tkp.TheLuid = tmpLuid
tkp.Attributes = SE_PRIVILEGE_ENABLED

'Enable the shutdown privilege in the access token of this process
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's GetLastError " & GetLastError

End Sub

Private Sub cmdShutdown_Click()

If glngWhichWindows32 = mlngWindowsNT Then
AdjustToken
MsgBox "Post-AdjustToken GetLastError " & GetLastError
End If

ExitWindowsEx (EWX_SHUTDOWN), &HFFFF
MsgBox "ExitWindowsEx's GetLastError " & GetLastError

End Sub

Private Sub cmdForceShutdown_Click()
If glngWhichWindows32 = mlngWindowsNT Then
AdjustToken
MsgBox "Post-AdjustToken GetLastError " & GetLastError
End If

ExitWindowsEx (EWX_SHUTDOWN Or EWX_FORCE), &HFFFF
MsgBox "ExitWindowsEx's GetLastError " & GetLastError

End Sub

Private Sub Form_Load()
'********************************************************************
'* When the project starts, check the operating system used by
'* calling the GetVersion function.
'********************************************************************
Dim lngVersion As Long

lngVersion = GetVersion()

If ((lngVersion And &H80000000) = 0) Then
glngWhichWindows32 = mlngWindowsNT
MsgBox "Running Windows NT or Windows 2000"
Else
glngWhichWindows32 = mlngWindows95
MsgBox "Running Windows 95/98/Me"
End If

End Sub

3、编译成EXE，然后退出VB运行该EXE程序

[youchenglong]

form_unload里写

[davyyan]

我试过了，在WIN98里面可以通过，但在WIN2000里却一点反应都没有，怎么办？

[davyyan]

TO youchenglong(小志)：
你的——（'以下在.Bas）是什么意思？不好意思，我看不明白，是不是也是用按钮来实现，那么里面应该怎么写？

[用户 昵称]

'以下在.Bas说明要建立一个模块，扩展名为.bas，工程-〉右键-〉add(添加）->module（模块）
重启Windows 2000/NT系统

作者: MadAd 　

　
　Reboots a Windows 2000 PC. Many examples shell to the kernel and just kill the PC. This does it properly and takes into account a user privilages.

'API Calls used for RebootPC

Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const EWX_SHUTDOWN As Long = 1
Private Const EWX_FORCE As Long = 4
Private Const EWX_REBOOT = 2


Private Type LUID
　UsedPart As Long
　IgnoredForNowHigh32BitPart As Long
End Type

Private Type TOKEN_PRIVILEGES
　PrivilegeCount As Long
　TheLuid As LUID
　Attributes As Long
End Type

Private Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
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


Sub RebootPC()
　On Local Error GoTo RebootPC_ErrorHandler
　Const csProcName = "RebootPC"
　
　Dim hProcessHandle As Long
　Dim hTokenHandle As Long
　Dim tmpLuid As LUID
　Dim tkpNew As TOKEN_PRIVILEGES
　Dim tkpPrevious As TOKEN_PRIVILEGES
　Dim lBufferNeeded As Long

　hProcessHandle = GetCurrentProcess()
　Call OpenProcessToken(hProcessHandle, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hTokenHandle)

' Get the LUID for the shutdown privilege
　Call LookupPrivilegeValue("", "SeShutdownPrivilege", tmpLuid)

　tkpNew.PrivilegeCount = 1 ' One privilege to set
　tkpNew.TheLuid = tmpLuid
　tkpNew.Attributes = SE_PRIVILEGE_ENABLED

' Enable the shutdown privilege in the access token of this process.
　lBufferNeeded = 0
　Call AdjustTokenPrivileges(hTokenHandle, False, tkpNew, Len(tkpPrevious), tkpPrevious, lBufferNeeded)

' Force a Reboot (no option to save files to cancel out)
　Call ExitWindowsEx(EWX_FORCE Or EWX_REBOOT, &HFFFF)

　Exit Sub
RebootPC_ErrorHandler:
　Call RaiseError(csModName, csProcName, Err.Number, Err.Description)
End Sub

[davyyan]

我不用按扭，想用程序左上角的文件-退出一键来实现，那在MOUSE_CLICK()是不是也象按钮这样写？

[leesnet]

我也是

[davyyan]

能否有个源程序参考一下？？

[liangfang]

Private Type LUID
UsedPart As Long
IgnoredForNowHigh32BitPart As Long
End Type

Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
TheLuid As LUID
Attributes As Long
End Type

Private Declare Function ExitWindowsEx Lib "user32" (ByVal _
dwOptions As Long, ByVal dwReserved As Long) As Long

Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal _
ProcessHandle As Long, _
ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" _
Alias "LookupPrivilegeValueA" _
(ByVal lpSystemName As String, ByVal lpName As String, lpLuid _
As LUID) As Long
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

Const EWX_SHUTDOWN = 1

Const EWX_POWEROFF=8'常数


Private Sub AdjustToken()
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

hdlProcessHandle = GetCurrentProcess()
OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or _
TOKEN_QUERY), hdlTokenHandle

' Get the LUID for shutdown privilege.
LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid

tkp.PrivilegeCount = 1 ' One privilege to set
tkp.TheLuid = tmpLuid
tkp.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 Sub Form_Unload(Cancel As Integer)
AdjustToken ‘ 如果不是98的 就要用这个
ExitWindowsEx 8, 0
End Sub