Solved

Detect KeyBoard

Posted on 2001-06-16
5
664 Views
Last Modified: 2007-12-19
I want to make project that can be detect keyboard when keyboard are pressed. OK I give you example when the program Run and when you pressed 's' and 'c' then the program will capture picture. Even when you on the other application like Note pad.SO I need to know How to make(source code will be nice) when the program run it will be stay on memory and when keyboard pressed the program will detect(for example) if the keyboard sequence 's' 'c'
then will capture picture in the Screen.
I just need source code how make program stay in windows memory and can detect when keyboard pressed with certain sequence. Than you Very much for your Help
0
Comment
Question by:Katsukidaito
5 Comments
 

Expert Comment

by:javudai
ID: 6197974
hi for that u can use Window hook - API... this api will give u what is the value(ASCII) is coming from the keyboard,U can display some another value for the coresponding input value...

I'll makie it clear..

Ex:
 In notepad or any other application like MS-WORD etc..
i want to display only 'A'...for any input from the keyboard..for this i can use Windows Hook api..u can code
to change for all the ACII values to ASCII value for 'A'
0
 
LVL 2

Expert Comment

by:PeteD
ID: 6197979
module code:-

Option Explicit

Public Enum HookFlags
   HFMouseDown = 1
   HFMouseUp = 2
   HFMouseMove = 4
   HFKeyDown = 8
   HFKeyUp = 16
End Enum

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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Private Declare Function GetAsyncKeyState% Lib "user32" (ByVal vKey As Long)
Private Declare Function GetForegroundWindow& Lib "user32" ()
Private Declare Function GetWindowThreadProcessId& Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long)
Private Declare Function GetKeyboardLayout& Lib "user32" (ByVal dwLayout As Long)
Private Declare Function MapVirtualKeyEx Lib "user32" Alias "MapVirtualKeyExA" (ByVal uCode As Long, ByVal uMapType As Long, ByVal dwhkl As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOREDRAW = &H8

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 WH_JOURNALRECORD = 0

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

Dim EMSG As EVENTMSG
Dim hHook As Long, frmHooked As Form, hFlags As Long

Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  If nCode < 0 Then
     HookProc = CallNextHookEx(hHook, nCode, wParam, lParam)
     Exit Function
  End If
  Dim i%, j%
  CopyMemory EMSG, ByVal lParam, Len(EMSG)
  Select Case EMSG.wMsg
    Case WM_KEYDOWN
       If (hFlags And HFKeyDown) = HFKeyDown Then
          If GetAsyncKeyState(vbKeyShift) Then j = 1
          If GetAsyncKeyState(vbKeyControl) Then j = 2
          If GetAsyncKeyState(vbKeyMenu) Then j = 4
          If (EMSG.lParamLow And &HFF) > 31 Then
             frmHooked.System_KeyDown MapVirtualKeyEx(EMSG.lParamLow And &HFF, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0))), j
          Else
             frmHooked.System_KeyDown EMSG.lParamLow And &HFF, j
          End If
        End If
    Case WM_KEYUP
       If (hFlags And HFKeyUp) = HFKeyUp Then
          If GetAsyncKeyState(vbKeyShift) Then j = 1
          If GetAsyncKeyState(vbKeyControl) Then j = 2
          If GetAsyncKeyState(vbKeyMenu) Then j = 4
          If (EMSG.lParamLow And &HFF) > 31 Then
             frmHooked.System_KeyUp MapVirtualKeyEx(EMSG.lParamLow And &HFF, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0))), j
          Else
             frmHooked.System_KeyUp EMSG.lParamLow And &HFF, j
          End If
        End If
    Case WM_MOUSEWHEEL
         Debug.Print "MouseWheel"
    Case WM_MOUSEMOVE
       If (hFlags And HFMouseMove) = HFMouseMove Then
         If GetAsyncKeyState(vbKeyLButton) Then i = 1
         If GetAsyncKeyState(vbKeyRButton) Then i = 2
         If GetAsyncKeyState(vbKeyMButton) Then i = 4
         If GetAsyncKeyState(vbKeyShift) Then j = 1
         If GetAsyncKeyState(vbKeyControl) Then j = 2
         If GetAsyncKeyState(vbKeyMenu) Then j = 4
         frmHooked.System_MouseMove i, j, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh)
       End If
    Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN
       If (hFlags And HFMouseDown) = HFMouseDown Then
         If GetAsyncKeyState(vbKeyShift) Then i = 1
         If GetAsyncKeyState(vbKeyControl) Then i = 2
         If GetAsyncKeyState(vbKeyMenu) Then i = 4
         frmHooked.System_MouseDown 2 ^ ((EMSG.wMsg - 513) / 3), i, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh)
       End If
    Case WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP
       If (hFlags And HFMouseUp) = HFMouseUp Then
         If GetAsyncKeyState(vbKeyShift) Then i = 1
         If GetAsyncKeyState(vbKeyControl) Then i = 2
         If GetAsyncKeyState(vbKeyMenu) Then i = 4
         frmHooked.System_MouseUp 2 ^ ((EMSG.wMsg - 514) / 3), i, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh)
       End If
  End Select
  Call CallNextHookEx(hHook, nCode, wParam, lParam)
End Function

Public Sub SetHook(fOwner As Form, flags As HookFlags)
   hHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf HookProc, 0, 0)
   Set frmHooked = fOwner
   hFlags = flags
   Window_SetAlwaysOnTop frmHooked.hwnd, True
End Sub

Public Sub RemoveHook()
   UnhookWindowsHookEx hHook
   Window_SetAlwaysOnTop frmHooked.hwnd, False
   Set frmHooked = Nothing
End Sub

Private Function Window_SetAlwaysOnTop(hwnd As Long, bAlwaysOnTop As Boolean) As Boolean
   Window_SetAlwaysOnTop = SetWindowPos(hwnd, -2 - bAlwaysOnTop, 0, 0, 0, 0, SWP_NOREDRAW Or SWP_NOSIZE Or SWP_NOMOVE)
End Function



'Form code  (you need 2 textboxes and a label text1,text2,label1)


Option Excplicit

Private Sub Form_Load()
   SetHook Me, HFMouseDown + HFMouseUp + HFMouseMove + HFKeyDown + HFKeyUp
   Text1 = "Mouse activity log:"
   Text2 = "Keyboard activity log:"
End Sub

Public Sub System_KeyDown(KeyCode As Integer, Shift As Integer)
   Dim s As String
   If KeyCode > 31 Then
      s = LCase(Chr$(KeyCode))
   Else
      s = "ASCII code " & KeyCode
   End If
   If Shift = vbShiftMask Then s = UCase(s): s = s & " + Shift "
   If Shift = vbCtrlMask Then s = s & " + Ctrl "
   If Shift = vbAltMask Then s = s & " + Alt "
   Text2 = Text2 & vbCrLf & s & " down"
End Sub

Public Sub System_KeyUp(KeyCode As Integer, Shift As Integer)
   Dim s As String
   If KeyCode > 31 Then
      s = LCase(Chr$(KeyCode))
   Else
      s = "ASCII code " & KeyCode
   End If
   If Shift = vbShiftMask Then s = UCase(s): s = s & " + Shift "
   If Shift = vbCtrlMask Then s = s & " + Ctrl "
   If Shift = vbAltMask Then s = s & " + Alt "
   Text2 = Text2 & vbCrLf & s & " up"
End Sub
Public Sub System_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  Dim s As String
  If Button = vbLeftButton Then s = "Left Button "
  If Button = vbRightButton Then s = "Right Button "
  If Button = vbMiddleButton Then s = "Middle Button "
  If Shift = vbShiftMask Then s = s & "+ Shift "
  If Shift = vbCtrlMask Then s = s & "+ Ctrl "
  If Shift = vbAltMask Then s = s & "+ Alt "
  Text1 = Text1 & vbCrLf & s & "Down at pos (pixels): " & CStr(x) & " , " & CStr(y)
End Sub

Public Sub System_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  Dim s As String
  If Button = vbLeftButton Then s = "Left Button "
  If Button = vbRightButton Then s = "Right Button "
  If Button = vbMiddleButton Then s = "Middle Button "
  If Shift = vbShiftMask Then s = s & "+ Shift "
  If Shift = vbCtrlMask Then s = s & "+ Ctrl "
  If Shift = vbAltMask Then s = s & "+ Alt "
  Text1 = Text1 & vbCrLf & s & "Up at pos (pixels): " & CStr(x) & " , " & CStr(y)
End Sub

Public Sub System_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  Dim s As String
  If Button = vbLeftButton Then s = "Left Button "
  If Button = vbRightButton Then s = "Right Button "
  If Button = vbMiddleButton Then s = "Middle Button "
  If Shift = vbShiftMask Then s = s & "+ Shift "
  If Shift = vbCtrlMask Then s = s & "+ Ctrl "
  If Shift = vbAltMask Then s = s & "+ Alt "
  Label1 = "Mouse info" & vbCrLf & "X = " & x & "  Y= " & y & vbCrLf
  If s <> "" Then Label1 = Label1 & "Extra Info: " & vbCrLf & s & "pressed"
End Sub

Private Sub Form_Unload(Cancel As Integer)
   RemoveHook
End Sub

0
 
LVL 6

Expert Comment

by:andyclap
ID: 6199141
Will that work as katsukidaito wants? If the app doesn't have focus, do you get the messages? You really need a system wide hook and I thought you couldn't set system hooks into VB code.

There's a nice article on system wide hooks with a library you can use at:
http://vbaccelerator.com/codelib/hook/vbalhook.htm
0
 
LVL 2

Accepted Solution

by:
PeteD earned 50 total points
ID: 6200410
If the app doesn't have focus, do you get the messages?

>Yes, The Window_SetAlwaysOnTop code proves it when you run it!
0
 

Author Comment

by:Katsukidaito
ID: 6200561
Thank You Very MUch For Your Kindness.
Visual Basic So MUch toLearn CAn you Help me Again?
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

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…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
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…
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…

708 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

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now