Как отловить нажатия клавиш (Русские буквы)

[Sayan]

Здравствуйте, как отследить нажатия клавиш на клавиатуре если форма не активна?
вот через API GetAsyncKeyState получилось отследить нажатые клавиши, но только ЛАТИНСКИЕ БУКВЫ((
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Как отследить какие русские буквы были введены из клавиатуры?

[alibek]

Там не бывает русских букв.
Там бывают клавиши (кнопки).
У кнопок есть коды, которые переводятся в «буквы» в соответствии с текущей раскладкой.

[Jack Ferre]

Лови сообщение WM_CHAR

UPD:

если форма не активна

проглядел

[Sayan]

Там не бывает русских букв.
Там бывают клавиши (кнопки).
У кнопок есть коды, которые переводятся в «буквы» в соответствии с текущей раскладкой.

так GetAsyncKeyState при русской раскладки все равно возвращает ASII кода английских букв((

[The trick]

Ставь WH_KEYBOARD_LL. При получении сообщения о нажатой клавише присоединяйся к вводу нужного потока AttachThreadInput, потом переводи с помощью например ToAsciiEx.

[Sayan]

как сделать через WH_KEYBOARD_LL? не умею- дайте пожалуйста листинг или проект

[Sam777e]

дайте пожалуйста листинг или проект

и в номера ...

Плохо понимаю зачем отслеживать

нажатия клавиш на клавиатуре если форма не активна

Как их потом использовать ?

Математик делает как надо то, что может.
Инженер делает как может то, что надо.

За неимением гербовой пишут и на простой.
Предлагаю простую бумагу - просто как идею ... [ ежели не можешь, как надо ].

1. Создаешь словарь вида [ показана произвольно некоторая часть ... ]

"q", "й"
"w", "ц"
"e", "у"
"r", "к"
"t", "е"
"y", "н"
"u", "г"
.
.
.
2. Отслеживаешь, как ты пишешь, "латинские буквы" [ например, по KeyUp ], и берешь из словаря 2-ого участника пары.

Можно создать несколько словарей и отслеживать Shift, Alt, ... или строить пары вида ("q", "йЙ")- в общем, есть где разгуляться самопальщику

[VBTerminator]

1. Создаешь словарь вида [ показана произвольно некоторая часть ... ]

Ага, и в результате привязываемся исключительно к паре раскладок «QWERTY» — «ЙЦУКЕН». А если у кого, к примеру, Dworak?

как сделать через WH_KEYBOARD_LL? не умею- дайте пожалуйста листинг или проект

Держи. Глобально отлавливает нажатия клавиш и выводит соответствующие символы с учётом раскладки и регистра вне зависимости от региональных настроек. Однако метод не универсален, так как символы, набираемые серией нажатий клавиш, не распознаются должным образом.

Добавлено: Данное решение не является полным. Полностью рабочей является третья версия.

Demo.zip

Демонстрация глобального перехватчика клавиатуры

(2.18 Кб) Скачиваний: 193

На всякий случай продублирую код здесь:

Subclasser.bas

Код: Выделить всё

Option Explicit

Const WM_KEYDOWN = &H100
Const WM_KEYUP = &H101

Type KBDLLHOOKSTRUCT
    vkCode As Long
    scanCode As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type

Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (ByVal hpvSource As Long, ByVal hpvSource As Long, ByVal cbCopy As Long)

Private Declare Function CallNextHookEx Lib "user32" (ByVal hhk As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetKeyboardState Lib "user32" (lpKeyState As Byte) As Long
Private Declare Function ToAscii Lib "user32" (ByVal uVirtKey As Long, ByVal uScanCode As Long, lpKeyState As Byte, lpChar As Integer, ByVal uFlags As Long) As Long

Public hHook As Long

Public Function KeyCallback(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If idHook >= 0 Then
        Dim info As KBDLLHOOKSTRUCT
        RtlMoveMemory VarPtr(info), lParam, 20
   
        Dim btKeyState(256) As Byte
        GetKeyboardState btKeyState(0)

        Dim keyId As Integer
        ToAscii info.vkCode, info.scanCode, btKeyState(0), keyId, 0
       
        MainForm.PressedLetter.Caption = Chr(keyId)
       
        Select Case wParam
            Case WM_KEYDOWN
                MainForm.PressedState.Caption = "Нажата"
               
            Case WM_KEYUP
                MainForm.PressedState.Caption = "Отпущена"
        End Select
    End If
   
    KeyCallback = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
End Function

MainForm.frm

Код: Выделить всё

VERSION 5.00
Begin VB.Form MainForm
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Демонстрация WH_KEYBOARD_LL"
   ClientHeight    =   1335
   ClientLeft      =   45
   ClientTop       =   375
   ClientWidth     =   5310
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1335
   ScaleWidth      =   5310
   StartUpPosition =   1  'CenterOwner
   Begin VB.Label PressedState
      Alignment       =   1  'Right Justify
      Height          =   255
      Left            =   1320
      TabIndex        =   2
      Top             =   840
      Width           =   975
   End
   Begin VB.Label PressedLetter
      Height          =   255
      Left            =   2400
      TabIndex        =   1
      Top             =   840
      Width           =   855
   End
   Begin VB.Label Label1
      Caption         =   "При нажатии и отпускании клавиши ниже будет выведена соответствующая ей буква в текущей раскладке:"
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   5055
   End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const WH_KEYBOARD_LL = 13

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long

Private Sub Form_Load()
    hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf KeyCallback, App.hInstance, 0)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnhookWindowsHookEx hHook
End Sub

PS: Да, я вижу, что прошёл уже месяц. Но, так как толкового ответа не прозвучало, думаю, не стоит сбивать с толку людей, пришедших сюда из поиска.

[Qwertiy]

Хм.. Работает. Но вроде где-то говорилось, что хуки обязаны размещаться в dll и не могут быть в exe?

[The trick]

Хм.. Работает. Но вроде где-то говорилось, что хуки обязаны размещаться в dll и не могут быть в exe?

LL - хуки работают и в EXE.
Для получения конкретного символа в раскладке того приложения в котором он был введен нужно подключаться к потоку ввода и получать оттуда раскладку, после этого транслирвать клавишу в символ с помощью ToAsciiEx.

[VBTerminator]

нужно подключаться к потоку ввода и получать оттуда раскладку

Да, моя первая версия не учитывала раскладку активного окна. Попробовал подключиться с помощью AttachThreadInput(). Вот только он так сильно привязывается, что во всех окнах кроме нашего пропала возможность менять язык ввода. В чём у меня ошибка?

Demo 2.zip

Демонстрация глобального перехватчика клавиатуры, версия 2

(2.29 Кб) Скачиваний: 155

Исправленный Subclasser.bas

Код: Выделить всё

Option Explicit

Const WM_KEYDOWN = &H100
Const WM_KEYUP = &H101

Type KBDLLHOOKSTRUCT
    vkCode As Long
    scanCode As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type

Private Declare Sub RtlMoveMemory Lib "kernel32.dll" _
    (ByVal hpvSource As Long, ByVal hpvSource As Long, ByVal cbCopy As Long)

Private Declare Function CallNextHookEx Lib "user32" (ByVal hhk As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, ByVal lpdwProcessId As Long) As Long
Private Declare Function AttachThreadInput Lib "user32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetKeyboardState Lib "user32" (lpKeyState As Byte) As Long
Private Declare Function GetKeyboardLayout Lib "user32" (ByVal idThread As Long) As Long
Private Declare Function ToAscii Lib "user32" (ByVal uVirtKey As Long, ByVal uScanCode As Long, lpKeyState As Byte, lpChar As Integer, ByVal uFlags As Long) As Long

Public hHook As Long

Public Function KeyCallback(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If idHook >= 0 Then
        AttachThreadInput GetWindowThreadProcessId(GetForegroundWindow(), 0), App.ThreadID, 1
   
        Dim info As KBDLLHOOKSTRUCT
        RtlMoveMemory VarPtr(info), lParam, 20
   
        Dim btKeyState(256) As Byte
        GetKeyboardState btKeyState(0)

        Dim keyId As Integer
        ToAscii info.vkCode, info.scanCode, btKeyState(0), keyId, 0
       
        AttachThreadInput GetWindowThreadProcessId(GetForegroundWindow(), 0), App.ThreadID, 0
       
       
        MainForm.PressedLetter.Caption = Chr(keyId)
       
        Select Case wParam
            Case WM_KEYDOWN
                MainForm.PressedState.Caption = "Нажата"
               
            Case WM_KEYUP
                MainForm.PressedState.Caption = "Отпущена"
        End Select
    End If
   
    KeyCallback = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
End Function

[The trick]

Нужно отсеивать от VK_LSHIFT до VK_RMENU, для перевода нужно использовать ToAsciiEx.

[VBTerminator]

Спасибо, Анатолий! Теперь всё работает как положено.

Demo 3.zip

Демонстрация глобального перехватчика клавиатуры, версия 3

(2.39 Кб) Скачиваний: 165

Subclasser.bas

Код: Выделить всё

Option Explicit

Const VK_LSHIFT = &HA0
Const VK_RMENU = &HA5

Type KBDLLHOOKSTRUCT
    vkCode As Long
    scanCode As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type

Private Declare Sub RtlMoveMemory Lib "kernel32.dll" _
    (ByVal hpvSource As Long, ByVal hpvSource As Long, ByVal cbCopy As Long)

Private Declare Function CallNextHookEx Lib "user32" (ByVal hhk As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, ByVal lpdwProcessId As Long) As Long
Private Declare Function AttachThreadInput Lib "user32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetKeyboardState Lib "user32" (lpKeyState As Byte) As Long
Private Declare Function GetKeyboardLayout Lib "user32" (ByVal idThread As Long) As Long
Private Declare Function ToAsciiEx Lib "user32" (ByVal uVirtKey As Long, ByVal uScanCode As Long, lpKeyState As Byte, lpChar As Integer, ByVal uFlags As Long, ByVal dwhkl As Long) As Long

Public hHook As Long

Public Function KeyCallback(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If idHook >= 0 Then
        Dim info As KBDLLHOOKSTRUCT
        RtlMoveMemory VarPtr(info), lParam, 20
   
        If info.vkCode < VK_LSHIFT Or info.vkCode > VK_RMENU Then
            Dim ActiveWindowThread As Long
            ActiveWindowThread = GetWindowThreadProcessId(GetForegroundWindow(), 0)
           
            AttachThreadInput ActiveWindowThread, App.ThreadID, 1
           
            Dim btKeyState(256) As Byte
            GetKeyboardState btKeyState(0)
   
            Dim keyId As Integer
            ToAsciiEx info.vkCode, info.scanCode, btKeyState(0), keyId, 0, GetKeyboardLayout(ActiveWindowThread)
           
            AttachThreadInput ActiveWindowThread, App.ThreadID, 0
           
            ' --------------------
           
            MainForm.UpdateKeyInfo Chr(keyId), wParam
        End If
    End If
   
    KeyCallback = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
End Function

MainForm.frm

Код: Выделить всё

VERSION 5.00
Begin VB.Form MainForm
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Äåìîíñòðàöèÿ WH_KEYBOARD_LL"
   ClientHeight    =   1335
   ClientLeft      =   45
   ClientTop       =   375
   ClientWidth     =   5310
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1335
   ScaleWidth      =   5310
   StartUpPosition =   1  'CenterOwner
   Begin VB.Label PressedState
      Alignment       =   1  'Right Justify
      Height          =   255
      Left            =   1320
      TabIndex        =   2
      Top             =   840
      Width           =   975
   End
   Begin VB.Label PressedLetter
      Height          =   255
      Left            =   2400
      TabIndex        =   1
      Top             =   840
      Width           =   855
   End
   Begin VB.Label Label1
      Caption         =   "Ïðè íàæàòèè è îòïóñêàíèè êëàâèøè íèæå áóäåò âûâåäåíà ñîîòâåòñòâóþùàÿ åé áóêâà â òåêóùåé ðàñêëàäêå:"
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   5055
   End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const WH_KEYBOARD_LL = 13

Const WM_KEYDOWN = &H100
Const WM_KEYUP = &H101

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private Sub Form_Load()
    hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf KeyCallback, App.hInstance, 0)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnhookWindowsHookEx hHook
End Sub

Public Sub UpdateKeyInfo(ByVal Letter As String, ByVal Modifiers As Long)
    PressedLetter.Caption = Letter
           
    Select Case Modifiers
        Case WM_KEYDOWN
            PressedState.Caption = "Íàæàòà"
                   
        Case WM_KEYUP
            MainForm.PressedState.Caption = "Îòïóùåíà"
    End Select
End Sub