1 (изменено: Poltergeyst, 2019-04-08 15:49:16)

Тема: LangMF 8.0: отслеживание клавиатурных нажатий, хук WH_KEYBOARD

Без гарантий. Используете на свой страх и риск.

Пример постановки глобального клавиатурного хука WH_KEYBOARD. После запуска скрипта в окне формы отображается текущая нажатая клавиша из буквенно цифрового диапазона [A-Z А-Я 0-9 Space] в верхнем регистре с учетом языковой раскладки текущего окна. Чтобы закрыть форму дважды щелкните по ней любой кнопкой мыши.

Потребуется установленный LangMF 8.0
ОС Win Me/XP

Проект состоит из двух файлов расположенных в одном каталоге:

1) Скрипт Khook.mf - установщик хука который надо запустить.
2) Библиотека процедуры хука CALLBACK.DLL

Содержимое Khook.mf


'Пример постановки клавиатурного хука WH_KEYBOARD. После запуска скрипта в окне формы 
'отображается текущая нажатая клавиша из буквенно цифрового диапазона [A-Z А-Я 0-9 Space] 
'в верхнем регистре с учетом языковой раскладки текущего окна. Чтобы закрыть форму
'дважды щелкните по ней любой кнопкой мыши.

'Потребуется установленный LangMF 8.0
'ОС Win 98/XP

<#Module=KBRD_HOOK>

    Const WH_KEYBOARD    =2    
    
    Const WM_COMMNOTIFY    =&H0044 
    Const LY_RU        =&H419
    Const LY_EN        =&H409

    Public hHook
    Public hLib

Sub Load(cmdstr)

    '[Загрузка библиотеки хука]
    '----------------------------------------------------------------------------------    
    hLib    =Sys.API.LoadLibrary("CALLBACK.DLL")

    If hLib=0 Then 
        MsgBox "Требуется CALLBACK.DLL",vbSystemModal+vbExclamation,"Error"
        EndMF
    End If

    hCBack    =Sys.DynApi.CallFunction("KERNEL32.DLL","GetProcAddress",hLib,"HookCallBack")

    '[Установка параметров формы]
    '----------------------------------------------------------------------------------    
    With form
        .Caption        ="kbrdhook"
        .BackColor        =vbYellow
        .Style.ToolWindow    =True    
        .Style.TaskBar         =False
        '------------------------------------------------------------------------
        .Add "label",1,        "Left=5","Top=5","Width=80","Height=40", _
                    "Alignment=2","Caption= ","FontSize=20"
        '------------------------------------------------------------------------
        .AttachMsg        WM_COMMNOTIFY
        .Show
    End With
    DoEvents
    '----------------------------------------------------------------------------------
    Sys.API.SetWindowPosA         form.hWnd, _
                    -1, _
                    0, _
                    0, _
                    100, _
                    100, _
                    0


    '[Установка клавиатурного хука]
    '----------------------------------------------------------------------------------    
    hHook    =Sys.DynApi.CallFunction( _
                    "USER32.DLL", _
                    "SetWindowsHookExA", _
                    WH_KEYBOARD, _
                    hCBack, _
                    hLib, _
                    0)

    '----------------------------------------------------------------------------------
    DoEvents
End Sub

Function UnhookKbrd()

    '[Освобождение клавиатурного хука]
    '----------------------------------------------------------------------------------    
    Sys.DynApi.CallFunction _
                "USER32.DLL", _
                "UnhookWindowsHookEx", _
                hHook
    '----------------------------------------------------------------------------------
    Sys.DynApi.CallFunction _
                "KERNEL32.DLL", _
                "FreeLibrary", _
                hLib
    '---------------------------------------------------------------------------------- 
End Function

<#Module>

<#Form=form>

    Function ISubclass_MsgResponse()
          ISubclass_MsgResponse=1
    End Function

    Function ISubclass_WindowProc(hwnd,iMsg,wParam,lParam)
    
    '[Получение языковой раскладки текущего окна]
    '----------------------------------------------------------------------------------
    hHookWnd=Sys.DynApi.CallFunction( _
                    "USER32.DLL", _
                    "GetForegroundWindow")

    hThread    =Sys.DynApi.CallFunction( _
                    "USER32.DLL", _
                    "GetWindowThreadProcessId", _
                    hHookWnd, _
                    0)    
    
    hLY    =Sys.DynApi.CallFunction( _
                    "USER32.DLL", _
                    "GetKeyboardLayout", _
                    hThread)

    '[Отображение нажатой клавиши]
    '----------------------------------------------------------------------------------
    hLY=CLng("&H" & Sys.RightS(CStr(Hex(hLY)),4))
    '----------------------------------------------------------------------------------
        If hLY=LY_RU Then 
            data=Sys.Conv.LKey_RKey(Chr(wParam))
        Else
            data=Chr(wParam)
        End If    
        '--------------------------------------------------------------------------    
        if data =~ /([A-ZА-Я0-9\s]+)// then form.Label(1).Caption=data
        '--------------------------------------------------------------------------    
    ISubclass_WindowProc=True

    End Function

    Sub Form_DblClick()
        form.UnloadForm()
    End Sub

    Sub Form_Unload()
        Form.DetachMsg WM_COMMNOTIFY
        DoEvents

        UnhookKbrd()
        DoEvents

        EndMF
        DoEvents
    End Sub

'pltrgst
<#Form>

2) Вынос процедуры хука в библиотеку CALLBACK.DLL позволяет поставить глобальный хук для всех уже существующих и вновь запущенных оконных процессов.

Запуск n новых процессов порождает n хуков, каждый из которых принадлежит своему процессу. Процедура хука автоматически подключается в процесс текущего рабочего окна, и отслеживает клавиатурные нажатия. К сожалению хуки встроенные во вновь запущенные процессы удаляются только закрытием самих процессов. Библиотека CALLBACK.DLL собрана на макроассемблере HLA 1.103.

Код CALLBACK.DLL

unit DllCallBack;
//------------------------------------------------------------------------
// Обработка хука WH_KEYBOARD
//------------------------------------------------------------------------
#include( "w.hhf" );
//------------------------------------------------------------------------
procedure dll( instance:dword; reason:dword; reserved:dword ); 
        @stdcall; 
        @external( "_dll@12" );
//------------------------------------------------------------------------
procedure HookCallBack(nCode:int32; wParam:dword; lParam:dword); 
        @stdcall; 
        @external( "_HookCallBack@12" );
//------------------------------------------------------------------------
static
    ThisInstance: dword:= 0;
storage
    hHook: dword;
//------------------------------------------------------------------------ 
procedure dll( instance:dword; reason:dword; reserved:dword ); @nodisplay;

begin dll;
    mov( instance, eax );
    mov( eax, ThisInstance );
        if( reason = w.DLL_PROCESS_ATTACH ) then
        endif;
    mov( true, eax );
end dll;
//------------------------------------------------------------------------ 
procedure HookCallBack(nCode:int32; wParam:dword; lParam:dword);
var
    hwnd:    dword;

begin HookCallBack;
    if ( nCode < 0 ) then
        mov(0,eax);
    else
        w.FindWindow(NULL,"kbrdhook");
        mov(eax,hwnd);
        w.SendMessage(hwnd,w.WM_COMMNOTIFY,wParam,lParam);
    endif;
    w.CallNextHookEx( hHook,nCode,wParam,lParam );
end HookCallBack;
//------------------------------------------------------------------------
end DllCallBack;

Библиотека экспортирует единственную полезную функцию HookCallBack, которая обрабатывает нажатия клавиатуры и не видя внутренние глобальные переменные, отсылает входной параметр отвечающий за виртуальный код нажатой клавиши окну LangMF скрипта,который обрабатывает сообщение с помощью возможностей сабклассинга.

Существенный недостаток HLA - работа с 128 символьной кодировкой, что сокращает возможности скрипта по корректному определению ASCII кода нажатой клавиши. Тем не менее данный вариант вполне применим для дополнительной обработки нажатия произвольной клавиши даже при скрытой форме LangMF, в независимости от текущего активного окна.

Post's attachments

khook.zip 2.23 kb, 354 downloads since 2009-01-01 

You don't have the permssions to download the attachments of this post.

2

Re: LangMF 8.0: отслеживание клавиатурных нажатий, хук WH_KEYBOARD

А если вот так, то гораздо проще, и тоже не зависит от того, скрыто окно или нет.

Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

<#Module=mdlDemo>
'---------------------------------------
Sub Load(cmdLine)
  form.add "text",1, "move 30, 40, 280, 30", "text=", "fontsize=12", "fontbold=true", "locked=true"

  form.show

  sys.ontimer 100, "test"
End Sub

'----------------------------------------
Sub Test
    dim txt
    
    key_Alt = 0
    key_Ctrl = 0
    key_Shift = 0
    
    If GetAsyncKeyState(16) Then
       If GetAsyncKeyState(160) Then
          If GetAsyncKeyState(161) Then
             key_Shift = 3
             txt = txt + "Shift {A} + "
          Else
             key_Shift = 1
             txt = txt + "Shift {L} + "
          End If
       Else
          key_Shift = 2
          txt = txt + "Shift {R} + "
       End If
    End If
    
    If GetAsyncKeyState(17) Then
       If GetAsyncKeyState(162) Then
          If GetAsyncKeyState(163) Then
             key_Ctrl = 3
             txt = txt + "Ctrl {A} + "
          Else
             key_Ctrl = 1
             txt = txt + "Ctrl {L} + "
          End If
       Else
          key_Ctrl = 2
          txt = txt + "Ctrl {R} + "
       End If
    End If
    
    If GetAsyncKeyState(18) Then
       If GetAsyncKeyState(164) Then
          If GetAsyncKeyState(165) Then
             key_Alt = 3
             txt = txt + "Alt {A} + "
          Else
             key_Alt = 1
             txt = txt + "Alt {L} + "
          End If
       Else
          key_Alt = 2
          txt = txt + "Alt {R} + "
       End If
    End If
    
    For a = 2 To 255
        If GetAsyncKeyState(a) And a <> 4 Then
            If (a < 160 Or a > 165) And numKey = 0 And (a < 16 Or a > 18) Then
                txt = txt + CodeToSym(a) + " "
                Exit For
            End If
        End If
    Next
    
    form.Text(1).Text = txt
End sub

Public Function CodeToSym(numCode)
Select Case numCode
    Case 27
      CodeToSym = "Esc"
    
    Case 112
      CodeToSym = "F1"
    Case 113
      CodeToSym = "F2"
    Case 114
      CodeToSym = "F3"
    Case 115
      CodeToSym = "F4"
    Case 116
      CodeToSym = "F5"
    Case 117
      CodeToSym = "F6"
    Case 118
      CodeToSym = "F7"
    Case 119
      CodeToSym = "F8"
    Case 120
      CodeToSym = "F9"
    Case 121
      CodeToSym = "F10"
    Case 122
      CodeToSym = "F11"
    Case 123
      CodeToSym = "F12"
    
    Case 44
      CodeToSym = "Prt Scr"
    Case 145
      CodeToSym = "Scroll Lock"
    Case 19
      CodeToSym = "Pause"
      
    Case 192
      CodeToSym = "~"
    Case 49
      CodeToSym = "1"
    Case 50
      CodeToSym = "2"
    Case 51
      CodeToSym = "3"
    Case 52
      CodeToSym = "4"
    Case 53
      CodeToSym = "5"
    Case 54
      CodeToSym = "6"
    Case 55
      CodeToSym = "7"
    Case 56
      CodeToSym = "8"
    Case 57
      CodeToSym = "9"
    Case 48
      CodeToSym = "0"
      
    Case 189
      CodeToSym = "-"
    Case 187
      CodeToSym = "+"
    Case 8
      CodeToSym = "Backspace"
      
    Case 45
      CodeToSym = "Insert"
    Case 36
      CodeToSym = "Home"
    Case 33
      CodeToSym = "Page Up"
      
    Case 144
      CodeToSym = "Num Lock"
    Case 111
      CodeToSym = "Num /"
    Case 106
      CodeToSym = "Num *"
    Case 109
      CodeToSym = "Num -"
      
    Case 9
      CodeToSym = "Tab"
    Case 81
      CodeToSym = "Q"
    Case 87
      CodeToSym = "W"
    Case 69
      CodeToSym = "E"
    Case 82
      CodeToSym = "R"
    Case 84
      CodeToSym = "T"
    Case 89
      CodeToSym = "Y"
    Case 85
      CodeToSym = "U"
    Case 73
      CodeToSym = "I"
    Case 79
      CodeToSym = "O"
    Case 80
      CodeToSym = "P"
    Case 219
      CodeToSym = "["
    Case 221
      CodeToSym = "]"
    Case 220
      CodeToSym = "\"
      
    Case 46
      CodeToSym = "Delete"
    Case 35
      CodeToSym = "End"
    Case 34
      CodeToSym = "Page Down"
      
    Case 107
      CodeToSym = "Num +"
    Case 110
      CodeToSym = "Num ."
    Case 12
      CodeToSym = "Num 5+"
      
    Case 96
      CodeToSym = "Num 0"
    Case 97
      CodeToSym = "Num 1"
    Case 98
      CodeToSym = "Num 2"
    Case 99
      CodeToSym = "Num 3"
    Case 100
      CodeToSym = "Num 4"
    Case 101
      CodeToSym = "Num 5"
    Case 102
      CodeToSym = "Num 6"
    Case 103
      CodeToSym = "Num 7"
    Case 104
      CodeToSym = "Num 8"
    Case 105
      CodeToSym = "Num 9"
          
    Case 20
      CodeToSym = "Caps Lock"
    Case 65
      CodeToSym = "A"
    Case 83
      CodeToSym = "S"
    Case 68
      CodeToSym = "D"
    Case 70
      CodeToSym = "F"
    Case 71
      CodeToSym = "G"
    Case 72
      CodeToSym = "H"
    Case 74
      CodeToSym = "J"
    Case 75
      CodeToSym = "K"
    Case 76
      CodeToSym = "L"
    Case 186
      CodeToSym = ";"
    Case 222
      CodeToSym = "'"
    Case 13
      CodeToSym = "Enter"
    Case 166
      CodeToSym = "Back"
    Case 167
      CodeToSym = "Forward"
      
    Case 90
      CodeToSym = "Z"
    Case 88
      CodeToSym = "X"
    Case 67
      CodeToSym = "C"
    Case 86
      CodeToSym = "V"
    Case 66
      CodeToSym = "B"
    Case 78
      CodeToSym = "N"
    Case 77
      CodeToSym = "M"
    Case 188
      CodeToSym = ","
    Case 190
      CodeToSym = "."
    Case 191
      CodeToSym = "/"
      
    Case 91
      CodeToSym = "WinKey {L}"
    Case 32
      CodeToSym = "Space"
    Case 92
      CodeToSym = "Winkey {R}"
    Case 93
      CodeToSym = "WinkeyMenu"
      
    Case 38
      CodeToSym = "Up"
    Case 40
      CodeToSym = "Down"
    Case 37
      CodeToSym = "Left"
    Case 39
      CodeToSym = "Right"
      
    Case 169
      CodeToSym = "WWW Stop"
    Case 168
      CodeToSym = "WWW Refresh"
    Case 172
      CodeToSym = "WWW"
    Case 170
      CodeToSym = "Find"
    Case 171
      CodeToSym = "Folder"
    Case 180
      CodeToSym = "E-Mail"
      
    Case 173
      CodeToSym = "No Music"
    Case 174
      CodeToSym = "Music -"
    Case 175
      CodeToSym = "Music +"
    Case 255
      CodeToSym = "Power"
    Case 95
      CodeToSym = "Sleep"
      
    Case 178
      CodeToSym = "Stop"
    Case 177
      CodeToSym = "Previous"
    Case 176
      CodeToSym = "Next"
    Case 179
      CodeToSym = "Play"
      
    'Остальные значения
    Case Else
      CodeToSym = CStr(numCode)
End Select
End Function
<#Module>

<#Form=form>
'----------------------------------------
Sub Form_Unload()
  sys.offtimer "test"
  endmf
End Sub
<#Form>