• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 280
  • Last Modified:

Send a keyboard event to an external app

Hi, does anyone know how to send an keyboard event to another application.
ie. simulating a key pressed. Lets say that insted of pressing enter on an app I want to send the enter pressed event to the app.

I think you can do this with the sendmessage api but is not sure.
Anybody have any ideas?

Thnx

Ps. I dont want step by step code, I want more in the lines of ideas
0
Veroland
Asked:
Veroland
  • 3
1 Solution
 
watyCommented:
Use the following class :

' #VBIDEUtils#************************************************************
' * Programmer Name  : Scott Seligman
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : waty.thierry@usa.net
' * Date             : 18/10/1999
' * Time             : 10:45
' **********************************************************************
' * Comments         : Simulates keystrokes using keybd_event
' * This class simulates keystrokes using the keybd_event API.
' * If offers two advantages over SendKeys. First, it doesn't cause
' * the num lock light to flicker unless you specifically press the num lock key.
' * Secondly, it's possible to press and hold a key. Sample Usage:
' * Dim keys As New clsKeys
' * Dim bCapsLock As Boolean
' * keys.GetLockStatus bCapsLock, True, True
' * If bCapsLock Then
' *    keys.PressKeyVK keyCapsLock
' * End If
' * keys.PressString "Now is the time for all good men to come to the aid of their country."
' *
' **********************************************************************
'--------- Class Name: clsKeys

Option Explicit

Private Declare Function MapVirtualKey Lib "user32" Alias _
   "MapVirtualKeyA" (ByVal wCode As Long, _
   ByVal wMapType As Long) As Long

Private Declare Function VkKeyScan Lib "user32" Alias "VkKeyScanA" (ByVal _
   cChar As Byte) As Integer

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 Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As _
   Long) As Integer

Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2

Public Enum enumKeys
   keyBackspace = &H8
   keyTab = &H9
   keyReturn = &HD
   keyShift = &H10
   keyControl = &H11
   keyAlt = &H12
   keyPause = &H13
   keyEscape = &H1B
   keySpace = &H20
   keyEnd = &H23
   keyHome = &H24
   keyLeft = &H25
   KeyUp = &H26
   keyRight = &H27
   KeyDown = &H28
   keyInsert = &H2D
   keyDelete = &H2E
   keyF1 = &H70
   keyF2 = &H71
   keyF3 = &H72
   keyF4 = &H73
   keyF5 = &H74
   keyF6 = &H75
   keyF7 = &H76
   keyF8 = &H77
   keyF9 = &H78
   keyF10 = &H79
   keyF11 = &H7A
   keyF12 = &H7B
   keyNumLock = &H90
   keyScrollLock = &H91
   keyCapsLock = &H14
End Enum

'Presses the single key represented by sKey
Public Sub PressKey(sKey As String, Optional bHold As Boolean, Optional _
   bRelease As Boolean)

   Dim nVK As Long
   nVK = VkKeyScan(Asc(sKey))

   If nVK = 0 Then
      Exit Sub
   End If

   Dim nScan As Long
   Dim nExtended As Long

   nScan = MapVirtualKey(nVK, 2)
   nExtended = 0
   If nScan = 0 Then
      nExtended = KEYEVENTF_EXTENDEDKEY
   End If
   nScan = MapVirtualKey(nVK, 0)

   Dim bShift As Boolean
   Dim bCtrl As Boolean
   Dim bAlt As Boolean

   bShift = (nVK And &H100)
   bCtrl = (nVK And &H200)
   bAlt = (nVK And &H400)

   nVK = (nVK And &HFF)

   If Not bRelease Then
      If bShift Then
         keybd_event enumKeys.keyShift, 0, 0, 0
      End If
      If bCtrl Then
         keybd_event enumKeys.keyControl, 0, 0, 0
      End If
      If bAlt Then
         keybd_event enumKeys.keyAlt, 0, 0, 0
      End If

      keybd_event nVK, nScan, nExtended, 0
   End If

   If Not bHold Then
      keybd_event nVK, nScan, KEYEVENTF_KEYUP Or nExtended, 0

      If bShift Then
         keybd_event enumKeys.keyShift, 0, KEYEVENTF_KEYUP, 0
      End If
      If bCtrl Then
         keybd_event enumKeys.keyControl, 0, KEYEVENTF_KEYUP, 0
      End If
      If bAlt Then
         keybd_event enumKeys.keyAlt, 0, KEYEVENTF_KEYUP, 0
      End If
   End If

End Sub

'Loop through a string and calls PressKey for each character (Does not
' parse strings like SendKeys)
Public Sub PressString(ByVal sString As String, Optional bDoEvents As Boolean = True)

   Do While sString <> ""
      PressKey Mid(sString, 1, 1)

      Sleep 20
      If bDoEvents Then
         DoEvents
      End If

      sString = Mid(sString, 2)
   Loop

End Sub

'Presses a specific key (this is used for keys that don't have a
' ascii equilivant)
Public Sub PressKeyVK(keyPress As enumKeys, Optional bHold As Boolean, _
   Optional bRelease As Boolean, Optional bCompatible As Boolean)

   Dim nScan As Long
   Dim nExtended As Long

   nScan = MapVirtualKey(keyPress, 2)
   nExtended = 0
   If nScan = 0 Then
      nExtended = KEYEVENTF_EXTENDEDKEY
   End If
   nScan = MapVirtualKey(keyPress, 0)

   If bCompatible Then
      nExtended = 0
   End If

   If Not bRelease Then
      keybd_event keyPress, nScan, nExtended, 0
   End If

   If Not bHold Then
      keybd_event keyPress, nScan, KEYEVENTF_KEYUP Or nExtended, 0
   End If

End Sub

'Returns (in the boolean variables) the status of the various Lock keys
Public Sub GetLockStatus(bCapsLock As Boolean, bNumLock As Boolean, _
   bScrollLock As Boolean)

   bCapsLock = GetKeyState(enumKeys.keyCapsLock)
   bNumLock = GetKeyState(enumKeys.keyNumLock)
   bScrollLock = GetKeyState(enumKeys.keyScrollLock)

End Sub
0
 
watyCommented:
' #VBIDEUtils#************************************************************
' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : waty.thierry@usa.net
' * Date             : 24/09/98
' * Time             : 13:36
' * Module Name      : class_SendKeys
' * Module Filename  :
' **********************************************************************
' * Comments         : Allows users to be able to send keystrokes to
' *                    dos programs running in a windows95 dos box
' *
' * This class has one property, Destination, which needs to be the handle
' *  returned from the shell function of the dos program or any program
' *  started with the shell function.
' * It also has one method called, SendKeys, this is the string to be sent
' *  to the destination.
' *
' **********************************************************************

Option Explicit

Private mvarDestination As Long 'local copy
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SHIFT = &H10

Private Declare Function OemKeyScan Lib "user32" (ByVal wsOemchar As Integer) As Long
Private Declare Function CharToOem Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Private Declare Function VkKeyScan Lib "user32" Alias "VkKeyScanA" (ByVal cChar As Byte) As Integer
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Sub SendAKey(ByVal sKeys As String)

   Dim vk            As Integer
   Dim nShiftScan    As Integer
   Dim nScan         As Integer
   Dim sOemchar      As String
   Dim nShiftKey     As Integer
   
   ' *** Get the virtual key code for this character
   vk = VkKeyScan(Asc(sKeys)) And &HFF
   ' *** See if shift key needs to be pressed
   nShiftKey = VkKeyScan(Asc(sKeys)) And 256
   sOemchar = " " ' 2 character buffer
   ' *** Get the OEM character - preinitialize the buffer
   CharToOem Left$(sKeys, 1), sOemchar
   ' *** Get the nScan code for this key
   nScan = OemKeyScan(Asc(sOemchar)) And &HFF
   ' *** Send the key down

   If nShiftKey = 256 Then
      ' *** if shift key needs to be pressed
      nShiftScan = MapVirtualKey(VK_SHIFT, 0)
      ' *** press down the shift key
      keybd_event VK_SHIFT, nShiftScan, 0, 0
   End If

   ' *** press key to be sent
   keybd_event vk, nScan, 0, 0
   ' *** Send the key up

   If nShiftKey = 256 Then
      ' *** keyup for shift key
      keybd_event VK_SHIFT, nShiftScan, KEYEVENTF_KEYUP, 0
   End If

   ' ***keyup for key sent
   keybd_event vk, nScan, KEYEVENTF_KEYUP, 0
   
End Sub

Public Sub SendKeys(ByVal sKeys As String)

   Dim X          As Integer
   
   ' *** loop thru string to send one key at a time
   For X = 1 To Len(sKeys)
      ' ***activate target application
      AppActivate (mvarDestination)
      ' ***send one key to target
      SendAKey Mid$(sKeys, X, 1)
   Next

End Sub

Public Property Let Destination(ByVal vData As Long)
   'used when assigning a value to the property, on the left si
   '     de of an assignment.
   
   ' ***Syntax: X.Destination = 5
   mvarDestination = vData
   
End Property

Public Property Get Destination() As Long
   
   'used when retrieving value of a property, on the right side
   '      of an assignment.
   ' ***Syntax: Debug.Print X.Destination
   Destination = mvarDestination
   
End Property

0
 
VerolandAuthor Commented:
Cool, thanks it workes.
0
 
watyCommented:
Great :ยง}
0
 
Tarun_GhoshCommented:
Try the sendkeys function
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now