Использование функции SendInput для имитации нажания клавиши
Автор Ким Владимир
27.09.2005 г.
...Как то мучился с предупреждающим окошком OutLook, назойливо предлагающего подтвердить внешнее обращение к почте. Понятно, что бороться с этим можно только через API Здесь помогла функция SendInput(API), которая засовывает команды в буфер потока клавиатуры (мыша)...
Как то мучился с предупреждающим окошком OutLook, назойливо предлагающего подтвердить внешнее обращение к почте. Понятно, что бороться с этим можно только через API Здесь помогла функция SendInput(API), которая засовывает команды в буфер потока клавиатуры (мыша). Найдено в дебрях интернета и немного преобразовано для практического использования. ВНИМАНИЕ! Действует для активного окна. '************************************************** 'Код ВБА
Type INPUT_TYPE dwType As Long xi(0 To 23) As Byte End Type
Type KEYBDINPUT wVk As Integer wScan As Integer dwFlags As Long time As Long dwExtraInfo As Long End Type
Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As INPUT_TYPE, ByVal cbSize As Long) As Long
Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Sub SendKeyBySendInput(VirtualKey As Byte, Optional VK_DOWN As Boolean = True, Optional VK_UP As Boolean = True)
' буфер о событиях клавы Dim inputevents(0 To 1) As INPUT_TYPE Dim keyevent As KEYBDINPUT
Dim i As Long ‘счетчик обработанных событий i = 0 If VK_DOWN Then ' инфа о нажатии клавиши keyevent.wVk = VirtualKey keyevent.wScan = 0 keyevent.dwFlags = 0 keyevent.time = 0 keyevent.dwExtraInfo = 0 ' структура копируется в буфер inputevents(i).dwType = INPUT_KEYBOARD CopyMemory inputevents(i).xi(0), keyevent, Len(keyevent) i = i + 1 End If
If VK_UP Then ' то же для события отпускания клавиши keyevent.wVk = VirtualKey keyevent.wScan = 0 keyevent.dwFlags = KEYEVENTF_KEYUP keyevent.time = 0 keyevent.dwExtraInfo = 0 inputevents(i).dwType = INPUT_KEYBOARD CopyMemory inputevents(i).xi(0), keyevent, Len(keyevent) i = i + 1 End If
If i <> 0 Then Call SendInput(i, inputevents(0), Len(inputevents(0))) ' размещает нужные события в поток End If
End Sub
'********************************************************** 'пример использования 'имитирование нажатия (нажать+отпустить) клавиши f1 Sub testSendKeyBySendInput() SendKeyBySendInput VK_F1,True,True End Sub