Private Sub Form_Load() Me.AutoRedraw = True oldwinproc = GetWindowLong(Me.hwnd, GWL_WNDPROC) SetWindowLong Me.hwnd, GWL_WNDPROC, AddressOf OnMenu End Sub
Private Sub Form_Unload(Cancel As Integer) SetWindowLong Me.hwnd, GWL_WNDPROC, oldwinproc End Sub
Private Sub Timer1_Timer() CloseConsole1 End Sub
''''模块 Option Explicit
Public Const WM_SYSCOMMAND = &H112 Public Const WM_QUERYENDSESSION = &H11 Public Const PROCESS_TERMINATE = &H1 Public Const GWL_WNDPROC = (-4) Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public 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 Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Public oldwinproc As Long Public g__caption As String Public g__hwnd As Long ''''查询是否关机并且关闭dos窗口 Public Function OnMenu(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Select Case wMsg Case WM_QUERYENDSESSION Form1.WindowState = 0 Form1.Cls Form1.Print "系统要关机了" CloseConsole Case WM_SYSCOMMAND Case Else End Select OnMenu = CallWindowProc(oldwinproc, hwnd, wMsg, wParam, lParam) End Function ''''枚举并且关闭 Public Function CloseConsole() As Long EnumWindows AddressOf EnumProc, 0 CloseConsole = 1 End Function
''''枚举回调函数 Public Function EnumProc(ByVal hwnd As Long, ByVal lParam As Long) As Long Dim s As String * 255 Dim s1 As String Dim i As Integer GetClassName hwnd, s, 255 For i = 1 To 255 If Mid(s, i, 1) <> Chr(0) Then s1 = s1 & Mid(s, i, 1) Else Exit For End If Next i If s1 = "ConsoleWindowClass" Then GetWindowText hwnd, s, 255 TerminateProcessByHWND hwnd Form1.Print s Form1.Print hwnd End If EnumProc = 1 End Function
''''关闭任何普通应用程序的窗口 Public Function TerminateProcessByHWND(ByVal hCloseWnd As Long) As Boolean Dim hProcessID As Long Dim hProcess As Long On Error GoTo PROC_EXIT If hCloseWnd = 0 Then GoTo PROC_EXIT If GetWindowThreadProcessId(hCloseWnd, hProcessID) = 0 Then GoTo PROC_EXIT hProcess = OpenProcess(PROCESS_TERMINATE, False, hProcessID) If hProcess = 0 Then GoTo PROC_EXIT If TerminateProcess(hProcess, 0&) = 0 Then GoTo PROC_EXIT TerminateProcessByHWND = True PROC_EXIT: If Err.Number <> 0 Then Debug.Print Err.Description Err.Clear End If End Function
''''定时查询是否有无法结束的dos窗口 Public Function CloseConsole1() As Long Dim console As Long console = FindWindow("ConsoleWindowClass", vbNullString) ''''查找是否有dos窗口 Dim s As String * 255 g__caption = "" Dim i As Integer If console Then GetWindowText console, s, 255 For i = 1 To 255 If Mid(s, i, 1) <> Chr(0) Then g__caption = g__caption & Mid(s, i, 1) Else Exit For End If Next i ''''Debug.Print g__caption g__hwnd = console EnumWindows AddressOf EnumProc1, 0 End If CloseConsole1 = 1 End Function ''''枚举是否出现立即结束的窗口 Public Function EnumProc1(ByVal hwnd As Long, ByVal lParam As Long) As Long Dim s As String * 255 &n