?
Solved

Ark - question about your Keyboard and Mouse hook...

Posted on 2002-03-19
3
Medium Priority
?
446 Views
Last Modified: 2012-06-21
How can I stop the event from occuring?  Here is the source you gave me once.. please tell me where I can add code to cancel the event from occuring.  For example, I'd like to stop all instances of the user typing "a" from occuring.

Thanks!

(by the way, I'm running low on points, sorry!)


(here is the source)
'======bas module code=====
Option Explicit
Public Type POINTAPI
      x As Long
      y As Long
End Type

Type TMSG
    hWnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any,
ByVal cBytes 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
Public hJournalHook As Long, hAppHook As Long
Public SHptr As Long
Public Const WM_CANCELJOURNAL = &H4B

Public Function JournalRecordProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As
Long
 If nCode < 0 Then
    JournalRecordProc = CallNextHookEx(hJournalHook, nCode, wParam, lParam)
    Exit Function
 End If
 ResolvePointer(SHptr).FireEvent lParam
 Call CallNextHookEx(hJournalHook, nCode, wParam, lParam)
End Function

Public Function AppHookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  If nCode < 0 Then
     AppHookProc = CallNextHookEx(hAppHook, nCode, wParam, lParam)
     Exit Function
  End If
  Dim msg As TMSG
  CopyMemory msg, ByVal lParam, Len(msg)
  Select Case msg.message
      Case WM_CANCELJOURNAL
           If wParam = 1 Then ResolvePointer(SHptr).FireEvent WM_CANCELJOURNAL
  End Select
  Call CallNextHookEx(hAppHook, nCode, wParam, ByVal lParam)
End Function

Private Function ResolvePointer(ByVal lpObj&) As cSystemHook
 Dim oSH As cSystemHook
 CopyMemory oSH, lpObj, 4&
 Set ResolvePointer = oSH
 CopyMemory oSH, 0&, 4&
End Function
'========End Bas module=======
Add class module named cSystemHook
'=====Class module code=======
Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Public Event SystemKeyDown(KeyCode As Integer)
Public Event SystemKeyUp(KeyCode 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 Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_MOUSEWHEEL = &H20A
Private Const WM_SYSTEMKEYDOWN = &H104
Private Const WM_SYSTEMKEYUP = &H105

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)
        If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2)
        If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4)
        s = Hex(EMSG.lParamLow)
        k = (EMSG.lParamLow And &HFF)
        RaiseEvent KeyDown(k, j)
        s = Left$(s, 2) & Right$("00" & Hex(k), 2)
        EMSG.lParamLow = CLng("&h" & s)
        CopyMemory ByVal lParam, EMSG, Len(EMSG)
   Case WM_KEYUP
        j = 0
        If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1)
        If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2)
        If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4)
        s = Hex(EMSG.lParamLow)
        k = (EMSG.lParamLow And &HFF)
        RaiseEvent KeyUp(k, j)
        s = Left$(s, 2) & Right$("00" & Hex(k), 2)
        EMSG.lParamLow = CLng("&h" & s)
        CopyMemory ByVal lParam, EMSG, Len(EMSG)
   Case WM_MOUSEMOVE
        i = 0
        If GetAsyncKeyState(vbKeyLButton) Then i = (i Or 1)
        If GetAsyncKeyState(vbKeyRButton) Then i = (i Or 2)
        If GetAsyncKeyState(vbKeyMButton) Then i = (i Or 4)
        j = 0
        If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1)
        If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2)
        If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4)
        RaiseEvent MouseMove(i, j, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh))
   Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN
        i = 0
        If GetAsyncKeyState(vbKeyShift) Then i = (i Or 1)
        If GetAsyncKeyState(vbKeyControl) Then i = (i Or 2)
        If GetAsyncKeyState(vbKeyMenu) Then i = (i Or 4)
        RaiseEvent MouseDown(2 ^ ((EMSG.wMsg - 513) / 3), i, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh))
   Case WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP
        i = 0
        If GetAsyncKeyState(vbKeyShift) Then i = (i Or 1)
        If GetAsyncKeyState(vbKeyControl) Then i = (i Or 2)
        If GetAsyncKeyState(vbKeyMenu) Then i = (i Or 4)
        RaiseEvent MouseUp(2 ^ ((EMSG.wMsg - 514) / 3), i, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh))
   Case WM_SYSTEMKEYDOWN
        s = Hex(EMSG.lParamLow)
        k = (EMSG.lParamLow And &HFF)
        If k <> vbKeyMenu Then RaiseEvent SystemKeyDown(k)
        s = Left$(s, 2) & Right$("00" & Hex(k), 2)
        EMSG.lParamLow = CLng("&h" & s)
        CopyMemory ByVal lParam, EMSG, Len(EMSG)
   Case WM_SYSTEMKEYUP
        s = Hex(EMSG.lParamLow)
        k = (EMSG.lParamLow And &HFF)
        If k <> vbKeyMenu Then RaiseEvent SystemKeyUp(k)
        s = Left$(s, 2) & Right$("00" & Hex(k), 2)
        EMSG.lParamLow = CLng("&h" & s)
        CopyMemory ByVal lParam, EMSG, Len(EMSG)
   Case Else
 End Select
End Function
0
Comment
Question by:samsonite1023
[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
  • 2
3 Comments
 
LVL 28

Accepted Solution

by:
Ark earned 100 total points
ID: 6884201
Hi
You can use same way as VB use:

Private Sub sh_KeyDown(KeyCode As Integer, Shift As Integer)
' Uncomment following string and all your input will be replaced with "a"
'   KeyCode = vbKeyA
'or
'   KeyCode = 0 - to ignore inputs
End Sub

See my sample at http://www.freevbcode.com/ShowCode.Asp?ID=1610

Cheers

0
 
LVL 1

Author Comment

by:samsonite1023
ID: 6884590
Thanks!  Is there a way to do the same thing with the mouse?

Putting Button = 0 inside the MouseDown sub does not work.

-Sam
0
 
LVL 28

Expert Comment

by:Ark
ID: 6887249
No, I didn't add this functionality to class.
0

Featured Post

Industry Leaders: 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!

Question has a verified solution.

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

Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses

801 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