如何修正VB程序实现仅监听真实程序窗口的创建事件？

问题背景 #

目标 #

编写Visual Basic程序，在新的程序窗口（如文件资源管理器）显示时执行指定代码（例：弹出消息框）。

现有问题 #

• 原始代码会误触发上下文菜单、控件弹窗等非目标窗口的创建事件
• 尝试通过检查窗口的最小化/最大化/关闭按钮过滤时，合法程序窗口也无法触发

原始代码 #

Private Declare Function GetForegroundWindow Lib "user32.dll" () As IntPtr
Declare Auto Function SetWinEventHook Lib "user32.dll" (ByVal eventMin As Integer, ByVal eventMax As Integer, ByVal hmodWinEventProc As IntPtr, ByVal lpfnWinEventProc As WinEventDelegate, ByVal idProcess As Integer, ByVal idThread As Integer, ByVal dwflags As Integer) As IntPtr

Declare Auto Function UnhookWinEvent Lib "user32.dll" (ByVal hWinEventHook As IntPtr) As Boolean
Delegate Sub WinEventDelegate(ByVal hWinEventHook As IntPtr, ByVal eventType As Integer, ByVal hwnd As IntPtr, ByVal idObject As Integer, ByVal idChild As Integer, ByVal dwEventThread As Integer, ByVal dwmsEventTime As Integer)

Const WINEVENT_OUTOFCONTEXT As Integer = 0
Const EVENT_OBJECT_CREATE As Integer = &H8000

Private hook As IntPtr = IntPtr.Zero

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    hook = SetWinEventHook(EVENT_OBJECT_CREATE, EVENT_OBJECT_CREATE, IntPtr.Zero, AddressOf WinEventProc, 0, 0, WINEVENT_OUTOFCONTEXT)
End Sub

Private Sub Form1_FormClosed(sender As Object, e As FormClosedEventArgs) Handles MyBase.FormClosed
    UnhookWinEvent(hook)
End Sub

Private Sub WinEventProc(ByVal hWinEventHook As IntPtr, ByVal eventType As Integer, ByVal hwnd As IntPtr, ByVal idObject As Integer, ByVal idChild As Integer, ByVal dwEventThread As Integer, ByVal dwmsEventTime As Integer)
    Dim windowTitle As String = GetWindowText(hwnd)
    If windowTitle <> "" AndAlso IsPopupWindow(hwnd) Then
        msgbox("New Window Detected")
    End If
End Sub

Private Function IsPopupWindow(ByVal hwnd As IntPtr) As Boolean
    Dim style As Long = GetWindowLong(hwnd, GWL_STYLE)
    Return (style And WS_POPUP) = WS_POPUP
End Function

Declare Auto Function GetWindowLong Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal nIndex As Integer) As Integer
Private Const GWL_STYLE As Integer = -16
Private Const WS_POPUP As Long = &H80000000

Private Function GetWindowText(ByVal hwnd As IntPtr) As String
    Dim textLength As Integer = GetWindowTextLength(hwnd) + 1
    Dim text As String = New String(" "c, textLength)
    GetWindowText(hwnd, text, textLength)
    Return text.Trim()
End Function

Declare Auto Function GetWindowText Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal lpString As String, ByVal nMaxCount As Integer) As Integer
Declare Auto Function GetWindowTextLength Lib "user32.dll" (ByVal hWnd As IntPtr) As Integer

修复方案 #

关键修改点 #

1. 过滤顶级窗口对象：通过idObject = OBJID_WINDOW和idChild = 0判断仅监听顶级窗口的创建事件，排除子控件、菜单等对象
2. 修正窗口类型判断：替换原有的IsPopupWindow逻辑，检查窗口是否具备标准程序窗口风格（WS_OVERLAPPEDWINDOW），同时排除工具窗口、弹窗等非目标窗口
3. 补充必要的API常量：添加窗口扩展风格、对象ID等常量，确保判断准确

修复后的完整代码 #

Private Declare Function GetForegroundWindow Lib "user32.dll" () As IntPtr
Declare Auto Function SetWinEventHook Lib "user32.dll" (ByVal eventMin As Integer, ByVal eventMax As Integer, ByVal hmodWinEventProc As IntPtr, ByVal lpfnWinEventProc As WinEventDelegate, ByVal idProcess As Integer, ByVal idThread As Integer, ByVal dwflags As Integer) As IntPtr
Declare Auto Function UnhookWinEvent Lib "user32.dll" (ByVal hWinEventHook As IntPtr) As Boolean
Delegate Sub WinEventDelegate(ByVal hWinEventHook As IntPtr, ByVal eventType As Integer, ByVal hwnd As IntPtr, ByVal idObject As Integer, ByVal idChild As Integer, ByVal dwEventThread As Integer, ByVal dwmsEventTime As Integer)

' 核心常量补充
Const WINEVENT_OUTOFCONTEXT As Integer = 0
Const EVENT_OBJECT_CREATE As Integer = &H8000
Const OBJID_WINDOW As Integer = 0 ' 顶级窗口对象ID
Const GWL_STYLE As Integer = -16
Const GWL_EXSTYLE As Integer = -20
Const WS_OVERLAPPEDWINDOW As Integer = &HC00000 ' 标准程序窗口风格
Const WS_EX_TOOLWINDOW As Integer = &H80 ' 工具窗口扩展风格
Const WS_EX_APPWINDOW As Integer = &H40000 ' 应用窗口扩展风格

Private hook As IntPtr = IntPtr.Zero

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    hook = SetWinEventHook(EVENT_OBJECT_CREATE, EVENT_OBJECT_CREATE, IntPtr.Zero, AddressOf WinEventProc, 0, 0, WINEVENT_OUTOFCONTEXT)
End Sub

Private Sub Form1_FormClosed(sender As Object, e As FormClosedEventArgs) Handles MyBase.FormClosed
    UnhookWinEvent(hook)
End Sub

Private Sub WinEventProc(ByVal hWinEventHook As IntPtr, ByVal eventType As Integer, ByVal hwnd As IntPtr, ByVal idObject As Integer, ByVal idChild As Integer, ByVal dwEventThread As Integer, ByVal dwmsEventTime As Integer)
    ' 仅处理顶级窗口创建事件
    If idObject <> OBJID_WINDOW Or idChild <> 0 Then Return

    Dim windowTitle As String = GetWindowText(hwnd)
    ' 过滤空标题窗口，仅识别标准程序窗口
    If windowTitle <> "" AndAlso IsValidProgramWindow(hwnd) Then
        MsgBox($"New Window Detected: {windowTitle}")
    End If
End Sub

Private Function IsValidProgramWindow(ByVal hwnd As IntPtr) As Boolean
    ' 获取窗口基础风格
    Dim windowStyle As Integer = GetWindowLong(hwnd, GWL_STYLE)
    ' 获取窗口扩展风格
    Dim windowExStyle As Integer = GetWindowLong(hwnd, GWL_EXSTYLE)

    ' 判断是否为标准程序窗口：具备WS_OVERLAPPEDWINDOW风格，且不是工具窗口
    ' 同时排除无标题栏的弹窗
    Return (windowStyle And WS_OVERLAPPEDWINDOW) = WS_OVERLAPPEDWINDOW AndAlso
           (windowExStyle And WS_EX_TOOLWINDOW) = 0 AndAlso
           Not String.IsNullOrEmpty(GetWindowText(hwnd))
End Function

' 保留原有窗口文本获取函数
Private Function GetWindowText(ByVal hwnd As IntPtr) As String
    Dim textLength As Integer = GetWindowTextLength(hwnd) + 1
    Dim text As String = New String(" "c, textLength)
    GetWindowText(hwnd, text, textLength)
    Return text.Trim()
End Function

Declare Auto Function GetWindowLong Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal nIndex As Integer) As Integer
Declare Auto Function GetWindowText Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal lpString As String, ByVal nMaxCount As Integer) As Integer
Declare Auto Function GetWindowTextLength Lib "user32.dll" (ByVal hWnd As IntPtr) As Integer

说明 #

• OBJID_WINDOW = 0确保仅处理顶级窗口对象，排除菜单、按钮等子控件的创建事件
• WS_OVERLAPPEDWINDOW是标准程序窗口的标识，包含标题栏、最小化/最大化/关闭按钮
• WS_EX_TOOLWINDOW过滤掉工具栏、小弹窗这类非独立程序窗口
• 如果需要更精准的过滤，可以添加GetWindowThreadProcessId获取进程信息，排除系统进程窗口

内容的提问来源于stack exchange，提问作者Barfunkle