I'm just a newbie and not good in programming. I have couple of questions that i want to ask regarding to my codes that i used in my application.
The application i made is an auto key presser. These codes are working fine in my favorite online game but not
and other keys are working in my online game. Except
But in notepad. Function Keys are working perfectly.
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
'Form1 with timer
Timer1_Timer()
Dim keys As New clsKeys
keys.PressKeyVK vbKeyF 'Show Friend list
End Sub
Can you give me an advice what strategy or what codes should i use or add to my Auto Key Presser to make the Function keys works in my online game?
) to an online game window. Is it possible in
Originally Posted by joi
