VB6 codes sending Function Keys to my online games

'--------- 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

 
'Form1 with timer
 
Timer1_Timer()
    Dim keys As New clsKeys

    keys.PressKeyVK vbKeyF 'Show Friend list
End Sub