Attribute VB_Name = "modKeyboard"
Option Explicit


'=============================================================================================================
'
' modKeyboard Module
' ------------------
'
' Created By  : Kevin Wilson
'               http://www.TheVBZone.com   ( The VB Zone )
'               http://www.TheVBZone.net   ( The VB Zone .net )
'
' Last Update : July 26, 2000
'
' VB Versions : 5.0 / 6.0
'
' Requires    : NOTHING
'
' Description : This module was created to make it easy to work with they from withing a VB project.  This
'               program will wait for a key to be pressed (no matter what program has the focus), check if a
'               certain key is pressed, simulate the pressing of a certain key, or simulate the pressing of a
'               string of text.  All this is done through the Windows API withough sublcassing, Active X
'               controls, or .DLL's to eliminate the need to distribute files with your project and eliminate
'               the hastle of dealing with subclassing.
'
'
' Example Use :
' =============
'
'  WaitForKeyPress KEY_ESCAPE
'  VirtualKey_Send KEY_NUMPAD0
'  VirtualKey_Send KEY_RETURN
'  Send_Keys "Hello World!"
'
'=============================================================================================================
'
' LEGAL:
'
' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit
' given where credit is due.  Also, it is not required, but it would be appreciated if you would mention
' somewhere in your compiled program that that your program makes use of code written and distributed by
' Kevin Wilson (www.TheVBZone.com).  Feel free to link to this code via your web site or articles.
'
' You may NOT take this code and pass it off as your own.  You may NOT distribute this code on your own server
' or web site.  You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products,
' utilities, or applications that directly compete with products, utilities, and applications created by Kevin
' Wilson, TheVBZone.com, or Wilson Media.  You may NOT take this code and sell it for profit without first
' obtaining the written consent of the author Kevin Wilson.
'
' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without
' warning or notice.  Copyright© by Kevin Wilson.  All rights reserved.
'
'=============================================================================================================


' Public Types
Public Type KeyboardBytes
  kbByte(0 To 255) As Byte
End Type

' Public Constants

' <ALT> Keys
Public Const KEY_MENU = &H12
Public Const KEY_LMENU = &HA4
Public Const KEY_RMENU = &HA5

' <SHIFT> Keys
Public Const KEY_SHIFT = &H10
Public Const KEY_LSHIFT = &HA0
Public Const KEY_RSHIFT = &HA1

' <CTRL> Keys
Public Const KEY_CONTROL = &H11
Public Const KEY_LCONTROL = &HA2
Public Const KEY_RCONTROL = &HA3

' Mouse Buttons
Public Const KEY_LBUTTON = &H1
Public Const KEY_MBUTTON = &H4
Public Const KEY_RBUTTON = &H2

' Number Pad Keys
Public Const KEY_NUMPAD0 = &H60
Public Const KEY_NUMPAD1 = &H61
Public Const KEY_NUMPAD2 = &H62
Public Const KEY_NUMPAD3 = &H63
Public Const KEY_NUMPAD4 = &H64
Public Const KEY_NUMPAD5 = &H65
Public Const KEY_NUMPAD6 = &H66
Public Const KEY_NUMPAD7 = &H67
Public Const KEY_NUMPAD8 = &H68
Public Const KEY_NUMPAD9 = &H69

' Function Keys
Public Const KEY_F1 = &H70
Public Const KEY_F2 = &H71
Public Const KEY_F3 = &H72
Public Const KEY_F4 = &H73
Public Const KEY_F5 = &H74
Public Const KEY_F6 = &H75
Public Const KEY_F7 = &H76
Public Const KEY_F8 = &H77
Public Const KEY_F9 = &H78
Public Const KEY_F10 = &H79
Public Const KEY_F11 = &H7A
Public Const KEY_F12 = &H7B
Public Const KEY_F13 = &H7C
Public Const KEY_F14 = &H7D
Public Const KEY_F15 = &H7E
Public Const KEY_F16 = &H7F
Public Const KEY_F17 = &H80
Public Const KEY_F18 = &H81
Public Const KEY_F19 = &H82
Public Const KEY_F20 = &H83
Public Const KEY_F21 = &H84
Public Const KEY_F22 = &H85
Public Const KEY_F23 = &H86
Public Const KEY_F24 = &H87

' Common Keyboard Keys
Public Const KEY_0 = 48
Public Const KEY_1 = 49
Public Const KEY_2 = 50
Public Const KEY_3 = 51
Public Const KEY_4 = 52
Public Const KEY_5 = 53
Public Const KEY_6 = 54
Public Const KEY_7 = 55
Public Const KEY_8 = 56
Public Const KEY_9 = 57
Public Const KEY_A = 65
Public Const KEY_B = 66
Public Const KEY_C = 67
Public Const KEY_D = 68
Public Const KEY_E = 69
Public Const KEY_F = 70
Public Const KEY_G = 71
Public Const KEY_H = 72
Public Const KEY_I = 73
Public Const KEY_J = 74
Public Const KEY_K = 75
Public Const KEY_L = 76
Public Const KEY_M = 77
Public Const KEY_N = 78
Public Const KEY_O = 79
Public Const KEY_P = 80
Public Const KEY_Q = 81
Public Const KEY_R = 82
Public Const KEY_S = 83
Public Const KEY_T = 84
Public Const KEY_U = 85
Public Const KEY_V = 86
Public Const KEY_W = 87
Public Const KEY_X = 88
Public Const KEY_Y = 89
Public Const KEY_Z = 90
Public Const KEY_a_ = 97
Public Const KEY_b_ = 98
Public Const KEY_c_ = 99
Public Const KEY_d_ = 100
Public Const KEY_e_ = 101
Public Const KEY_f_ = 102
Public Const KEY_g_ = 103
Public Const KEY_h_ = 104
Public Const KEY_i_ = 105
Public Const KEY_j_ = 106
Public Const KEY_k_ = 107
Public Const KEY_l_ = 108
Public Const KEY_m_ = 109
Public Const KEY_n_ = 110
Public Const KEY_o_ = 111
Public Const KEY_p_ = 112
Public Const KEY_q_ = 113
Public Const KEY_r_ = 114
Public Const KEY_s_ = 115
Public Const KEY_t_ = 116
Public Const KEY_u_ = 117
Public Const KEY_v_ = 118
Public Const KEY_w_ = 119
Public Const KEY_x_ = 120
Public Const KEY_y_ = 121
Public Const KEY_z_ = 122

' Other Keys
Public Const KEY_ADD = &H6B
Public Const KEY_ATTN = &HF6
Public Const KEY_BACK = &H8
Public Const KEY_CANCEL = &H3
Public Const KEY_CAPITAL = &H14
Public Const KEY_CLEAR = &HC
Public Const KEY_CRSEL = &HF7
Public Const KEY_DECIMAL = &H6E
Public Const KEY_DELETE = &H2E
Public Const KEY_DIVIDE = &H6F
Public Const KEY_DOWN = &H28
Public Const KEY_END = &H23
Public Const KEY_EREOF = &HF9
Public Const KEY_ESCAPE = &H1B
Public Const KEY_EXECUTE = &H2B
Public Const KEY_EXSEL = &HF8
Public Const KEY_HELP = &H2F
Public Const KEY_HOME = &H24
Public Const KEY_INSERT = &H2D
Public Const KEY_LEFT = &H25
Public Const KEY_MULTIPLY = &H6A
Public Const KEY_NEXT = &H22
Public Const KEY_NONAME = &HFC
Public Const KEY_NUMLOCK = &H90
Public Const KEY_OEM_CLEAR = &HFE
Public Const KEY_PA1 = &HFD
Public Const KEY_PAUSE = &H13
Public Const KEY_PLAY = &HFA
Public Const KEY_PRINT = &H2A
Public Const KEY_PRIOR = &H21
Public Const KEY_PROCESSKEY = &HE5
Public Const KEY_RETURN = &HD
Public Const KEY_RIGHT = &H27
Public Const KEY_SCROLL = &H91
Public Const KEY_SELECT = &H29
Public Const KEY_SEPARATOR = &H6C
Public Const KEY_SNAPSHOT = &H2C
Public Const KEY_SPACE = &H20
Public Const KEY_SUBTRACT = &H6D
Public Const KEY_TAB = &H9
Public Const KEY_UP = &H26
Public Const KEY_ZOOM = &HFB
Public Const KEYEVENTF_KEYUP = &H2

' Public Variables
Public kbKeys As KeyboardBytes

' Public Declarations
Public Declare Sub keybd_event Lib "USER32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Public Declare Function MapVirtualKey Lib "USER32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Public Declare Function GetAsyncKeyState Lib "USER32" (ByVal vKey As Long) As Integer
Public Declare Function GetKeyboardState Lib "USER32" (kbArray As KeyboardBytes) As Long
Public Declare Function GetKeyState Lib "USER32" (ByVal nVirtKey As Long) As Integer
Public Declare Function VkKeyScan Lib "USER32" Alias "VkKeyScanA" (ByVal cChar As Byte) As Integer
Public Declare Function CharToOem Lib "USER32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Public Declare Function OemKeyScan Lib "USER32" (ByVal wOemChar As Long) As Long

' Function that checks if a specified virtual key (0-255) is currently pressed
Public Function VirtualKey_Check(ByVal VirtualKey As Long) As Boolean
On Error Resume Next
  
  If VirtualKey > 255 Then
    Exit Function
  ElseIf VirtualKey < 0 Then
    Exit Function
  End If
  
  VirtualKey_Check = CBool(GetAsyncKeyState(VirtualKey))
  
End Function

' Function that sends a specified virtual key (0-255) as if that key was pressed
' on the keyboard by the user
Public Function VirtualKey_Send(ByVal VirtualKey As Long, Optional ByVal KeyDownOnly As Boolean = False, Optional ByVal KeyUpOnly As Boolean = False)
On Error Resume Next
  
  Dim bytVirtKey As Byte
  
  If VirtualKey > 255 Then
    Exit Function
  ElseIf VirtualKey < 0 Then
    Exit Function
  End If
  
  If KeyDownOnly = True Then
    keybd_event VirtualKey, 0, 0, 0
  ElseIf KeyUpOnly = True Then
    keybd_event VirtualKey, 0, KEYEVENTF_KEYUP, 0
  Else
    keybd_event VirtualKey, 0, 0, 0
    keybd_event VirtualKey, 0, KEYEVENTF_KEYUP, 0
  End If
  
End Function

' Function that will wait for a specified virtual key (0-255) to be pressed
Public Function WaitForKeyPress(ByVal VirtualKey As Long, Optional ByVal EscapeKey1 As Long = 999, Optional ByVal EscapeKey2 As Long = 999) As Boolean
On Error Resume Next
  
  While GetAsyncKeyState(VirtualKey) = 0
    DoEvents
    If EscapeKey1 <> 999 Then
      If GetAsyncKeyState(EscapeKey1) <> 0 Then
        GoTo TheEnd
      End If
    End If
    If EscapeKey2 <> 999 Then
      If GetAsyncKeyState(EscapeKey2) <> 0 Then
        GoTo TheEnd
      End If
    End If
    DoEvents
  Wend
  
TheEnd:
  
  WaitForKeyPress = True
  
End Function

' This function takes the place of VB's standard function SendKeys()
' SendKeys() can be slow and inaccurate.  This function accesses the
' keyboard directly through the Windows API and sends the keys
'
' * NOTE : If the SendAccurately variable is set to FALSE, the keys will be
' sent MUCH quicker, especially if you're sending a lot of text.  However,
' By doing so, you risk having the text sent incorrectly as this is more
' error prone... especially if you have a lot of tasks running, or have
' other CPU intensive programs running.
Public Function Send_Keys(ByVal StringToEnter As String, Optional ByVal SendAccurately As Boolean = True) As Boolean
On Error GoTo ErrorTrap
   
  Dim MyCounter As Integer
  Dim boolShift As Boolean
  Dim strChar As String
  Dim strOemChar As String
  Dim bytVKey As Byte
  Dim bytScan As Byte
  Dim bytVirtKey As Byte
  Dim intCAPLOCK As Integer
  
  For MyCounter = 1 To Len(StringToEnter)
    strChar = Mid(StringToEnter, MyCounter, 1)
    
    ' Test if the character requires a SHIFT press
    If strChar = "~" Or strChar = "!" Or strChar = "@" Or strChar = "#" _
    Or strChar = "$" Or strChar = "%" Or strChar = "^" Or strChar = "&" _
    Or strChar = "*" Or strChar = "(" Or strChar = ")" Or strChar = "_" _
    Or strChar = "+" Or strChar = "|" Or strChar = "<" Or strChar = ">" _
    Or strChar = "?" Or strChar = ":" Or strChar = Chr(34) _
    Or strChar = "{" Or strChar = "}" Then
      boolShift = True
      bytVirtKey = MapVirtualKey(KEY_SHIFT, 0)
      keybd_event KEY_SHIFT, bytVirtKey, 0, 0  ' Send SHIFT key press
    ElseIf Asc(strChar) >= 65 And Asc(strChar) <= 90 Then ' UPPER CASE ALPHA CHAR
      intCAPLOCK = GetKeyState(KEY_CAPITAL)    ' 1 = Down, 0 = Up
      If intCAPLOCK = 0 Then
        boolShift = True
        bytVirtKey = MapVirtualKey(KEY_SHIFT, 0)
        keybd_event KEY_SHIFT, bytVirtKey, 0, 0 ' Send SHIFT key press
      End If
    ElseIf Asc(strChar) >= 97 And Asc(strChar) <= 122 Then ' lower case alpha char
      intCAPLOCK = GetKeyState(KEY_CAPITAL)     ' 1 = Down, 0 = Up
      If intCAPLOCK = 1 Then
        boolShift = True
        bytVirtKey = MapVirtualKey(KEY_SHIFT, 0)
        keybd_event KEY_SHIFT, bytVirtKey, 0, 0 ' Send SHIFT key press
      End If
    End If
    
    bytVKey = VkKeyScan(Asc(strChar)) And &HFF
    strOemChar = "  "
    CharToOem Left(strChar, 1), strOemChar
    
    bytScan = OemKeyScan(Asc(strOemChar)) And &HFF
    keybd_event bytVKey, bytScan, 0, 0               ' Send the key down
    keybd_event bytVKey, bytScan, KEYEVENTF_KEYUP, 0 ' Send the key up
    
    If boolShift = True Then
      boolShift = False
      keybd_event KEY_SHIFT, bytVirtKey, KEYEVENTF_KEYUP, 0 ' Send SHIFT key up
    End If
    If SendAccurately = True Then
      DoEvents
    End If
  Next MyCounter
  
  Send_Keys = True
  
  Exit Function
  
ErrorTrap:
  
  If Err.Number = 0 Then      ' No Error
    Resume Next
  ElseIf Err.Number = 20 Then ' Resume without error
    Resume Next
  Else
    Send_Keys = False
    Err.Clear
    Exit Function
  End If
   
End Function