Atlanta Custom Software Development 

   Search        Code/Page
 

User Login
Email

Password

 

Forgot the Password?
Services
» Web Development
» Maintenance
» Data Integration/BI
» Information Management
Programming
  Database
Automation
OS/Networking
Graphics
Links
Tools
» Regular Expr Tester
» Free Tools

VBSendKeys - Send keys to any Windows and MS-DOS application

Total Hit ( 7260)

Rate this article:     Poor     Excellent 

 Submit Your Question/Comment about this article

Rating


 


Click here to copy the following block
Private Declare Function OemKeyScan Lib "user32" (ByVal wOemChar 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 Const KEYEVENTF_KEYDOWN   As Long = &H0
Private Const KEYEVENTF_KEYUP    As Long = &H2

Type VKType
  VKCode As Integer
  scanCode As Integer
  Control As Boolean
  Shift As Boolean
  Alt As Boolean
End Type

'---------------------------------------------------------------------
' Routine: VbSendKeys()
'
' Author: Bryan Wolf, 1999
'
' Purpose: Imitate VB's internal SendKeys statement, but add the
'     ability to send keypresses to a DOS application. You
'     can use SendKeys, to paste ASCII characters to a DOS
'     window from the clipboard, but you can't send function
'     keys. This module solves that problem and makes sending
'     any keys to any Application, DOS or Windows, easy.
'
' Arguments: Keystrokes. Note that this does not implement the
'      SendKeys's 'wait' argument. If you need to wait,
'      try using a timing loop.
'
'      The syntax for specifying keystrokes is the
'      same as that of SendKeys - Please refer to VB's
'      documentation for an in-depth description. Support
'      for the following codes has been added, in addition
'      to the standard set of codes suppored by SendKeys:
'
'      KEY         CODE
'      break        {CANCEL}
'      escape        {ESCAPE}
'      left mouse button  {LBUTTON}
'      right mouse button  {RBUTTON}
'      middle mouse button {MBUTTON}
'      clear        {CLEAR}
'      shift        {SHIFT}
'      control       {CONTROL}
'      alt         {MENU} or {ALT}
'      pause        {PAUSE}
'      space        {SPACE}
'      select        {SELECT}
'      execute       {EXECUTE}
'      snapshot       {SNAPSHOT}
'      number pad 0     {NUMPAD0}
'      number pad 1     {NUMPAD1}
'      number pad 2     {NUMPAD2}
'      number pad 3     {NUMPAD3}
'      number pad 4     {NUMPAD4}
'      number pad 5     {NUMPAD5}
'      number pad 6     {NUMPAD6}
'      number pad 7     {NUMPAD7}
'      number pad 8     {NUMPAD8}
'      number pad 9     {NUMPAD9}
'      number pad multiply {MULTIPLY}
'      number pad add    {ADD}
'      number pad separator {SEPARATOR}
'      number pad subtract {SUBTRACT}
'      number pad decimal  {DECIMAL}
'      number pad divide  {DIVIDE}
'
' Sample Calls:
'  VbSendKeys "Dir~"  ' View a directory of in DOS
'
' NOTE: there is a minor difference with SendKeys syntax. You can
'    group multiple characters under the same shift key using
'    curly brackets, while VB's SendKeys uses regular brackets.
'    For example, to keep the SHIFT key pressed while you type
'    A, B, and C keys, you must run the following statement
'      VBSendKeys "+{abc}"
'    while the syntax of the built-in VB function is
'      SendKeys "+(abc)"
'---------------------------------------------------------------------

Sub VbSendKeys(ByVal sKeystrokes As String)
  Dim iKeyStrokesLen As Integer
  Dim lRepetitions As Long
  Dim bShiftKey As Boolean
  Dim bControlKey As Boolean
  Dim bAltKey As Boolean
  Dim lResult As Long
  Dim sKey As String
  Dim iAsciiKey As Integer
  Dim iVirtualKey As Integer
  Dim i As Long
  Dim j As Long
 
  Static bInitialized As Boolean
  Static AsciiKeys(0 To 255) As VKType
  Static VirtualKeys(0 To 255) As VKType
 
  On Error GoTo 0

  If Not bInitialized Then
    Dim iKey As Integer
    Dim OEMChar As String
    Dim keyScan As Integer
    
    ' Initialize AsciiKeys()
    For iKey = LBound(AsciiKeys) To UBound(AsciiKeys)
      keyScan = VkKeyScan(iKey)
      AsciiKeys(iKey).VKCode = keyScan And &HFF  ' low-byte of key scan
                            ' code
      AsciiKeys(iKey).Shift = (keyScan And &H100)
      AsciiKeys(iKey).Control = (keyScan And &H200)
      AsciiKeys(iKey).Alt = (keyScan And &H400)
      ' Get the ScanCode
      OEMChar = " " ' 2 Char
      CharToOem Chr(iKey), OEMChar
      AsciiKeys(iKey).scanCode = OemKeyScan(Asc(OEMChar)) And &HFF
    Next iKey
    
    ' Initialize VirtualKeys()
    For iKey = LBound(VirtualKeys) To UBound(VirtualKeys)
      VirtualKeys(iKey).VKCode = iKey
      VirtualKeys(iKey).scanCode = MapVirtualKey(iKey, 0)
      ' no use in initializing remaining elements
    Next iKey
    bInitialized = True   ' don't run this code twice
  End If  ' End of initialization routine
 
  ' Parse the string in the same way that SendKeys() would
  Do While Len(sKeystrokes)
    lRepetitions = 1 ' Default number of repetitions for each character
    bShiftKey = False
    bControlKey = False
    bAltKey = False
    
    ' Pull off Control, Alt or Shift specifiers
    sKey = Left$(sKeystrokes, 1)
    sKeystrokes = Mid$(sKeystrokes, 2)
    
    Do While InStr(" ^%+", sKey) > 1 ' The space in " ^%+" is necessary
      If sKey = "+" Then
        bShiftKey = True
      ElseIf sKey = "^" Then
        bControlKey = True
      ElseIf sKey = "%" Then
        bAltKey = True
      End If
      sKey = Left$(sKeystrokes, 1)
      sKeystrokes = Mid$(sKeystrokes, 2)
    Loop
    
    ' Look for "{}"
    If sKey = "{" Then
      ' Look for the "}"
      i = InStr(sKeystrokes, "}")
      If i > 0 Then
        sKey = Left$(sKeystrokes, i - 1) ' extract the content between
                         ' the {}
        sKeystrokes = Mid$(sKeystrokes, i + 1) ' Remove the }
      End If
    
      ' Look for repetitions
      i = Len(sKey)
      Do While Mid$(sKey, i, 1) >= "0" And Mid$(sKey, i, _
        1) <= "9" And i >= 3
        i = i - 1
      Loop
    
      If i < Len(sKey) Then ' If any digits were found...
        If i >= 2 Then ' If there is something preceding it...
          If Mid$(sKey, i, 1) = " " Then ' If a space precedes the
                          ' digits...
            On Error Resume Next ' On overflow, ignore the value
            lRepetitions = CLng(Mid$(sKey, i + 1))
            On Error GoTo 0
            sKey = Left$(sKey, i - 1)
          End If
        End If
      End If
    End If
    
    ' Look for special words
    Select Case UCase$(sKey)
      Case "LBUTTON" ' New
        iVirtualKey = vbKeyLButton
      Case "RBUTTON" ' New
        iVirtualKey = vbKeyRButton
      Case "BREAK", "CANCEL"
        iVirtualKey = vbKeyCancel
      Case "MBUTTON" ' New
        iVirtualKey = vbKeyMButton
      Case "BACKSPACE", "BS", "BKSP"
        iVirtualKey = vbKeyBack
      Case "TAB"
        iVirtualKey = vbKeyTab
      Case "CLEAR" ' New
        iVirtualKey = vbKeyClear
      Case "ENTER", "~"
        iVirtualKey = vbKeyReturn
      Case "SHIFT" ' New
        iVirtualKey = vbKeyShift
      Case "CONTROL" ' New
        iVirtualKey = vbKeyControl
      Case "MENU", "ALT" ' New
        iVirtualKey = vbKeyMenu
      Case "PAUSE" ' New
        iVirtualKey = vbKeyPause
      Case "CAPSLOCK"
        iVirtualKey = vbKeyCapital
      Case "ESCAPE", "ESC"
        iVirtualKey = vbKeyEscape
      Case "SPACE" ' New
        iVirtualKey = vbKeySpace
      Case "PGUP"
        iVirtualKey = vbKeyPageUp
      Case "PGDN"
        iVirtualKey = vbKeyPageDown
      Case "END"
        iVirtualKey = vbKeyEnd
      Case "HOME" ' New
        iVirtualKey = vbKeyHome
      Case "LEFT"
        iVirtualKey = vbKeyLeft
      Case "UP"
        iVirtualKey = vbKeyUp
      Case "RIGHT"
        iVirtualKey = vbKeyRight
      Case "DOWN"
        iVirtualKey = vbKeyDown
      Case "SELECT" ' New
        iVirtualKey = vbKeySelect
      Case "PRTSC"
        iVirtualKey = vbKeyPrint
      Case "EXECUTE" ' New
        iVirtualKey = vbKeyExecute
      Case "SNAPSHOT" ' New
        iVirtualKey = vbKeySnapshot
      Case "INSERT", "INS"
        iVirtualKey = vbKeyInsert
      Case "DELETE", "DEL"
        iVirtualKey = vbKeyDelete
      Case "HELP"
        iVirtualKey = vbKeyHelp
      Case "NUMLOCK"
        iVirtualKey = vbKeyNumlock
      Case "SCROLLLOCK"
        iVirtualKey = vbKeyScrollLock
      Case "NUMPAD0" ' New
        iVirtualKey = vbKeyNumpad0
      Case "NUMPAD1" ' New
        iVirtualKey = vbKeyNumpad1
      Case "NUMPAD2" ' New
        iVirtualKey = vbKeyNumpad2
      Case "NUMPAD3" ' New
        iVirtualKey = vbKeyNumpad3
      Case "NUMPAD4" ' New
        iVirtualKey = vbKeyNumpad4
      Case "NUMPAD5" ' New
        iVirtualKey = vbKeyNumpad5
      Case "NUMPAD6" ' New
        iVirtualKey = vbKeyNumpad6
      Case "NUMPAD7" ' New
        iVirtualKey = vbKeyNumpad7
      Case "NUMPAD8" ' New
        iVirtualKey = vbKeyNumpad8
      Case "NUMPAD9" ' New
        iVirtualKey = vbKeyNumpad9
      Case "MULTIPLY" ' New
        iVirtualKey = vbKeyMultiply
      Case "ADD" ' New
        iVirtualKey = vbKeyAdd
      Case "SEPARATOR" ' New
        iVirtualKey = vbKeySeparator
      Case "SUBTRACT" ' New
        iVirtualKey = vbKeySubtract
      Case "DECIMAL" ' New
        iVirtualKey = vbKeyDecimal
      Case "DIVIDE" ' New
        iVirtualKey = vbKeyDivide
      Case "F1"
        iVirtualKey = vbKeyF1
      Case "F2"
        iVirtualKey = vbKeyF2
      Case "F3"
        iVirtualKey = vbKeyF3
      Case "F4"
        iVirtualKey = vbKeyF4
      Case "F5"
        iVirtualKey = vbKeyF5
      Case "F6"
        iVirtualKey = vbKeyF6
      Case "F7"
        iVirtualKey = vbKeyF7
      Case "F8"
        iVirtualKey = vbKeyF8
      Case "F9"
        iVirtualKey = vbKeyF9
      Case "F10"
        iVirtualKey = vbKeyF10
      Case "F11"
        iVirtualKey = vbKeyF11
      Case "F12"
        iVirtualKey = vbKeyF12
      Case "F13"
        iVirtualKey = vbKeyF13
      Case "F14"
        iVirtualKey = vbKeyF14
      Case "F15"
        iVirtualKey = vbKeyF15
      Case "F16"
        iVirtualKey = vbKeyF16
      Case Else
        ' Not a virtual key
        iVirtualKey = -1
    End Select
    
    ' Turn on CONTROL, ALT and SHIFT keys as needed
    If bShiftKey Then
      keybd_event VirtualKeys(vbKeyShift).VKCode, _
        VirtualKeys(vbKeyShift).scanCode, KEYEVENTF_KEYDOWN, 0
    End If
    
    If bControlKey Then
      keybd_event VirtualKeys(vbKeyControl).VKCode, _
        VirtualKeys(vbKeyControl).scanCode, KEYEVENTF_KEYDOWN, 0
    End If
    
    If bAltKey Then
      keybd_event VirtualKeys(vbKeyMenu).VKCode, _
        VirtualKeys(vbKeyMenu).scanCode, KEYEVENTF_KEYDOWN, 0
    End If
    
    ' Send the keystrokes
    For i = 1 To lRepetitions
      If iVirtualKey > -1 Then
        ' Virtual key
        keybd_event VirtualKeys(iVirtualKey).VKCode, _
          VirtualKeys(iVirtualKey).scanCode, KEYEVENTF_KEYDOWN, 0
        keybd_event VirtualKeys(iVirtualKey).VKCode, _
          VirtualKeys(iVirtualKey).scanCode, KEYEVENTF_KEYUP, 0
      Else
        ' ASCII Keys
        For j = 1 To Len(sKey)
          iAsciiKey = Asc(Mid$(sKey, j, 1))
          ' Turn on CONTROL, ALT and SHIFT keys as needed
          If Not bShiftKey Then
            If AsciiKeys(iAsciiKey).Shift Then
              keybd_event VirtualKeys(vbKeyShift).VKCode, _
                VirtualKeys(vbKeyShift).scanCode, _
                KEYEVENTF_KEYDOWN, 0
            End If
          End If
    
          If Not bControlKey Then
            If AsciiKeys(iAsciiKey).Control Then
              keybd_event VirtualKeys(vbKeyControl).VKCode, _
                VirtualKeys(vbKeyControl).scanCode, _
                KEYEVENTF_KEYDOWN, 0
            End If
          End If
    
          If Not bAltKey Then
            If AsciiKeys(iAsciiKey).Alt Then
              keybd_event VirtualKeys(vbKeyMenu).VKCode, _
                VirtualKeys(vbKeyMenu).scanCode, _
                KEYEVENTF_KEYDOWN, 0
            End If
          End If
    
          ' Press the key
          keybd_event AsciiKeys(iAsciiKey).VKCode, _
            AsciiKeys(iAsciiKey).scanCode, KEYEVENTF_KEYDOWN, 0
          keybd_event AsciiKeys(iAsciiKey).VKCode, _
            AsciiKeys(iAsciiKey).scanCode, KEYEVENTF_KEYUP, 0
    
          ' Turn on CONTROL, ALT and SHIFT keys as needed
          If Not bShiftKey Then
            If AsciiKeys(iAsciiKey).Shift Then
              keybd_event VirtualKeys(vbKeyShift).VKCode, _
                VirtualKeys(vbKeyShift).scanCode, _
                KEYEVENTF_KEYUP, 0
            End If
          End If
    
          If Not bControlKey Then
            If AsciiKeys(iAsciiKey).Control Then
              keybd_event VirtualKeys(vbKeyControl).VKCode, _
                VirtualKeys(vbKeyControl).scanCode, _
                KEYEVENTF_KEYUP, 0
            End If
          End If
    
          If Not bAltKey Then
            If AsciiKeys(iAsciiKey).Alt Then
              keybd_event VirtualKeys(vbKeyMenu).VKCode, _
                VirtualKeys(vbKeyMenu).scanCode, _
                KEYEVENTF_KEYUP, 0
            End If
          End If
        Next j ' Each ASCII key
      End If ' ASCII keys
    Next i ' Repetitions
    
    ' Turn off CONTROL, ALT and SHIFT keys as needed
    If bShiftKey Then
      keybd_event VirtualKeys(vbKeyShift).VKCode, _
        VirtualKeys(vbKeyShift).scanCode, KEYEVENTF_KEYUP, 0
    End If
    
    If bControlKey Then
      keybd_event VirtualKeys(vbKeyControl).VKCode, _
        VirtualKeys(vbKeyControl).scanCode, KEYEVENTF_KEYUP, 0
    End If
    
    If bAltKey Then
      keybd_event VirtualKeys(vbKeyMenu).VKCode, _
        VirtualKeys(vbKeyMenu).scanCode, KEYEVENTF_KEYUP, 0
    End If
    
  Loop ' sKeyStrokes
End Sub


Audit, Notify, Deploy and Manage SSIS
Download the Free 30-day Trial Version...Learn More About This Product...

Submitted By : Nayan Patel  (Member Since : 5/26/2004 12:23:06 PM)

Job Description : He is the moderator of this site and currently working as an independent consultant. He works with VB.net/ASP.net, SQL Server and other MS technologies. He is MCSD.net, MCDBA and MCSE. In his free time he likes to watch funny movies and doing oil painting.
View all (893) submissions by this author  (Birth Date : 7/14/1981 )


Home   |  Comment   |  Contact Us   |  Privacy Policy   |  Terms & Conditions   |  Blogs

© 2008 BinaryWorld LLC. All rights reserved.