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的描述可以可以看這裡：http://msdn.microsoft.com/library/en-us/winui/winui/windowsuserinterface/windowing/hooks/hookreference/hookfunctions/shellproc.asp?frame=true
        看到這裡，也許有朋友認為，想鉤到其它程式的訊息，需要一個額外的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 函數的作用是一樣的，不過它只有一個參數，看起來更舒服一些，關於這個函數的訊息說明可以看這裡：http://msdn.microsoft.com/library/en-us/winui/winui/windowsuserinterface/windowing/hooks/hookreference/hookfunctions/registershellhookwindow.asp?frame=true
        按照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