Visual Basic

Option Explicit

Private Type CWPSTRUCT
    lParam As Long
    wParam As Long
    message As Long
    hwnd As Long
End Type

Private Type CREATESTRUCT
    lpCreateParams As Long
    hInstance As Long
    hMenu As Long
    hWndParent As Long
    cy As Long
    cx As Long
    y As Long
    x As Long
    style As Long
    lpszName As Long    ' String
    lpszClass As Long   ' String
    ExStyle As Long
End Type

Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private Const WH_CALLWNDPROC = 4
Private Const WS_EX_APPWINDOW = &H40000
Private Const WS_EX_TOOLWINDOW = &H80&

' VB5 & VB6 class names:
Private Const C_MDIFORMCLASS_IDE = "ThunderMDIForm"
Private Const C_MDIFORMCLASS_EXE = "ThunderRT6MDIForm"
Private Const C_MDIFORMCLASS5_IDE = "ThunderMDIForm"
Private Const C_MDIFORMCLASS5_EXE = "ThunderRT5MDIForm"
 
Private Const C_FORMCLASS_IDE_DC = "ThunderFormDC"
Private Const C_FORMCLASS_EXE_DC = "ThunderRT6FormDC"
Private Const C_FORMCLASS_IDE = "ThunderForm"
Private Const C_FORMCLASS_EXE = "ThunderRT6Form"
Private Const C_FORMCLASS5_IDE = "ThunderForm"
Private Const C_FORMCLASS5_EXE = "ThunderRT5Form"

Private m_hHook As Long
Private m_lHookWndProc As Long
<BR><BR>
Private Function Form_WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lSetStyleEX As Long
   ' SPM - specific wnd proc for a form.  Only called once for the WM_CREATE message.
   Select Case Msg
   Case WM_CREATE
      Dim tCS As CREATESTRUCT
      CopyMemory tCS, ByVal lParam, Len(tCS)
      lSetStyleEX = GetWindowLong(hwnd, GWL_EXSTYLE)
      lSetStyleEX = lSetStyleEX Or WS_EX_APPWINDOW
      lSetStyleEX = lSetStyleEX And (Not WS_EX_TOOLWINDOW)
      tCS.ExStyle = lSetStyleEX
      CopyMemory ByVal lParam, tCS, Len(tCS)
      SetWindowLong hwnd, GWL_WNDPROC, m_lHookWndProc
      SetWindowLong hwnd, GWL_EXSTYLE, tCS.ExStyle
   End Select
   Form_WndProc = CallWindowProc(m_lHookWndProc, hwnd, Msg, wParam, lParam)
End Function
<BR><BR>
Private Function AppHook(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim CWP As CWPSTRUCT
Dim k As Long, aClass As String
    
   If idHook >= 0 Then
      CopyMemory CWP, ByVal lParam, Len(CWP)
      Select Case CWP.message
      Case WM_CREATE
          aClass = Space$(128)
          k = GetClassName(CWP.hwnd, ByVal aClass, 128)
          aClass = Left$(aClass, k)
          If IsIn(aClass, C_MDIFORMCLASS_IDE, C_MDIFORMCLASS_EXE, C_MDIFORMCLASS5_IDE, _
              C_MDIFORMCLASS5_EXE, C_FORMCLASS_IDE_DC, C_FORMCLASS_EXE_DC, C_FORMCLASS_IDE, _
              C_FORMCLASS_EXE, C_FORMCLASS5_IDE, C_FORMCLASS5_EXE) Then
             m_lHookWndProc = SetWindowLong(CWP.hwnd, GWL_WNDPROC, AddressOf Form_WndProc)
          End If
      End Select
   End If
   AppHook = CallNextHookEx(m_hHook, idHook, wParam, ByVal lParam)
End Function
<BR><BR>
Private Function IsIn(ByVal vComp As Variant, ParamArray vTo() As Variant) As Boolean
Dim i As Long, iL As Long, iU As Long
   On Error Resume Next
   iU = UBound(vTo)
   If Err.Number = 0 Then
      iL = LBound(vTo)
      For i = iL To iU
         If vComp = vTo(i) Then
            IsIn = True
            Exit Function
         End If
      Next i
   End If
End Function
<BR><BR>
Public Sub HookAttach()
   m_hHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf AppHook, App.hInstance, App.ThreadID)
End Sub
<BR><BR>
Public Sub HookDetach()
   If m_hHook <> 0 Then
      UnhookWindowsHookEx m_hHook
      m_hHook = 0
   End If
End Sub