'根据窗口句柄获取对应的程序路径，只适用于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
