VB,为什么有VB做阻止关机的程序?

已举报 回答
VB,为什么有VB做阻止关机的程序?
问在线客服
扫码问在线客服
  • 回答数

    7

  • 浏览数

    5,625

7个回答 默认排序
  • 默认排序
  • 按时间排序

已采纳
来源:网络精英

在关机或Logff前信息的拦截

如果我们关机或Logoff时,我们的程序有时会因而无法按正常程序结束,一般我们会在Form的Unload中一段程序结束时要做什么事,但是,如果使用者直接用开始功能菜单的关机,会使UnLoad的部份没有做到,我们现在就想办法来拦截关机(或Logoff)时的信息。

一般来说,关机或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中则CheckwParam = 0 菜单False ,0菜单True),说到这里大概就知道该如何做啦,程序如下:

’以下在Form
Private Sub Form_Load()
Dim ret As Long 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
Dim fno As Long

’取消Message的截取,而使之又只送往原来的Window Procedure
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)

’这里只是要看看用关机的方式结束程序时,会不会执行到这里
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 2
取消 评论
在进程里把他找出来,右键结束进程咯。
取消 评论
Private Sub Form_Load()
Timer1.Enabled = True '可用
Timer1.Interval = 1000 '一秒种触发一次
End Sub

Private Sub Timer1_Timer()
Static n% '静态变量
n = n + 1 '1秒钟加1
Label1.Caption = (30 - n) & 秒 '剩余时间
If n = 30 Then '30秒后关机
Shell shutdown -s -t 0 '关机
'Shell shutdown -r -t 0 '重启
'Shell shutdown -l -t 0 '注销
End If
End Sub
取消 评论
y有难度
取消 评论
Declare Function ExitWindowsEx Lib user32 (ByVal uFlags As Long, ByVal dwReserved As Long) As Long

'ExitWindowsEx的参数uflags,有四个对应值,分别是:

Public Const EWX_LOGOFF = 0 '退出(注销)
Public Const EWX_SHUTDOWN = 1 '关机
Public Const EWX_REBOOT = 2 '重启动
Public Const EWX_FORCE = 4 '强制关机,即不通知现在活动应用程序让其先自我关闭

Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const TOKEN_QUERY = &H8
Public Const SE_PRIVILEGE_ENABLED = &H2
Public Const ANYSIZE_ARRAY = 1

Type LUID
lowpart As Long
highpart As Long
End Type

Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type

Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

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

'这个函数就是用于NT关机中使用的
Sub AdjustTokenPrivilegesForNT()

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

LookupPrivilegeValue , SeShutdownPrivilege, tmpLuid
tkp.PrivilegeCount = 1
tkp.Privileges(0).pLuid = tmpLuid
tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED

AdjustTokenPrivileges hdlTokenHandle, False, tkp, _
Len(tkpNewButIgnored), tkpNewButIgnored, _
lBufferNeeded
End Sub

Sub main()
AdjustTokenPrivilegesForNT '在95/98中调用没作用,但为了和NT兼容,写上无妨
ExitWindowsEx EWX_SHUTDOWN, 0 '这里将uFlgs换成以上面标记蓝色字中所提到的四个参数之一即可
'下面为举例
'ExitWindowsEx EWX_FORCE, 0 强迫关机(就是不管有无要保存的东西而强行关闭)

'ExitWindowsEx EWX_LOGOFF, 0 退出(注销)
End Sub
取消 评论
Private Declare Function SetProcessShutdownParameters Lib kernel32 (ByVal dwLevel As Long, ByVal dwFlags As Long) As Long private sub command1_click() Call SetProcessShutdownParameters(1279, 0&) end sub private sub command2_click() '这个好像阻止不了 end sub
取消 评论
这个太难了。不是给分就能解决的。。。。
取消 评论
ZOL问答 > VB,为什么有VB做阻止关机的程序?

举报

感谢您为社区的和谐贡献力量请选择举报类型

举报成功

经过核实后将会做出处理
感谢您为社区和谐做出贡献

扫码参与新品0元试用
晒单、顶楼豪礼等你拿

扫一扫,关注我们
提示

确定要取消此次报名,退出该活动?