VB:如何監聽打開的窗口和程序

 這個問題是CSDN網友MattHgh (黎明破曉前)提出來的，這個問題其實有很多種解決的辦法，這裏我用WH_SHELL鉤子解決，WH_SHELL鉤子可以獲得很多信息，比如窗口創建、窗口銷燬、窗口被激活、窗口的標題欄被重繪等等，但是這些信息都是基於窗口的，而MattHgh 希望同時獲得相應的程序。那麼怎麼根據窗口的句柄的句柄獲得對應的程序路徑呢，這個當然可以通過枚舉所有的進程獲得，不過這樣一來，速度就慢上一些了，我在程序中用到的是另外一種方法，這種方法儘管很平常，但我估計有些朋友可能還不知道，所以下面我用程序簡單的說明一下：

'根據窗口句柄獲取對應的程序路徑，只適用於NT平臺
Public Function GetEXEFromHandle(Optional ByVal nHWnd As Long = 0) As String
    Dim nProcID As Long
    Dim nResult As Long
    Dim nTemp As Long
    Dim lModules(1 To 200) As Long
    Dim sFile As String
    Dim hProcess As Long  '
    If nHWnd = 0 Then nHWnd = GetForegroundWindow()
    '獲得窗口的ProcessID
    If GetWindowThreadProcessId(nHWnd, nProcID) <> 0 Then
        '打開Process，獲得窗口對應的進程句柄
        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or _
        PROCESS_VM_READ, 0, nProcID)
        If hProcess <> 0 Then
            ' 獲得窗口對應的Module
            nResult = EnumProcessModules(hProcess, lModules(1), _
              200, nTemp)
            If nResult <> 0 Then
                 '獲得程序名
                sFile = Space$(260)
                nResult = GetModuleFileNameEx(hProcess, 0, sFile, Len(sFile))
                sFile = LCase$(Left$(sFile, nResult))
                GetEXEFromHandle = sFile
            End If
            '關閉Process
            CloseHandle hProcess
        End If
    End If
End Function

        請注意函數開始時的註釋，這種方法只適用於NT平臺，所以用win9x的朋友還是老老實實的枚舉進程吧，這樣的代碼在網上很容易找到，這裏我就不羅嗦了。
        下面說說WH_SHELL鉤子，MSDN上對這個鉤子的描述是這樣的：
WH_SHELL Hook

A shell application can use the WH_SHELL hook to receive important notifications. The system calls a WH_SHELL hook procedure when the shell application is about to be activated and when a top-level window is created or destroyed.

Note that custom shell applications do not receive WH_SHELL messages. Therefore, any application that registers itself as the default shell must call the SystemParametersInfo function with SPI_SETMINIMIZEDMETRICS before it (or any other application) can receive WH_SHELL messages.

        關於ShellProc Function的描述可以可以看這裏：[url]http://msdn.microsoft.com/library/en-us/winui/winui/windowsuserinterface/windowing/hooks/hookreference/hookfunctions/shellproc.asp?frame=true[/url]
        看到這裏，也許有朋友認爲，想鉤到其它程序的消息，需要一個額外的dll，這裏我明確的說，不需要額外的dll。事實上，在shell32.dll中有一個編號爲181號的api函數，他爲我們解決這個問題提供了強有力的支持，這個函數在vb中通常被聲明爲：
Declare Function RegisterShellHook Lib "Shell32" Alias "#181" (ByVal hwnd As Long, ByVal nAction As Long) As Long
其中hwnd爲窗口句柄，而nAction通常爲下面的常數：
Const RSH_DEREGISTER = 0
Const RSH_REGISTER = 1
Const RSH_REGISTER_PROGMAN = 2
Const RSH_REGISTER_TASKMAN = 3

      通過使用這個api函數，你就可以在你的程序中接收到其它程序的窗口創建，窗口銷燬等消息，需要注意的是，在默認情況下，你的程序是接收不到這些消息的，想要你的程序能夠接收到這些消息，你必須要用RegisterWindowMessage函數註冊一條名爲"SHELLHOOK"的消息。
        不過我的程序中使用的是另外一個api函數：RegisterShellHookWindow，這個函數的作用和我們上面聲明的 RegisterShellHook 函數的作用是一樣的，不過它只有一個參數，看起來更舒服一些，關於這個函數的消息說明可以看這裏：[url]http://msdn.microsoft.com/library/en-us/winui/winui/windowsuserinterface/windowing/hooks/hookreference/hookfunctions/registershellhookwindow.asp?frame=true[/url]
        按照MSDN的說明，這個函數需要在2000以上系統可以工作，我這裏暫時找不到2000，我可以肯定的說，它在我的xp sp2下工作的很好，如果在2000中它不能很好的工作，請用RegisterShellHook 代替程序中的RegisterShellHookWindow，好了廢話就說到這裏，下面給出代碼：
一個模塊，一個窗體（窗體名爲Form1，窗體上有一個listbox（List1）：

模塊代碼：
Option Explicit
Private 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
Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
    ByVal Hwnd As Long, ByVal lpString As String, _
    ByVal cch As Long) As Long

Private Declare Function RegisterWindowMessage Lib "user32" Alias _
    "RegisterWindowMessageA" (ByVal lpString As String) As Long

   
Private Declare Function SetWindowLong Lib "user32" Alias _
    "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long

Private Declare Function GetWindowLong Lib "user32" Alias _
    "GetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function RegisterShellHook Lib "Shell32" Alias "#181" _
    (ByVal Hwnd As Long, ByVal nAction As Long) As Long
   
Private Declare Function RegisterShellHookWindow Lib "user32" _
    (ByVal Hwnd As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () 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 EnumProcessModules Lib "psapi.dll" ( _
    ByVal hProcess As Long, _
    ByRef lphModule As Long, _
    ByVal cb As Long, _
    ByRef lpcbNeeded As Long) As Long

Private Declare Function GetModuleFileNameEx Lib "psapi.dll" _
    Alias "GetModuleFileNameExA" ( _
    ByVal hProcess As Long, _
    ByVal hModule As Long, _
    ByVal lpFilename As String, _
    ByVal nSize As Long) As Long

Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)

Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_READ = 16

Private Const HSHELL_WINDOWCREATED = 1
Private Const HSHELL_WINDOWDESTROYED = 2
Private Const HSHELL_ACTIVATESHELLWINDOW = 3
Private Const HSHELL_WINDOWACTIVATED = 4
Private Const HSHELL_GETMINRECT = 5
Private Const HSHELL_REDRAW = 6
Private Const HSHELL_TASKMAN = 7
Private Const HSHELL_LANGUAGE = 8

Private Const WM_NCDESTROY = &H82

Private Const GWL_WNDPROC = -4

Private Const WH_SHELL = 10
Private Const WH_CBT As Long = 5

Private Const GW_OWNER = 4
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_TOOLWINDOW = &H80
Private Const WS_EX_APPWINDOW = &H40000

Private Const RSH_DEREGISTER = 0
Private Const RSH_REGISTER = 1
Private Const RSH_REGISTER_PROGMAN = 2
Private Const RSH_REGISTER_TASKMAN = 3

Private lpPrevWndProc As Long
Public msgShellHook As Long

Public Sub Unhook(Hwnd As Long)
    'Call RegisterShellHook(Hwnd, RSH_DEREGISTER)
     SetWindowLong Hwnd, GWL_WNDPROC, lpPrevWndProc
End Sub

Public Sub StartHook(Hwnd As Long)
    msgShellHook = RegisterWindowMessage("SHELLHOOK")
    Dim hLibShell As Long
 
    RegisterShellHookWindow Hwnd
    'Call RegisterShellHook(Hwnd, RSH_REGISTER Or RSH_REGISTER_TASKMAN Or RSH_REGISTER_PROGMAN)
    lpPrevWndProc = SetWindowLong(Hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Private Function WindowProc(ByVal Hwnd As Long, ByVal uMsg As Long, _
  ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case uMsg
        Case WM_NCDESTROY
            Unhook Hwnd
        Case msgShellHook
            Select Case wParam
            Case HSHELL_WINDOWCREATED
                AddCREATEDstr lParam
            'Case HSHELL_WINDOWDESTROYED
                 '這裏沒有用，想用的話，添加你的代碼
            'Case HSHELL_REDRAW
              '這裏沒有用，想用的話，添加你的代碼
            'Case HSHELL_WINDOWACTIVATED
               '這裏沒有用，想用的話，添加你的代碼
            'Case HSHELL_GETMINRECT
                '這裏沒有用，想用的話，添加你的代碼
            'Case HSHELL_REDRAW
                 '這裏沒有用，想用的話，添加你的代碼
             'Case HSHELL_TASKMAN
                  '這裏沒有用，想用的話，添加你的代碼
             'Case HSHELL_LANGUAGE
                 '這裏沒有用，想用的話，添加你的代碼
            End Select
    End Select
    WindowProc = CallWindowProc(lpPrevWndProc, Hwnd, uMsg, wParam, lParam)
End Function

Private Function GetEXEFromHandle(Optional ByVal nHWnd As Long = 0) As String
    Dim nProcID As Long
    Dim nResult As Long
    Dim nTemp As Long
    Dim lModules(1 To 200) As Long
    Dim sFile As String
    Dim hProcess As Long  '
    If nHWnd = 0 Then nHWnd = GetForegroundWindow()
    If GetWindowThreadProcessId(nHWnd, nProcID) <> 0 Then
        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or _
        PROCESS_VM_READ, 0, nProcID)
        If hProcess <> 0 Then
            nResult = EnumProcessModules(hProcess, lModules(1), _
              200, nTemp)
            If nResult <> 0 Then
                sFile = Space$(260)
                nResult = GetModuleFileNameEx(hProcess, 0, sFile, Len(sFile))
                sFile = LCase$(Left$(sFile, nResult))
                GetEXEFromHandle = sFile
            End If
            CloseHandle hProcess
        End If
    End If
End Function

Private Function GetWindowCaption(ByVal Hwnd As Long) As String
    Dim MyStr As String
    MyStr = String(256, Chr$(0))    '
    GetWindowText Hwnd, MyStr, 256
    MyStr = Left$(MyStr, InStr(MyStr, Chr$(0)) - 1)
    GetWindowCaption = MyStr
   
End Function

Private Sub AddCREATEDstr(ByVal Hwnd As Long)
    If Hwnd = 0 Then Exit Sub
    Dim s As String
    s = Format(Now, "YYYY年MM月DD日 HH:MM:SS")
    Dim mCaption As String
    mCaption = GetWindowCaption(Hwnd)
    Dim exename As String
    exename = GetEXEFromHandle(Hwnd)
    If mCaption <> "" And exename <> "" Then
        s = s + " 句柄爲：" + CStr(Hwnd) + " 的窗口被創建，標題爲：" + mCaption + "  對應程序路徑爲：" + exename
    ElseIf mCaption = "" And exename <> "" Then
        s = s + " 句柄爲：" + CStr(Hwnd) + " 的窗口被創建，對應程序路徑爲：" + exename
    ElseIf mCaption <> "" And exename = "" Then
        s = s + " 句柄爲：" + CStr(Hwnd) + " 的窗口被創建，標題爲：" + mCaption
    ElseIf mCaption = "" And exename = "" Then
        s = s + " 句柄爲：" + CStr(Hwnd) + " 的窗口被創建"
    End If
    Form1.List1.AddItem s
End Sub

窗體代碼：
Option Explicit

Private Sub Form_Load()
    StartHook Me.Hwnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Unhook Me.Hwnd
End Sub

Private Sub Form_Resize()
  List1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub

Private Sub List1_Click()
    MsgBox List1.Text
End Sub