Sample - Keys

Keys

Description:
	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. 8/5/1999: Added scan codes, allowing the keystrokes to be sent to a dos window. 9/29/1999: Added compatibility flag to PressKeyVK to attempt to make extended keys work with some dos applications. 11/29/1999: Added PressSendKeys function, which attempts to parse SendKeys() style commands.

Code:
	'--------- 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 keyPageUp = &H21 keyPageDown = &H22 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 'Presses a sequence of keys, attempts to parse strings like 'SendKeys() does. Public Sub PressSendKeys(ByVal sKeys As String) Dim nPos As Long Dim sPart As String Dim colModify As Collection: Set colModify = New Collection Dim bBrace As Boolean Dim i As Long Dim nCount As Long Dim nVK As Long nPos = 1 Do While nPos <= Len(sKeys) Select Case UCase(Mid(sKeys, nPos, 1)) Case "+", "^", "%" If Mid(sKeys, nPos, 1) = "+" Then nVK = keyShift ElseIf Mid(sKeys, nPos, 1) = "^" Then nVK = keyControl Else 'Mid(sKeys, nPos, 1) = "%" then nVK = keyAlt End If PressKeyVK nVK, True colModify.Add nVK If Mid(sKeys, nPos + 1, 1) <> "(" And Mid(sKeys, _ nPos + 1, 1) <> "{" Then sKeys = Mid(sKeys, 1, nPos) & "(" & Mid(sKeys, _ nPos + 1, 1) & ")" & Mid(sKeys, nPos + 2) End If Case "~" 'enter PressKeyVK keyReturn Case "(" 'do nothing Case ")", "}" If colModify.Count > 0 Then If colModify.Item(colModify.Count) <> 0 Then PressKeyVK colModify.Item(colModify.Count) _ , , True End If colModify.Remove colModify.Count End If Case "{" 'Brace colModify.Add 0 nCount = 0 FindSpecial nPos, sKeys, sPart, nCount, nVK If Mid(sKeys, nPos, 1) = " " Then nCount = 0 Do Until Mid(sKeys, nPos, 1) = "}" Or _ nPos > Len(sKeys) nCount = (nCount * 10) + _ Val(Mid(sKeys, nPos, 1)) nPos = nPos + 1 Loop Else nCount = 1 End If For i = 1 To nCount If nVK = 0 Then PressKey sPart Else PressKeyVK nVK DoEvents End If Next nPos = nPos - 1 Case Else PressKey Mid(sKeys, nPos, 1) End Select DoEvents nPos = nPos + 1 Loop End Sub Private Sub FindSpecial(nPos As Long, sKeys As String, _ sPart As String, nCount As Long, nVK As Long) Dim bFound As Boolean nCount = 1 nVK = 0 sPart = "" nPos = nPos + 1 bFound = True Select Case UCase(Mid(sKeys, nPos, 2)) Case "BS": nVK = keyBackspace Case "UP": nVK = KeyUp Case "F1": nVK = keyF1 Case "F2": nVK = keyF2 Case "F3": nVK = keyF3 Case "F4": nVK = keyF4 Case "F5": nVK = keyF5 Case "F6": nVK = keyF6 Case "F7": nVK = keyF7 Case "F8": nVK = keyF8 Case "F9": nVK = keyF9 Case Else bFound = False End Select If bFound Then nPos = nPos + 2 Exit Sub End If bFound = True Select Case UCase(Mid(sKeys, nPos, 3)) Case "F10": nVK = keyF10 Case "F11": nVK = keyF11 Case "F12": nVK = keyF12 Case "DEL": nVK = keyDelete Case "END": nVK = enumKeys.keyEnd Case "ESC": nVK = enumKeys.keyEscape Case "INS": nVK = enumKeys.keyInsert Case "TAB": nVK = enumKeys.keyTab Case Else bFound = False End Select If bFound Then nPos = nPos + 3 Exit Sub End If bFound = True Select Case UCase(Mid(sKeys, nPos, 4)) Case "BKSP": nVK = enumKeys.keyBackspace Case "DOWN": nVK = enumKeys.KeyDown Case "HOME": nVK = enumKeys.keyHome Case "LEFT": nVK = enumKeys.keyLeft Case "PGDN": nVK = enumKeys.keyPageDown Case "PGUP": nVK = enumKeys.keyPageUp Case Else bFound = False End Select If bFound Then nPos = nPos + 4 Exit Sub End If bFound = True Select Case UCase(Mid(sKeys, nPos, 5)) Case "ENTER": nVK = enumKeys.keyReturn Case "RIGHT": nVK = enumKeys.keyRight Case Else bFound = False End Select If bFound Then nPos = nPos + 5 Exit Sub End If bFound = True Select Case UCase(Mid(sKeys, nPos, 6)) Case "DELETE": nVK = enumKeys.keyInsert Case "INSERT": nVK = enumKeys.keyDelete Case Else bFound = False End Select If bFound Then nPos = nPos + 6 Exit Sub End If If UCase(Mid(sKeys, nPos, 7)) = "NUMLOCK" Then nVK = enumKeys.keyNumLock nPos = nPos + 7 Exit Sub End If If UCase(Mid(sKeys, nPos, 8)) = "CAPSLOCK" Then nVK = enumKeys.keyCapsLock nPos = nPos + 8 Exit Sub End If If UCase(Mid(sKeys, nPos, 9)) = "BACKSPACE" Then nVK = enumKeys.keyBackspace nPos = nPos + 9 Exit Sub End If If UCase(Mid(sKeys, nPos, 10)) = "SCROLLLOCK" Then nVK = enumKeys.keyScrollLock nPos = nPos + 10 Exit Sub End If nVK = 0 sPart = Mid(sKeys, nPos, 1) nPos = nPos + 1 End Sub '--------- End of class: clsKeys

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."