File "SendInput.inc"
Path: /aliexpress/SendInput.inc
File size: 14.82 KB
MIME-type:
Charset: 8 bit
'===============================================================================
' SendInput.inc
' 2009 - Eddy Van Esch
'
' History:
' --------
' V1.0: 14-May-2009 : Initial version
'
' V1.1: 27-May-2009 :
' - Fixed a bug where SHIFT_D with HOME or an arrow key combination produced
' incorrect results. The shift key appeared to be ignored.
' Thanks to S. Stamp for reporting the problem.
'
' Apparently, the HOME and arrow keys (and a number of others) are extended keys and
' they require the extended key flag to be set.
' A forum thread about the problem:
' http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_21737163.html
' - Added more special keys (see list below)
' - SUB WaitForNoKeys slightly modified
'
' ---------------------------------------------------------------------------
' This software allows to send keystrokes to the application that
' currently has focus.
' Rather than using KEYBD_EVENT, this routine uses SENDINPUT.
' The advantage is that when using SendInput, the sent keystrokes can not
' be accidently mixed with keystrokes that the user is entering on the keyboard.
' Also, there is no problem with timings between multiple Keybd_Event commands.
' This routine also handles characters with diacritics, like ,,,, etc. (See **)
' Writing this code, I took inspiration (and a few lines of code :-)) from
' William Burns' file 'SendKeys.inc'
' Not all possible special keys are implemented yet, but it is easy to add more.
'
'Sub WaitForNoKeys was reused from William Burns' file 'SendKeys.inc'. Thanks William!
'
'----------------------------
'** IMPORTANT !!!
'Although SendString should handle strings with diacritics properly, other active programs
'can mess this up. Especially programs that use a global keyboard hook, such
'as AutoHotKey for example.
'The reason is that these programs use the ToAscii(Ex) API function in their keyboard hook.
'Using ToAscii(Ex) in a hook messes up diacritics handling.
'What you then will notice is an inconsistent behaviour when sending characters with diacritics.
'For example, sending "" could result in "ee", "''e" or some other inconsistent result.
'Very annoying. The only solution is to terminate the application that is using the global hook.
'----------------------------
'
'===============================================================================
#IF NOT %DEF(%WINAPI)
#INCLUDE "win32api.inc" 'add win32api if not already added
#ENDIF
'-------------------------------------------------------------------------
'This sub places the characters in 'sString' in the keyboard buffer. Then, the characters are sent to
'whatever application currently has focus.
'So, this sub allows to simulate keyboard input.
'Apart from normal ascii characters, SendString can also handle some special characters:
'
'The special characters currently implemented are:
'{CTRL_D}, {CTRL_U}, {ALT_D}, {ALT_U}, {SHIFT_D}, {SHIFT_U}, {WIN_D}, {WIN_U}, {BACKSPACE}
'{ENTER}, {INSERT}, {DELETE}, {RIGHT}, {LEFT}, {UP}, {DOWN}, {HOME}, {END}, {TAB}, {ESCAPE}
'{PGUP}, {PGDN}, {F1}, {F2}, {F3}, {F4}, {F5}, {F6}, {F7}, {F8}, {F9}, {F10}, {F11}, {F12}
'{APPS}, {NUMLOCK}
'The {.._D} are the 'key down' codes. The {.._U} are the 'key up' codes.
'
'Examples of use:
'SendString "This is a test"
'SendString "{BACKSPACE}{BACKSPACE}abcdef{ENTER}"
'SendString "{CTRL_D}c{CTRL_U}" simulates a CTRL-C key combination. In most applications this copies the selected data.
'
%TimeIncr = 0
SUB SendString(BYVAL sString AS STRING)
LOCAL i AS LONG
LOCAL lBufCnt AS LONG
LOCAL lFetchingSpecialChar AS LONG
LOCAL sChar AS STRING
LOCAL sSpecialChar AS STRING
LOCAL iRet AS INTEGER
LOCAL dKeybLayout AS DWORD
LOCAL bVkCode AS BYTE
LOCAL bShiftState AS BYTE
LOCAL Time AS DWORD
LOCAL inpAPI() AS INPUTAPI
REDIM inpAPI(0:20)
IF sString = "" THEN EXIT SUB
dKeybLayout = GETKEYBOARDLAYOUT(0)
lBufCnt = -1
Time = 0
lFetchingSpecialChar = 0
FOR i = 1 TO LEN(sString) 'Parse the input string character by character
sChar = MID$(sString, i, 1)
SELECT CASE sChar
CASE "{" 'Start of a special-character sequence
lFetchingSpecialChar = 1
sSpecialChar = ""
CASE "}" 'End of a special-character sequence
lFetchingSpecialChar = 0
GOSUB AddSpecialCharToBuffer
CASE ELSE
IF lFetchingSpecialChar THEN
sSpecialChar = sSpecialChar + sChar 'Compose the special character string
ELSE
GOSUB AddNormalCharToBuffer
END IF
END SELECT
NEXT i
REDIM PRESERVE inpAPI(0 TO lBufCnt)
i = SENDINPUT(lBufCnt+1, inpAPI(0), SIZEOF(inpAPI(0)))
EXIT SUB
AddSpecialCharToBuffer:
'Special characters (such as ENTER, BACKSPACE, CTRL-down, etc) that can not be represented
'by an ASCII character, are defined here.
sSpecialChar = UCASE$(sSpecialChar)
SELECT CASE sSpecialChar
CASE "CTRL_D" : bVkCode = %VK_CONTROL : GOSUB bVkCode_Down
CASE "CTRL_U" : bVkCode = %VK_CONTROL : GOSUB bVkCode_Up
CASE "ALT_D" : bVkCode = %VK_MENU : GOSUB bVkCode_Down
CASE "ALT_U" : bVkCode = %VK_MENU : GOSUB bVkCode_Up
CASE "SHIFT_D" : bVkCode = %VK_SHIFT : GOSUB bVkCode_Down
CASE "SHIFT_U" : bVkCode = %VK_SHIFT : GOSUB bVkCode_Up
CASE "WIN_D" : bVkCode = %VK_LWIN : GOSUB bVkCode_Down
CASE "WIN_U" : bVkCode = %VK_LWIN : GOSUB bVkCode_Up
CASE "BACKSPACE" : bVkCode = %VK_BACK : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "ENTER" : bVkCode = %VK_RETURN : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "INSERT" : bVkCode = %VK_INSERT : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "DELETE" : bVkCode = %VK_DELETE : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "RIGHT" : bVkCode = %VK_RIGHT : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "LEFT" : bVkCode = %VK_LEFT : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "UP" : bVkCode = %VK_UP : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "DOWN" : bVkCode = %VK_DOWN : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "HOME" : bVkCode = %VK_HOME : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "END" : bVkCode = %VK_END : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "TAB" : bVkCode = %VK_TAB : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "ESCAPE" : bVkCode = %VK_ESCAPE : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "PGUP" : bVkCode = %VK_PGUP : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "PGDN" : bVkCode = %VK_PGDN : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "F1" : bVkCode = %VK_F1 : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "F2" : bVkCode = %VK_F2 : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "F3" : bVkCode = %VK_F3 : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "F4" : bVkCode = %VK_F4 : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "F5" : bVkCode = %VK_F5 : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "F6" : bVkCode = %VK_F6 : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "F7" : bVkCode = %VK_F7 : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "F8" : bVkCode = %VK_F8 : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "F9" : bVkCode = %VK_F9 : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "F10" : bVkCode = %VK_F10 : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "F11" : bVkCode = %VK_F11 : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "F12" : bVkCode = %VK_F12 : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "APPS" : bVkCode = %VK_APPS : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE "NUMLOCK" : bVkCode = %VK_NUMLOCK : GOSUB bVkCode_Down : GOSUB bVkCode_Up
'Caps lock
CASE "CAPITAL" : bVkCode = %VK_CAPITAL : GOSUB bVkCode_Down : GOSUB bVkCode_Up
CASE ELSE
END SELECT
RETURN
bVkCode_Down: 'key 'bVkCode' down
IF (UBOUND(inpAPI()) - lBufCnt) < 5 THEN REDIM PRESERVE inpAPI(lBufCnt + 16)
INCR lBufCnt
inpAPI(lBufCnt).dTYPE = %INPUT_KEYBOARD
inpAPI(lBufCnt).m.ki.wVk = bVkCode
inpAPI(lBufCnt).m.ki.time = Time
inpAPI(lBufCnt).m.ki.wScan = MAPVIRTUALKEY(bVkCode, 0)
'Intercept extended keys. They require the extended key flag.
'
SELECT CASE bVkCode
CASE %VK_UP, %VK_DOWN, %VK_LEFT, %VK_RIGHT, %VK_HOME, %VK_END, %VK_INSERT, %VK_DELETE, %VK_PGUP, %VK_PGDN
inpAPI(lBufCnt).m.ki.dwFlags = %KEYEVENTF_EXTENDEDKEY
CASE ELSE
inpAPI(lBufCnt).m.ki.dwFlags = 0
END SELECT
RETURN
bVkCode_Up: 'key 'bVkCode' up
IF (UBOUND(inpAPI()) - lBufCnt) < 5 THEN REDIM PRESERVE inpAPI(lBufCnt + 16)
INCR lBufCnt
inpAPI(lBufCnt).dTYPE = %INPUT_KEYBOARD
inpAPI(lBufCnt).m.ki.wVk = bVkCode
inpAPI(lBufCnt).m.ki.time = Time
inpAPI(lBufCnt).m.ki.wScan = MAPVIRTUALKEY(bVkCode, 0)
'Intercept extended keys. They require the extended key flag.
SELECT CASE bVkCode
CASE %VK_UP, %VK_DOWN, %VK_LEFT, %VK_RIGHT, %VK_HOME, %VK_END, %VK_INSERT, %VK_DELETE, %VK_PGUP, %VK_PGDN
inpAPI(lBufCnt).m.ki.dwFlags = %KEYEVENTF_KEYUP OR %KEYEVENTF_EXTENDEDKEY
CASE ELSE
inpAPI(lBufCnt).m.ki.dwFlags = %KEYEVENTF_KEYUP
END SELECT
RETURN
AddNormalCharToBuffer:
IF (UBOUND(inpAPI()) - lBufCnt) < 5 THEN REDIM PRESERVE inpAPI(lBufCnt + 16)
iRet = VKKEYSCANEX(ASC(sChar), dKeybLayout)
bVkCode = LO(BYTE, iRet)
bShiftState = HI(BYTE, iRet)
IF (bVkCode = 255) AND (bShiftState = 255) THEN ' Unicode character
DIM c AS STRING
DIM u AS DWORD
c = StrToUnicode(sChar)
u = 256*ASC(c,2)+ASC(c,1)
INCR lBufCnt
inpAPI(lBufCnt).dTYPE = %INPUT_KEYBOARD
inpAPI(lBufCnt).m.ki.wVk = 0
inpAPI(lBufCnt).m.ki.dwFlags = %KEYEVENTF_UNICODE
inpAPI(lBufCnt).m.ki.time = Time
inpAPI(lBufCnt).m.ki.wScan = u
END IF
IF BIT(bShiftState, 0) THEN 'Shift
INCR lBufCnt
inpAPI(lBufCnt).dTYPE = %INPUT_KEYBOARD
inpAPI(lBufCnt).m.ki.wVk = %VK_SHIFT
inpAPI(lBufCnt).m.ki.dwFlags = 0
inpAPI(lBufCnt).m.ki.time = Time
inpAPI(lBufCnt).m.ki.wScan = MAPVIRTUALKEY(%VK_SHIFT, 0)
END IF
IF BIT(bShiftState, 1) THEN 'Ctrl
INCR lBufCnt
inpAPI(lBufCnt).dTYPE = %INPUT_KEYBOARD
inpAPI(lBufCnt).m.ki.wVk = %VK_CONTROL
inpAPI(lBufCnt).m.ki.dwFlags = 0
inpAPI(lBufCnt).m.ki.time = Time
inpAPI(lBufCnt).m.ki.wScan = MAPVIRTUALKEY(%VK_CONTROL, 0)
END IF
IF BIT(bShiftState, 2) THEN 'Alt
INCR lBufCnt
inpAPI(lBufCnt).dTYPE = %INPUT_KEYBOARD
inpAPI(lBufCnt).m.ki.wVk = %VK_MENU
inpAPI(lBufCnt).m.ki.dwFlags = 0
inpAPI(lBufCnt).m.ki.time = Time
inpAPI(lBufCnt).m.ki.wScan = MAPVIRTUALKEY(%VK_MENU, 0)
END IF
INCR lBufCnt
inpAPI(lBufCnt).dTYPE = %INPUT_KEYBOARD
inpAPI(lBufCnt).m.ki.wVk = bVkCode
inpAPI(lBufCnt).m.ki.dwFlags = 0
inpAPI(lBufCnt).m.ki.time = Time
inpAPI(lBufCnt).m.ki.wScan = MAPVIRTUALKEY(bVkCode, 0)
INCR lBufCnt
inpAPI(lBufCnt).dTYPE = %INPUT_KEYBOARD
inpAPI(lBufCnt).m.ki.wVk = bVkCode
inpAPI(lBufCnt).m.ki.dwFlags = %KEYEVENTF_KEYUP
inpAPI(lBufCnt).m.ki.time = Time
inpAPI(lBufCnt).m.ki.wScan = MAPVIRTUALKEY(bVkCode, 0)
IF BIT(bShiftState, 0) THEN 'Shift
INCR lBufCnt
inpAPI(lBufCnt).dTYPE = %INPUT_KEYBOARD
inpAPI(lBufCnt).m.ki.wVk = %VK_SHIFT
inpAPI(lBufCnt).m.ki.dwFlags = %KEYEVENTF_KEYUP
inpAPI(lBufCnt).m.ki.time = Time
inpAPI(lBufCnt).m.ki.wScan = MAPVIRTUALKEY(%VK_SHIFT, 0)
END IF
IF BIT(bShiftState, 1) THEN 'Ctrl
INCR lBufCnt
inpAPI(lBufCnt).dTYPE = %INPUT_KEYBOARD
inpAPI(lBufCnt).m.ki.wVk = %VK_CONTROL
inpAPI(lBufCnt).m.ki.dwFlags = %KEYEVENTF_KEYUP
inpAPI(lBufCnt).m.ki.time = Time
inpAPI(lBufCnt).m.ki.wScan = MAPVIRTUALKEY(%VK_CONTROL, 0)
END IF
IF BIT(bShiftState, 2) THEN 'Alt
INCR lBufCnt
inpAPI(lBufCnt).dTYPE = %INPUT_KEYBOARD
inpAPI(lBufCnt).m.ki.wVk = %VK_MENU
inpAPI(lBufCnt).m.ki.dwFlags = %KEYEVENTF_KEYUP
inpAPI(lBufCnt).m.ki.time = Time
inpAPI(lBufCnt).m.ki.wScan = MAPVIRTUALKEY(%VK_MENU, 0)
END IF
RETURN
END SUB
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------
'Sub borrowed from SendKeys.inc - by William Burns
'Wait until user lets go of the ctrl/Alt/Shift and any other keys
SUB WaitForNoKeys
LOCAL KeyWasPressed AS LONG
LOCAL iKey AS LONG
DO 'loop here until user lets go of the ctrl/Alt/Shift and any other keys
SLEEP 5 '<-- Modified in V1.1
KeyWasPressed = 0
'FOR iKey = 19 TO 255 '0-9 and a-z
FOR iKey = 0 TO 255 '<-- Modified in V1.1
IF (GETASYNCKEYSTATE(iKey) AND &H8000) THEN KeyWasPressed = 1
NEXT iKey
IF (GETASYNCKEYSTATE(%VK_CONTROL) AND &H8000) _
OR (GETASYNCKEYSTATE(%VK_SHIFT) AND &H8000) _
OR (GETASYNCKEYSTATE(%VK_MENU) AND &H8000) _
THEN KeyWasPressed = 1 'note: %VK_MENU = %VK_ALT
LOOP WHILE KeyWasPressed
END SUB
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------
FUNCTION StrToUnicode(BYVAL x AS STRING) AS STRING
DIM Buffer AS STRING
Buffer = SPACE$(LEN(x) * 2)
MultiByteToWideChar %CP_ACP, _ ' code page
%MB_PRECOMPOSED, _ ' performance and mapping flags
BYVAL STRPTR(x), _ ' ANSI string to convert
LEN(x), _ ' len of ANSI string
BYVAL STRPTR(Buffer), _ ' buffer for Unicode string
LEN(Buffer) ' len of Unicode buffer
FUNCTION = Buffer
END FUNCTION
'-------------------------------------------------------------------------