Visual Basic Hook Routines
SetWindowsHookEx: 'Self-Closing' Message Box using a VB Timer
Posted:   Saturday March 24, 2001
Updated:   Monday December 26, 2011
Applies to:   VB5, VB6
Developed with:   VB6, Windows 2000
OS restrictions:   None
Author:   VBnet - Randy Birch


SetWindowsHookEx: 'Self-Closing' Message Box using a VB Timer
SetWindowsHookEx: 'Self-Closing' Message Box using SetTimer
SetWindowsHookEx: Detect Caps/Numlock/Scrollock via System-wide Keyboard Hook
SetWindowsHookEx: Customize the API Message Box
SetWindowsHookEx: Trapping Special Key Events using Low Level Hooks
MessageBoxEx: Displaying an API-created Message Box
VB5 / VB6.

Using a window hook to control display of an API-generated message box is not a difficult task in VB, as SetWindowsHookEx: Customize the API Message Box has shown. This code shows how to use the above methods to present a message box that performs in a non-standard fashion.

Like the above example, this code uses a hook procedure created with SetWindowsHookEx to catch the creation of the message box and perform changes to its interface prior to display -- the captions of the messagebox buttons are changed to better reflect the purpose of the dialog. The hook is then terminated. But the code goes further-- it also starts a timer on the form whose Timer event changes the text displayed once per interval - in this case once per second - creating a "countdown" message box.

In calling the initial code, the developer specifies which of the buttons presented represents the 'default' action to be taken in case the timer elapses without user intervention.  When this occurs, the Timer event uses GetDlgItem to retrieve the handle of the 'default action' button specified through the dwTimerExpireButton flag, calling PostMessage to send that button a pair of  WM_LBUTTONDOWN and WM_LBUTTONUP messages. The effect is to dismiss the dialog through code as if the user had pressed the button specified, thereby executing any code in the app conditional on a button press. Should the user press a button during the messagebox display, the timer is stopped and the button pressed is returned as usual.

This demo uses three buttons on the dialog -- I chose to use the About-Retry-Ignore set for no specific reason, so the Yes-No-Cancel set could have been used instead. But in order for the working code to accurately reflect the purpose of the altered buttons (read "to avoid confusion"), I defined three new constants - IDSELECT, IDBEGIN and IDSKIP - and assigned the Windows-defined constant values for IDABORT, IDRETRY and IDIGNORE to them. You'll see the use in the Command1_Click event and the hook proc. Debugging the app will be easier - especially in the future - when encountering the line "dwTimerExpireButton = IDBEGIN" rather than the line "dwTimerExpireButton = IDRETRY".

To show how little code is needed to actually perform this demo, I have only provided the declares for functions and constants actually used. You can grab the complete set from the API viewer, or from the MessageBoxEx example page here in the sample MessageBoxEx: Displaying an API-created Message Box.

Note: Kaushik Dalwadi has emailed me to point out an issue with this and the timed API messagebox routines. When a single button is required, MB_OK is passed as part of the .dwFlags member, and one would think that IDOK would then be specified as the .dwTimerExpire member. In reality, however, the ID of the actual button on the single-button messagebox is 2, not 1.  Therefore, to display a one-button messagebox, pass MB_OK as part of dwFlags, and define a new constant - perhaps IDTIMEDOK = 2 - and assign that to dwTimerExpire instead of IDOK.

 BAS Module Code
Place the following code into the general declarations area of a bas module:

Option Explicit
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
'needed public for the Timer event
Public hwndMsgBox As Long

'custom user-defined type to pass
'info between procedures - easier than
'passing a long list of variables.
'Needed public for the Timer event
   hOwnerThread         As Long
   hOwnerWindow         As Long
   dwStyle              As Long
   bUseTimer            As Boolean
   dwTimerDuration      As Long
   dwTimerInterval      As Long
   dwTimerExpireButton  As Long
   dwTimerCountDown     As Long
   sTitle               As String
   sPrompt              As String
End Type


'Windows-defined uType parameters
Public Const MB_ICONINFORMATION As Long = &H40&
Private Const MB_ABORTRETRYIGNORE As Long = &H2&
Private Const MB_TASKMODAL As Long = &H2000&

'Windows-defined MessageBox return values
Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const IDABORT = 3
Private Const IDRETRY = 4
Private Const IDIGNORE = 5
Private Const IDYES = 6
Private Const IDNO = 7

'This section contains user-defined constants
'to represent the buttons/actions we are
'creating, based on the existing MessageBox
'constants. Doing this makes the code in
'the calling procedures more readable, since
'the messages match the buttons we're creating.
Public Const IDPROMPT = &HFFFF&

'misc API constants
Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_ACTIVATE = 5
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202

'UDT for passing data through the hook
   hwndOwner   As Long
   hHook       As Long
End Type

'need this declared at module level as
'it is used in the call and the hook proc

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Public Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function GetWindowLong Lib "user32" _
   Alias "GetWindowLongA" _
  (ByVal hwnd As Long, _
   ByVal nIndex As Long) As Long

Public Declare Function GetDlgItem Lib "user32" _
  (ByVal hDlg As Long, _
   ByVal nIDDlgItem As Long) As Long
Private Declare Function MessageBox Lib "user32" _
   Alias "MessageBoxA" _
  (ByVal hwnd As Long, _
   ByVal lpText As String, _
   ByVal lpCaption As String, _
   ByVal wType As Long) As Long
Public Declare Function PostMessage Lib "user32" _
   Alias "PostMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, lParam As Long) As Long
Public Declare Function PutFocus Lib "user32" _
   Alias "SetFocus" _
  (ByVal hwnd As Long) As Long
Public Declare Function SetDlgItemText Lib "user32" _
   Alias "SetDlgItemTextA" _
  (ByVal hDlg As Long, _
   ByVal nIDDlgItem As Long, _
   ByVal lpString As String) 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 SetWindowText Lib "user32" _
   Alias "SetWindowTextA" _
  (ByVal hwnd As Long, _
   ByVal lpString As String) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32" _
   (ByVal hHook As Long) As Long

Public Function MsgBoxHookProc(ByVal uMsg As Long, _
                               ByVal wParam As Long, _
                               ByVal lParam As Long) As Long
  'When the message box is about to be shown,
  'we'll change the titlebar text, prompt message
  'and button captions
   If uMsg = HCBT_ACTIVATE Then
     'in a HCBT_ACTIVATE message, wParam holds
     'the handle to the messagebox - save that
     'for the timer event
      hwndMsgBox = wParam
     'the ID's of the buttons on the message box
     'correspond exactly to the values they return,
     'so the same values can be used to identify
     'specific buttons in a SetDlgItemText call.
      SetDlgItemText wParam, IDSELECT, "Select.."
      SetDlgItemText wParam, IDBEGIN, "Begin"
      SetDlgItemText wParam, IDSKIP, "Skip"
     'we're done with the dialog, so release the hook
      UnhookWindowsHookEx MHP.hHook
   End If
  'return False to let normal processing continue
   MsgBoxHookProc = False

End Function

Public Function TimedMessageBoxH(cmp As CUSTOM_MSG_PARAMS) As Long

   Dim hInstance As Long
   Dim hThreadId As Long
  'Set up the hook
   hInstance = GetWindowLong(cmp.hOwnerThread, GWL_HINSTANCE)
   hThreadId = GetCurrentThreadId()

  'set up the MSGBOX_HOOK_PARAMS values
  'By specifying a Windows hook as one
  'of the params, we can intercept messages
  'sent by Windows and thereby manipulate
  'the dialog
   With MHP
      .hwndOwner = cmp.hOwnerWindow
      .hHook = SetWindowsHookEx(WH_CBT, _
                                AddressOf MsgBoxHookProc, _
                                hInstance, hThreadId)
   End With
  '(re)set the countdown value to 0
   cmp.dwTimerCountDown = 0
  'if bUseTimer, enable the timer. Because the
  'MessageBox API acts just as the MsgBox function
  'does (that is, creates a modal dialog), control
  'won't return to the next line until the dialog
  'is closed. This necessitates our starting the
  'timer before making the call.
  'However, timer events will execute once the
  'modal dialog is shown, allowing us to use the
  'timer to dynamically modify the on-screen message!
   With Form1.Timer1
      .Interval = cmp.dwTimerInterval
      .Enabled = cmp.bUseTimer
   End With

  'call the MessageBox API and return the
  'value as the result of the function
   TimedMessageBoxH = MessageBox(cmp.hOwnerWindow, _
                                 cmp.sPrompt, _
                                 cmp.sTitle, _

  'in case the timer event didn't
  'suspend the timer, do it now
   Form1.Timer1.Enabled = False

End Function
 Form Code
Add a text box (Text1), a command button (Command1) and a Timer control (Timer1) to a form, along with the following code:

Option Explicit

Private Sub Command1_Click()
  'Display wrapper message box,
  'passing the CUSTOM_MSG_PARAMS
  'struct as the parameter.
   With cmp
      .sTitle = "VBnet Timed MessageBox Hook Demo"
      .sPrompt = "To start searching C: immediately, select Begin." & vbCrLf & _
                 "To select a different drive, press Select." & vbCrLf & vbCrLf & _
                 "Automatic searching of C: will begin in 10 seconds." & Space$(20)
      .bUseTimer = True               'if True the Timer will update once per dwTimerInterval
      .dwTimerDuration = 10           'time to wait seconds
      .dwTimerInterval = 1000         'countdown interval in milliseconds
      .dwTimerExpireButton = IDBEGIN  'message to return if timeout occurs
      .dwTimerCountDown = 0           '(re)set to 0
      .hOwnerThread = Me.hwnd         'handle of form owning the thread on which
                                      'execution is proceeding.
                                      'The thread owner is always the calling form.
      .hOwnerWindow = Me.hwnd         'who owns the dialog (me.hwnd or desktop).
                                      'GetDesktopWindow allows user-interaction
                                      'with the form while the dialog is displayed.
                                      'This may not be desirable, so set accordingly.
   End With

   Select Case TimedMessageBoxH(cmp)
      Case IDSELECT: Text1.Text = "Select button pressed before timeout"
      Case IDBEGIN:  Text1.Text = "Begin button pressed or message timed out"
      Case IDSKIP:   Text1.Text = "Skip button pressed before timeout"
   End Select
End Sub

Private Sub Timer1_Timer()

   Dim hWndTargetBtn As Long
   If hwndMsgBox <> 0 Then
     'increment the counter
      cmp.dwTimerCountDown = cmp.dwTimerCountDown + 1

     'update the prompt message with the countdown value
      SetDlgItemText hwndMsgBox, IDPROMPT, _
                     "To start searching C: immediately, select Begin." & vbCrLf & _
                     "To select a different drive, press Select." & vbCrLf & vbCrLf & _
                     "Automatic searching of C: will begin in " & _
                     CStr(10 - cmp.dwTimerCountDown) & " seconds."

     'if the timer has 'expired' (the
     'count=duration), we need to
     'programmatically 'press' the button
     'specified as the default on timeout
      If cmp.dwTimerCountDown = cmp.dwTimerDuration Then
        'we can kill this timer
         Timer1.Enabled = False
        'obtain the handle to the
        'button designated as default
        'if the timer expires
         hWndTargetBtn = GetDlgItem(hwndMsgBox, cmp.dwTimerExpireButton)
         If hWndTargetBtn <> 0 Then
           'set the focus to the target button and
           'simulate a click to close the dialog and
           'return the correct value
            Call PutFocus(hWndTargetBtn)
           'need a DoEvents to allow PutFocus
           'to actually put focus
           'simulate a mouse click on the button
            Call PostMessage(hWndTargetBtn, WM_LBUTTONDOWN, 0, ByVal 0&)
            Call PostMessage(hWndTargetBtn, WM_LBUTTONUP, 0, ByVal 0&)
         End If
      End If
   End If
End Sub
See the Comments section at SetWindowsHookEx: Customize the API Message Box for more info on window hook types.


PayPal Link
Make payments with PayPal - it's fast, free and secure!


Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy


Hit Counter