Link to home
Start Free TrialLog in
Avatar of lynnton
lynnton

asked on

CTRL + Numlock key (Guru's on systemwide keys)

Hi Experts,

I'm able to block system wide keys using this project

http://vbnet.mvps.org/index.html?code/hooks/lowlevelkeyboardproc.htm

I able to block ctrl.
I able to block numlock.

Problem is I can't block "Ctrl + numlock".

Please kindly guide me how to implement to block "Ctrl + numlock". vb6

Private Const VK_NUMLOCK = &H90

Thanks.

already tried this too:
http://www.vbaccelerator.com/home/VB/Code/Libraries/Subclassing/Registered_Hotkeys/article.asp
couldn't catch ctrl+numlock
SOLUTION
Avatar of nffvrxqgrcfqvvc
nffvrxqgrcfqvvc

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of nffvrxqgrcfqvvc
nffvrxqgrcfqvvc

add the following code to a form_
add 1 timer
set its interval to 10
I mean this is an example:

What you should really do is check if the CTRL is press than turn off the numlock key

Private Sub Timer1_Timer()
If CTRLkey was pressed Then
'Disable control key here
Call ToggleNumLock(False)
DoEvents
End If
may I ask what CTRL + numlock does, because when I use CTRL + numlock the light does not even show..if i use an other combination besides CTRL + numlock the numock light shows.  U might not be able to use CTRL + Numlock you need to look into this.
Also want to mention that if the numlock keys is on and you hold down ctrl you can't toggle the numlock key so evidentally when you use CTRL with the numlock key it blocks and keyboard interaction
Avatar of lynnton

ASKER

egl1044,

Ctrl+numlock is a unique combination, if you could kindly guide me how we can block it, i would really appreciate it.

Thanks.
Avatar of lynnton

ASKER

egl1044,

>>What you should really do is check if the CTRL is press than turn off the numlock key<<

The numlock key is already killed by the posted link. Ctrl+numlock sends a different combination.

Thanks.

Use the link I provided above download the project and just change to use the numlock key

Private Const VK_NUMLOCK = &H90
Avatar of lynnton

ASKER

egl1044,

Sad to say already did, unfortunately it was blocking all the system keys. including crtl+numlock.

Can we only block ctrl+numlock?

Thanks.
Just change the module to this:


Option Explicit



Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public 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
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Const HC_ACTION = 0
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
Public Const VK_TAB = &H9
Public Const VK_ESCAPE = &H1B
Public Const VK_NUMLOCK = &H90

Public Const VK_CONTROL = &H11  'CTRL key


Public Const VK_LWIN = &H5B  'Left Windows key (Microsoft® Natural® keyboard)
Public Const VK_RWIN = &H5C  'Right Windows key (Natural keyboard)
Public Const VK_APPS = &H5D  'Applications key (Natural keyboard)



Public Const WH_KEYBOARD_LL = 13
Public Const LLKHF_ALTDOWN = &H20

Public Type KBDLLHOOKSTRUCT
    vkCode As Long
    scanCode As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type

Dim p As KBDLLHOOKSTRUCT

Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Dim fEatKeystroke As Boolean
   
   If (nCode = HC_ACTION) Then
      If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Or wParam = WM_KEYUP Or wParam = WM_SYSKEYUP Then
         CopyMemory p, ByVal lParam, Len(p)
         fEatKeystroke = _
            p.vkCode = VK_LWIN Or _
            p.vkCode = VK_RWIN Or _
            p.vkCode = VK_CONTROL Or _
            p.vkCode = VK_NUMLOCK Or _
            ((GetKeyState(VK_CONTROL) And &H90) <> 0) Or _
            ((p.flags And LLKHF_ALTDOWN) <> 0)
        End If
    End If
   
    If fEatKeystroke Then
        LowLevelKeyboardProc = -1
    Else
        'LowLevelKeyboardProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
    End If
End Function


make sure before you end the application that you un-check the checkbox to unhook the keyboard..

You could use a command button instead of the checkbox..
Avatar of lynnton

ASKER

egl1044,

Problem is we are also block all the hotkeys like ctrl, alt, ctrl+esc and etc.

can we soley block ctrl+numlock ?

Thanks.
Why can't you just block the numlock key if CTRL is pressed?
Option Explicit

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Const VK_CONTROL = &H11

Private Sub Command1_Click()
   Static bVal As Boolean
   bVal = Not bVal
   SetNumState bVal
End Sub

Private Function IsNumOn() As Boolean
   IsNumOn = IsBitSet(GetKeyState(vbKeyNumlock), 0)
End Function

Private Sub SetNumState(Optional ByVal bOn As Boolean = True)
  If IsNumOn <> bOn Then
     keybd_event vbKeyNumlock, &H45, 1, 3
     keybd_event vbKeyNumlock, &H45, 3, 0
  End If
End Sub

Private Function IsBitSet(iBitString As Long, ByVal lBitNo As Integer) As Boolean
    If lBitNo = 31 Then
        IsBitSet = iBitString < 0
    Else
        IsBitSet = iBitString And (2 ^ lBitNo)
    End If
End Function

Private Sub Form_Activate()
Call SetNumState(False)
End Sub

Private Sub Form_Load()
Call SetNumState(False)
End Sub


Private Sub Timer1_Timer()
If GetKeyState(VK_CONTROL) = 1 Then
     'or disable/lock numlock key numlock
     Call SetNumState(False)
   End If
DoEvents
End Sub
Avatar of lynnton

ASKER

egl1044,

Ctrl +numlock sends a different key. blocking the numlock doesn't work.(already tried it in the first post).

to test weather ctrl numlock is disabled:
open a cmd prompt >tracert yahoo.com >press ctrl+numlock

Thanks.
Avatar of lynnton

ASKER

egl1044,

The code below blocks ctrl+numlock, it we could tweak it a little to open other hotkeys like "ctrl", "numlock", "alt"
it would be then perfect.

Thanks


   If (nCode = HC_ACTION) Then
      If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Or wParam = WM_KEYUP Or wParam = WM_SYSKEYUP Then
         CopyMemory p, ByVal lParam, Len(p)
         fEatKeystroke = _
            p.vkCode = VK_NUMLOCK Or _
            ((GetKeyState(VK_CONTROL) And &H8000) <> 0) Or _
            ((p.flags And LLKHF_ALTDOWN) <> 0)
        End If
    End If
Change it to this then: This works I just tested it using tracert

Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Dim fEatKeystroke As Boolean
   
   If (nCode = HC_ACTION) Then
      If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Or wParam = WM_KEYUP Or wParam = WM_SYSKEYUP Then
         CopyMemory p, ByVal lParam, Len(p)
         fEatKeystroke = _
            p.vkCode = VK_LWIN Or _
            p.vkCode = VK_RWIN Or _
            p.vkCode = VK_CONTROL Or _
            p.vkCode = VK_NUMLOCK Or _
            ((GetKeyState(VK_NUMLOCK) And &H90)) Or _
            ((p.flags And VK_CONTROL) <> 0)
        End If
    End If
   
    If fEatKeystroke Then
        LowLevelKeyboardProc = -1
    Else
        LowLevelKeyboardProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
    End If
End Function
Avatar of lynnton

ASKER

egl1044,

We are almost there!!! Great idea !!! no doubt one of the best.

The code below disables ctrl+numlock, sadly it also block
"page up"
"page down"
"enter key on numpad"
"->" (left arrow)
"<-" (right arrow)

Please kindly guide me how can we enable those keys

Thanks.

         fEatKeystroke = _
            p.vkCode = VK_NUMLOCK Or _
            (p.flags And (VK_CONTROL) <> 0)
Once you issue the unhook command the keys are enabled again.
Avatar of lynnton

ASKER

egl1044,

Yes that is correct, once we issue the unhook command, the keys are enabled again, unfortunately we need the other keys open while blocking ctrl+numlock.


Thanks.
Avatar of lynnton

ASKER

egl1044,

Is it possible to add a condition that, if these key are press, dont block it..

Thanks.
ASKER CERTIFIED SOLUTION
Avatar of Ark
Ark
Flag of Russian Federation image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of lynnton

ASKER

Ark,

Amazing it did catch it, is it possible if you could kindly guide me which function, api, module and etc we only need inorder to get this detect the ctrl+numlock?

Thanks.
Avatar of lynnton

ASKER

Ark,

The project I've downloaded has frmTest, mHook.bas, and cSystemHook.

Thanks.
Hi
IMHO, code size is not too large. You can just add bas and cls modules to your project, then at any of your form code:

Dim WithEvents sh As cSystemHook

Private Sub Form_Load()
  '.....Your code
   Set sh = New cSystemHook
   sh.SetHook
  '.....Your code
End Sub

Private Sub Form_Unload(Cancel As Integer)
  '.....Your code
   sh.RemoveHook
   Set sh = Nothing
  '.....Your code
End Sub

Private Sub sh_KeyDown(hWin As Long, KeyCode As Integer, Shift As Integer)
   If KeyCode = vbKeyPause Then
      Debug.Print "Ctrl+Num blocked"
      KeyCode = 0
   End If
End Sub

Private Sub sh_KeyUp(hWin As Long, KeyCode As Integer, Shift As Integer)
   If KeyCode = vbKeyPause Then
      Debug.Print "Ctrl+Num blocked"
      KeyCode = 0
   End If
End Sub

If you want to eleminate code size, you can remove all mouse-dependent and system-keys staff from class module:
'Class module:
Option Explicit

Public Event KeyDown(hWin As Long, KeyCode As Integer, Shift As Integer)
Public Event KeyUp(hWin As Long, KeyCode As Integer, Shift As Integer)

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 GetAsyncKeyState% Lib "user32" (ByVal vKey As Long)
Private Declare Function GetFocus Lib "user32" () As Long

Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101

Private Const WH_JOURNALRECORD = 0
Private Const WH_GETMESSAGE = 3

Private Type EVENTMSG
     wMsg As Long
     lParamLow As Long
     lParamHigh As Long
     msgTime As Long
     hWndMsg As Long
End Type

Dim EMSG As EVENTMSG

Public Function SetHook() As Boolean
   If hJournalHook = 0 Then hJournalHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf JournalRecordProc, App.hInstance, 0)
   If hAppHook = 0 Then hAppHook = SetWindowsHookEx(WH_GETMESSAGE, AddressOf AppHookProc, App.hInstance, App.ThreadID)
   SetHook = True
End Function

Public Sub RemoveHook()
   UnhookWindowsHookEx hAppHook
   UnhookWindowsHookEx hJournalHook
End Sub

Private Sub Class_Initialize()
  SHptr = ObjPtr(Me)
End Sub

Private Sub Class_Terminate()
  If hJournalHook Or hAppHook Then RemoveHook
End Sub

Public Function FireEvent(ByVal lParam As Long)
  Dim i%, j%, k%
  Dim s As String
  If lParam = WM_CANCELJOURNAL Then
     hJournalHook = 0
     SetHook
     Exit Function
  End If
 
  CopyMemory EMSG, ByVal lParam, Len(EMSG)
  Select Case EMSG.wMsg
    Case WM_KEYDOWN
         j = 0
         If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1)        'fixed by JJ
         If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2)      'fixed by JJ
         If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4)         'fixed by JJ
         s = Hex(EMSG.lParamLow)
         k = (EMSG.lParamLow And &HFF)
         RaiseEvent KeyDown(GetFocus, k, j)
         s = Left$(s, 2) & Right$("00" & Hex(k), 2)               'fixed by JJ
         EMSG.lParamLow = CLng("&h" & s)
         CopyMemory ByVal lParam, EMSG, Len(EMSG)
    Case WM_KEYUP
         j = 0                                                    'fixed by JJ
         If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1)        'fixed by JJ
         If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2)      'fixed by JJ
         If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4)         'fixed by JJ
         s = Hex(EMSG.lParamLow)
         k = (EMSG.lParamLow And &HFF)
         RaiseEvent KeyUp(GetFocus, k, j)
         s = Left$(s, 2) & Right$("00" & Hex(k), 2)               'fixed by JJ
         EMSG.lParamLow = CLng("&h" & s)
         CopyMemory ByVal lParam, EMSG, Len(EMSG)
    Case Else
  End Select
End Function
Avatar of lynnton

ASKER

Ark,

I've pasted into the form and left everything untouch on the bas ad class. Unfortunately, nothing happend whne I press ctrl+numlock and also tried vbKeyP.

When closing the program error message,  sh.RemoveHook <----object required

Thanks.
How did you name SystemHook class? Its name should be cSystemHook, or change

Dim WithEvents sh As cSystemHook <--- Your class name
Private Sub Form_Load()
  '.....Your code
   Set sh = New cSystemHook <--- Your class name
Avatar of lynnton

ASKER

Ark,

Thanks for your time and patience. It was the vbPause key that solved the problem.