Solved

System wide keyboard hook

Posted on 2003-11-06
8
1,112 Views
Last Modified: 2007-12-19
Hi,

The code below works fine on WinXP but doesn't work on Win95/98/Me.

Can you help me?

ps.: I need a simple keyboard hook that works on entire system, but I need that the code works on 95 and 98/Me.

Thanx.


(Module.bas):

Option Explicit

' Type Declarations
Private Type KBDLLHOOKSTRUCT
 vkCode As Long
 scanCode As Long
 Flags As Long
 time As Long
 dwExtraInfo As Long
End Type

' Win32 API
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 Declare Function CallNextHookEx Lib "user32" _
 (ByVal hHook As Long, _
  ByVal nCode As Long, _
  ByVal wParam As Long, _
  ByVal lParam As Long) As Long
 
Private Declare Sub CopyMemory Lib "kernel32" _
 Alias "RtlMoveMemory" _
  (pDest As Any, _
   pSource As Any, _
   ByVal cbLength As Long)
 
' Constants
Private Const WH_KEYBOARD_LL = 13&      ' Hook Flag
Private Const HC_ACTION = 0&            ' Keyboard Process Message
 
' Variables
Private m_hLLKeyboardHook As Long       ' The hook object
Public g_bInterceptKeys As Boolean      ' Flag

Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, _
                                     ByVal lParam As Long) As Long

 ' FuncDef: System wide keyboard hook callback
 
 ' FuncParams (From MSDN):
 
   ' nCode : Specifies a code the hook procedure uses to determine
   '         how to process the message. This parameter can be one
   '         of the following values:
   '
   '         HC_ACTION
   
   '         The wParam and lParam parameters contain information
   '         about a keyboard message.
   
   '         If nCode is less than zero, the hook procedure must
   '         pass the message to the CallNextHookEx function without
   '         further processing and should return the value returned
   '         by CallNextHookEx

   ' wParam : Specifies the identifier of the keyboard message.
   '          This parameter can be one of the following messages:
   '
   '          WM_KEYDOWN
   '          WM_KEYUP
   '          WM_SYSKEYDOWN
   '          WM_SYSKEYUP

   ' lParam : Pointer to the KBDLLHOOKSTRUCT structure.

 ' FuncNotes:
 
   ' If nCode is greater than or equal to zero, and the hook procedure
   ' did not process the message, it is highly recommended that you
   ' call CallNextHookEx and return the value it returns; otherwise,
   ' other applications that have installed WH_KEYBOARD_LL hooks will not
   ' receive hook notifications and may behave incorrectly as a result.
   ' If the hook procedure processed the message, it may return a nonzero
   ' value to prevent the system from passing the message to the rest of
   ' the hook chain or the target window procedure.
 
 ' Set up the hook object
 Static tKeyboardHook As KBDLLHOOKSTRUCT


 If nCode = HC_ACTION Then
  Call CopyMemory(tKeyboardHook, ByVal lParam, Len(tKeyboardHook))

  ' Display some info on the form
  With frmDemo
   .lblvkCode2.Caption = tKeyboardHook.vkCode
   .lblscanCode2.Caption = tKeyboardHook.scanCode
   .lblFlags2.Caption = tKeyboardHook.Flags
   .lblTime2.Caption = tKeyboardHook.time
   .lblExtraInfo2.Caption = tKeyboardHook.dwExtraInfo
   .lblwParam2.Caption = wParam
   .lbllParam2.Caption = lParam
  End With
 
  If g_bInterceptKeys Then
   ' Intercept the keystroke and don't pass it along the hook chain
   LowLevelKeyboardProc = 1
   Exit Function
  End If
 
 End If

 ' If the message is not one we want to trap, pass it along
 ' through the hook chain to the intended app
 LowLevelKeyboardProc = CallNextHookEx(m_hLLKeyboardHook, nCode, wParam, lParam)

End Function

Public Function SetSystemWideKeyboardHook() As Long

 ' Hook into the keyboard process
 
 ' Specifying 0 for the last parameter (dwThreadId) indicates a system wide
 ' hook
 
 If m_hLLKeyboardHook = 0 Then
  m_hLLKeyboardHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0&)
 End If

 If m_hLLKeyboardHook = 0 Then
  SetSystemWideKeyboardHook = 0
 Else
  SetSystemWideKeyboardHook = 1
 End If

End Function

Public Function UnSetSystemWideKeyboardHook() As Long

 ' Unhook from the keyboard process
 
 If m_hLLKeyboardHook <> 0 Then
  Call UnhookWindowsHookEx(m_hLLKeyboardHook)
  m_hLLKeyboardHook = 0
  UnSetSystemWideKeyboardHook = 1
 Else
  UnSetSystemWideKeyboardHook = 0
 End If

End Function




(form1.frm):

Option Explicit

Private Sub cmdSet_Click()
 ' Attempt to set the hook
 If SetSystemWideKeyboardHook = 1 Then
  Me.Caption = "Keyboard Hook Info [Hooked]"
 Else
  Me.Caption = "Keyboard Hook Info [Unable to Hook]"
 End If
End Sub

Private Sub cmdUnSet_Click()
 If UnSetSystemWideKeyboardHook = 1 Then
  ne.Caption = "Keyboard Hook Info [UnHooked]"

 Else
  Me.Caption = "Keyboard Hook Info [Hook Not Set]"
 End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
 Call UnSetSystemWideKeyboardHook
End Sub
0
Comment
Question by:Nofx
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
8 Comments
 
LVL 5

Expert Comment

by:fantasy1001
ID: 9698402
An example:

'In a module
Public Const WH_KEYBOARD = 2
Public Const VK_SHIFT = &H10
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
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 UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public hHook As Long
Public Function KeyboardProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    'if idHook is less than zero, no further processing is required
    If idHook < 0 Then
        'call the next hook
        KeyboardProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
    Else
        'check if SHIFT-S is pressed
        If (GetKeyState(VK_SHIFT) And &HF0000000) And wParam = Asc("S") Then
            'show the result
            Form1.Print "Shift-S pressed ..."
        End If
        'call the next hook
        KeyboardProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
    End If
End Function

'In a form, called Form1
Private Sub Form_Load()
    'set a keyboard hook
    hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc, App.hInstance, App.ThreadID)
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'remove the windows-hook
    UnhookWindowsHookEx hHook
End Sub
0
 

Author Comment

by:Nofx
ID: 9699050
Hi,

Your code doesn't work on Win95/Win98/Me and doesn't install a real system wide hook...only vb app is hooked

Thanx anyway
0
 
LVL 28

Expert Comment

by:AzraSound
ID: 9702376
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:Nofx
ID: 9708570
Hi AzraSound,

The code really works...but, let me explain what I need:  
 
I need a hook that intercepts a specific key (ex.: I)....when user press < I > on a specific application, the hook need to stop the action of this key and show a dialog. If user press < ok > in this dialog (form) the hook send (sendkeys) the < I > to this app, if the user press < cancel> the hook doesn't send the < I > key, in other words, I need a hook with cancel support.

Any Idea?
Thanx!

My actual code (works fine only on Win2000/NT/XP):



Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, _
                                     ByVal lParam As Long) As Long

Dim lRet As Long
Static tKeyboardHook As KBDLLHOOKSTRUCT


 If nCode = HC_ACTION Then
    Call CopyMemory(tKeyboardHook, ByVal lParam, Len(tKeyboardHook))
   
   
    If GetForegroundWindow() = w_Cap And Not noHook Then
        'Log Function keys < F1 > a < F16 >
        If tKeyboardHook.vkCode >= vbKeyF1 And tKeyboardHook.vkCode <= vbKeyF16 And tKeyboardHook.Flags = 0 Then
            sLog = sLog & "< F" & (tKeyboardHook.vkCode - vbKeyF1) + 1 & " > " & Now & vbCrLf
        End If
       
        'Show Log if user press < I > and cancel the key
        If tKeyboardHook.vkCode = vbKeyI And tKeyboardHook.Flags = 0 Then
            LowLevelKeyboardProc = 1 'cancel
            lRet = ShowLog()
           
            Exit Function
        End If
    End If
 End If

 LowLevelKeyboardProc = CallNextHookEx(m_hLLKeyboardHook, nCode, wParam, lParam)

End Function

Public Function SetSystemWideKeyboardHook() As Long

 If m_hLLKeyboardHook = 0 Then
  m_hLLKeyboardHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0&)
 End If

 If m_hLLKeyboardHook = 0 Then
  SetSystemWideKeyboardHook = 0
 Else
  SetSystemWideKeyboardHook = 1
 End If

End Function

Public Function UnSetSystemWideKeyboardHook() As Long

 If m_hLLKeyboardHook <> 0 Then
  Call UnhookWindowsHookEx(m_hLLKeyboardHook)
  m_hLLKeyboardHook = 0
  UnSetSystemWideKeyboardHook = 1
 Else
  UnSetSystemWideKeyboardHook = 0
 End If

End Function


Public Function ShowLog() As Long

ShowLog = 0

If Press_I Then Exit Function

Press_I = True
Load frmLog

End Function





(FrmLog):


Private Function BringToFront(ByVal hWnd As Long) As Boolean
   Dim ret As Long
   Dim ThreadID1 As Long
   Dim ThreadID2 As Long
   
   If hWnd = GetForegroundWindow() Then
      BringToFront = True
   Else
      ThreadID1 = GetWindowThreadProcessId(GetForegroundWindow, ByVal 0&)
      ThreadID2 = GetWindowThreadProcessId(hWnd, ByVal 0&)

      If ThreadID1 <> ThreadID2 Then
         Call AttachThreadInput(ThreadID1, ThreadID2, True)
         ret = SetForegroundWindow(hWnd)
         Call AttachThreadInput(ThreadID1, ThreadID2, False)
      Else
         ret = SetForegroundWindow(hWnd)
      End If
      BringToFront = CBool(ret)
   End If
End Function


Private Sub Command1_Click()

If w_Cap <> 0 Then
    noHook = True
   
 
    BringToFront w_Cap
    SendKeys "I"
       
    'DoEvents
    'SendKeystroke vbKeyI, w_Cap
    noHook = False
End If

Unload Me

End Sub




0
 

Expert Comment

by:Hugson
ID: 9807787
I can't help you as far as getting this code to work on Win 95/98/Me is concerned. But to cancel the keycode being sent, simply return -1 as the result of the LowLevelKeyboardProc function
(which must be done within the number of milliseconds stored in HKCU\Control Panel\Desktop\LowLevlHooksTimeout)
0
 

Accepted Solution

by:
amp072397 earned 0 total points
ID: 10528543
PAQed - no points refunded (of 500)

amp
Community Support Moderator amp~at~experts-exchange.com
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

734 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question