' Folgender Code in ein Modul
' ---------------------------
 
Option Explicit
 
'Windows API
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 GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal _
  hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal _
  lpLibFileName As String) As Long
Declare Function RegisterWindowMessage Lib "user32" Alias _
  "RegisterWindowMessageA" (ByVal lpString As String) As Long
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
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal _
  hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
 
'Undocumented (at least that I could find) Windows API.
'  Use with caution
Declare Function RegisterShellHookWindow Lib "user32" (ByVal hWnd As _
  Long) As Long
 
'Constants for Windows API
Public Const HSHELL_WINDOWCREATED = 1
Public Const HSHELL_WINDOWDESTROYED = 2
Public Const HSHELL_ACTIVATESHELLWINDOW = 3
Public Const HSHELL_WINDOWACTIVATED = 4
Public Const HSHELL_GETMINRECT = 5
Public Const HSHELL_REDRAW = 6
Public Const HSHELL_TASKMAN = 7
Public Const HSHELL_LANGUAGE = 8
 
Public Const WM_NCDESTROY = &H82
 
Public Const GWL_WNDPROC = -4
 
Public Const WH_SHELL = 10
 
'Variables
Private lpPrevWndProc As Long ' Address of previos window proc
Private msgShellHook As Long  ' Msg number of "SHELLHOOK" message
 
'Start the subclassing of the window
Public Sub Hook(hWnd As Long)
  lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
 
'Stop the subclasing of the window
Public Sub Unhook(hWnd As Long)
  SetWindowLong hWnd, GWL_WNDPROC, lpPrevWndProc
End Sub
 
'Main Entry point.  Setup the system wide WH_SHELL hook, and start the
'  subclassing of the form to view messages.
Public Sub StartHook(hWnd As Long)
 
  'This is the message that Shell32's ShellHookProc sends us whenever
  '  a shell hook occurs
  msgShellHook = RegisterWindowMessage("SHELLHOOK")
 
  'Load the Shell32 library, and find the ShellHookProc so we can pass
  '  it to SetWindowsHookEx to create the Shell Hook
  Dim hLibShell As Long
  Dim lpHookProc As Long
 
  hLibShell = LoadLibrary("shell32.dll")
  lpHookProc = GetProcAddress(hLibShell, "ShellHookProc")
 
  'Initialize ShellHookProc
  RegisterShellHookWindow hWnd
 
  SetWindowsHookEx WH_SHELL, lpHookProc, hLibShell, 0
 
  'Start the subclassing of the window so we get the "SHELLHOOK" '
  '  messages generated from ShellHookProc
  Hook hWnd
 
End Sub
 
'Subclassing procedure, look for "SHELLHOOK" messages and process
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  'If we receive this message, unhook our subclassing
                       '  routing, to prevent crashing the app as it closes
      Unhook hWnd
    Case msgShellHook  'This is the message generated from Shell32's
                       '  ShellHookProc, decode it, and send the results
                       '  up to the From1's handlers
      Select Case wParam
        Case HSHELL_WINDOWCREATED
          ' Code wenn ein Fenster erstellt wurde
 
        Case HSHELL_WINDOWDESTROYED
          ' Code wenn ein Fenster zerstört wurde
 
        Case HSHELL_REDRAW
          ' Code wenn ein Fenster neu gezeichnet wird
 
        Case HSHELL_WINDOWACTIVATED
          ' Code wenn ein Fenster aktiviert wird
 
      End Select
  End Select
 
  WindowProc = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wParam, lParam)
End Function
 
' ------------------
' End of module code
 
' Begin of Form-Code
' ---------------------------
Option Explicit
 
Private hWndOldActive As Long
 
'On form load, start the subclassing of the window,
'  as well as the shell hook
Private Sub Form_Load()
  StartHook Me.hWnd
End Sub
 
'On form exit, stop the subclassing
Private Sub Form_Unload(Cancel As Integer)
  Unhook Me.hWnd
End Sub
 
' End of form code