VB发送后台按键和组合键

 

http://files.cnblogs.com/files/liuzhaoyzz/VB%E5%8F%91%E9%80%81%E5%90%8E%E5%8F%B0%E7%BB%84%E5%90%88%E9%94%AE.rar

先上图，以记事本为例，新建若干个command.

直接上代码。试过了，发送单字符及功能键F3没问题。

发送CTRL+C,CTRL+X,CTRL+V不能后台，只能前台。

CTRL+v后台可以用SendMessage thwnd, WM_PASTE, 0, 0消息代替，但不一定有通用性，有些程序不接受。

后台发送Ctrl+N,Ctrl+O,Ctrl+S,Ctrl+P,Ctrl+Z,Ctrl+F,Ctrl+H均成功。

发送ALT+H，A成功，但只能前台发送，并且需要发送给主窗体。

Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Const VK_MENU = &H12
Private Const VK_CONTROL = &H11
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Private Const KEYEVENTF_KEYUP = &H2
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_CHAR = &H102
Private Const VK_A = &H41
Private Const WM_SYSKEYDOWN = &H104
Private Const WM_SYSKEYUP = &H105
Private Const EM_GETSEL = &HB0
Private Const EM_SETSEL = &HB1
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_COPY = &H301
Private Const WM_PASTE = &H302
Private Const WM_CUT = &H300
Private Const WM_COPYDATA = &H4A
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

Function MakeKeyLparam(ByVal VirtualKey As Long, ByVal flag As Long) As Long '修订后的完整版本
Dim sx As String
Dim Firstbyte As String 'lparam参数的24-31位
Select Case flag
Case WM_KEYDOWN: Firstbyte = "00"
Case WM_KEYUP: Firstbyte = "C0"
Case WM_CHAR: Firstbyte = "20"
Case WM_SYSKEYDOWN: Firstbyte = "20"
Case WM_SYSKEYUP: Firstbyte = "E0"
Case WM_SYSCHAR: Firstbyte = "E0"
End Select
Dim Scancode As Long
'获得键的扫描码
Scancode = MapVirtualKey(VirtualKey, 0)
Dim Secondbyte As String 'lparam参数的16-23位，即虚拟键扫描码
Secondbyte = Right("00" & Hex(Scancode), 2)
sx = Firstbyte & Secondbyte & "0001" '0001为lparam参数的0-15位，即发送次数和其它扩展信息
MakeKeyLparam = Val("&H" & sx)
End Function

'用法举例：
' sendKey thwnd, vbKeyA'发送A键，成功
Function sendKey(hwnd, vkey)
' Dim vkey
' vkey = Eval("&H" & Hex(key))
PostMessage hwnd, WM_KEYDOWN, vkey, MakeKeyLparam(vkey, WM_KEYDOWN)
Sleep 100
PostMessage hwnd, WM_KEYUP, vkey, MakeKeyLparam(vkey, WM_KEYUP)
End Function

'用法举例：
' SendCtrlPlusKey tHwnd, vbKeyN '发送Ctrl+N键成功
Function SendCtrlPlusKey(hwnd, vkey)
' Dim vkey
' vkey = Eval("&H" & Hex(key))
' KeyDown 17, 1
' PostMessage hwnd, WM_KEYDOWN, &H11, MakeKeyLparam(&H11, WM_KEYDOWN)'失败
keybd_event vbKeyControl, MapVirtualKey(vbKeyControl, 0), 0, 0 '前台按下Ctrl键
Sleep 100
PostMessage hwnd, WM_KEYDOWN, vkey, MakeKeyLparam(vkey, WM_KEYDOWN)
Sleep 200
PostMessage hwnd, WM_KEYUP, vkey, MakeKeyLparam(vkey, WM_KEYUP)
Sleep 100
keybd_event vbKeyControl, MapVirtualKey(vbKeyControl, 0), KEYEVENTF_KEYUP, 0 '前台释放Ctrl键
' KeyUp 17, 1
' PostMessage hwnd, WM_KEYUP, &H11, MakeKeyLparam(&H11, WM_KEYUP)'失败
End Function

'用法举例：
' 查找记事本编辑框句柄 dhwnd, thwnd
' SetForegroundWindow dhwnd
' Sleep 200
' SendAltPlusKey dhwnd, vbKeyH '发送ALT+H,A键成功
' Sleep 200
' sendKey dhwnd, vbKeyA
Function SendAltPlusKey(hwnd, vkey)
' Dim vkey
' vkey = Eval("&H" & Hex(key))
' PostMessage hwnd, WM_SYSKEYDOWN, &H12, MakeKeyLparam(&H12, WM_SYSKEYDOWN)
keybd_event vbKeyMenu, MapVirtualKey(vbKeyMenu, 0), 0, 0 '前台按下ALT键
Sleep 100
PostMessage hwnd, WM_SYSKEYDOWN, vkey, MakeKeyLparam(vkey, WM_SYSKEYDOWN)
Sleep 100
PostMessage hwnd, WM_SYSKEYUP, vkey, MakeKeyLparam(vkey, WM_SYSKEYUP)
Sleep 100
keybd_event vbKeyMenu, MapVirtualKey(vbKeyMenu, 0), KEYEVENTF_KEYUP, 0 '前台释放Ctrl键
' PostMessage hwnd, WM_KEYUP, &H12, MakeKeyLparam(&H12, WM_KEYUP)
End Function

'Function SendLclick(hwnd, x, y)
' PostMessage hwnd, WM_LBUTTONDOWN, 0, Eval("&H" & Hex(y * 65536 + x))
' PostMessage hwnd, WM_LBUTTONUP, 0, Eval("&H" & Hex(y * 65536 + x))
'End Function
'
'Function SendRclick(hwnd, x, y)
' PostMessage hwnd, WM_RBUTTONDOWN, 0, Eval("&H" & Hex(y * 65536 + x))
' PostMessage hwnd, WM_RBUTTONUP, 0, Eval("&H" & Hex(y * 65536 + x))
'End Function
'
'Public Function postKey(wHandle As Long, KeyCode As Long) '//发送按键
' PostMessage wHandle, WM_KEYDOWN, KeyCode, MakeKeyLparam(KeyCode, WM_KEYDOWN) '按下某键
' Sleep 100
' PostMessage wHandle, WM_KEYUP, KeyCode, MakeKeyLparam(KeyCode, WM_KEYUP) '释放某键
'End Function

Private Sub Command1_Click() '发送A键，成功
查找记事本编辑框句柄 dhwnd, thwnd
'发送A键，成功
sendKey thwnd, vbKeyA
End Sub

Private Sub Command2_Click() '发送Ctrl+A键成功
查找记事本编辑框句柄 dhwnd, thwnd
' '发送Ctrl+A键成功
' keybd_event vbKeyControl, MapVirtualKey(vbKeyControl, 0), 0, 0 '前台按下Ctrl键
' PostMessage tHwnd, WM_KEYDOWN, vbKeyA, MakeKeyLparam(vbKeyA, WM_KEYDOWN) '按下A键
' Sleep 100 '延时100毫秒，否则可能会失败！
' PostMessage tHwnd, WM_KEYUP, vbKeyA, MakeKeyLparam(vbKeyA, WM_UP) '释放A键
' keybd_event vbKeyControl, MapVirtualKey(vbKeyControl, 0), KEYEVENTF_KEYUP, 0 '前台释放Ctrl键

' SendCtrlPlusKey tHwnd, vbKeyN '发送Ctrl+N键成功
' SendCtrlPlusKey tHwnd, vbKeyO '发送Ctrl+O键成功
' SendCtrlPlusKey tHwnd, vbKeyS '发送Ctrl+S键成功
' SendCtrlPlusKey tHwnd, vbKeyP '发送Ctrl+P键成功
' SendCtrlPlusKey tHwnd, vbKeyZ '发送Ctrl+Z键成功
' SendCtrlPlusKey tHwnd, vbKeyF '发送Ctrl+F键成功
' SendCtrlPlusKey tHwnd, vbKeyH '发送Ctrl+H键成功
SendCtrlPlusKey thwnd, vbKeyA '发送Ctrl+A键成功

' SendCtrlPlusKey tHwnd, vbKeyC '发送Ctrl+C键失败,被windows屏蔽？
' SendCtrlPlusKey tHwnd, vbKeyV '发送Ctrl+v键失败,被windows屏蔽？
' SendCtrlPlusKey tHwnd, vbKeyX '发送Ctrl+x键失败,被windows屏蔽？

End Sub

Private Sub Command3_Click() '发送ALT+H,A键成功，必须为焦点窗口，且消息需要发向父窗口
查找记事本编辑框句柄 dhwnd, thwnd
SetForegroundWindow dhwnd
Sleep 200
SendAltPlusKey dhwnd, vbKeyH '发送ALT+H,A键成功
Sleep 200
sendKey dhwnd, vbKeyA

'用VB自带的sendkeys成功
' SendKeys "%HA"
' DoEvents

'ALT+H,继续A失败
' PostMessage(hWnd,WM_SYSKEYDOWN,VK_V,1<<29)'C语言
' PostMessage thwnd, WM_SYSKEYDOWN, vbKeyH, &H3E0001 Or &H20000000 '按下H
' ' Sleep 900
' PostMessage thwnd, WM_SYSKEYUP, vbKeyH, &HC03E0001 Or &H20000000 '按下H
' PostMessage tHwnd, WM_SYSKEYDOWN, vbKeyA, 2 ^ 29 '按下a
End Sub

Private Sub Command4_Click()
End
End Sub

Private Sub Command5_Click()
查找记事本编辑框句柄 dhwnd, thwnd
'发送A键，成功
sendKey thwnd, vbKeyReturn
End Sub

Private Sub Command6_Click()
查找记事本编辑框句柄 dhwnd, thwnd
'发送A键，成功
sendKey thwnd, vbKeyF3
End Sub

Private Sub Command8_Click() '发送CTRL+C到记事本
查找记事本编辑框句柄 dhwnd, thwnd
SetForegroundWindow dhwnd
SendCtrlPlusKey thwnd, vbKeyA
Sleep 500
SendCtrlPlusKey thwnd, vbKeyC '发送Ctrl+C键失败,被windows屏蔽？
' SendCtrlPlusKey tHwnd, vbKeyX '发送Ctrl+x键失败,被windows屏蔽？
' SendMessage tHwnd, WM_COPY, 0, 0
End Sub

Private Sub Command7_Click() '发送CTRL+V到记事本
查找记事本编辑框句柄 dhwnd, thwnd
' SetForegroundWindow dHwnd
SendMessage thwnd, WM_PASTE, 0, 0

' Dim lngStart As Long, lngEnd As Long
' ret = SendMessage(hwnd, EM_GETSEL, lngStart, lngEnd)
' If lngStart <> lngEnd Then
' ret = SendMessage(hwnd, WM_COPY, 0&, 0&)
' Debug.Print Clipboard.GetText
' End If
' SendCtrlPlusKey tHwnd, vbKeyV '发送Ctrl+v键失败,被windows屏蔽？
End Sub

Private Sub Command9_Click()
查找记事本编辑框句柄 dhwnd, thwnd
If thwnd = 0 Then Shell "notepad.exe", vbNormalNoFocus
End Sub

Sub 查找记事本编辑框句柄(dhwnd, thwnd)
' Dim dhwnd As Long
' Dim thwnd As Long
dhwnd = FindWindow("Notepad", vbNullString)
If dhwnd > 0 Then
thwnd = FindWindowEx(dhwnd, ByVal 0&, "Edit", vbNullString)
End If
End Sub