’以下在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
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
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