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

 


免責聲明!

本站轉載的文章為個人學習借鑒使用,本站對版權不負任何法律責任。如果侵犯了您的隱私權益,請聯系本站郵箱yoyou2525@163.com刪除。



 
粵ICP備18138465號   © 2018-2025 CODEPRJ.COM