zoukankan      html  css  js  c++  java
  • 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

  • 相关阅读:
    2017.0710.《计算机组成原理》-信息的校验
    2017.0707.《计算机组成原理》-汉明码
    2017.0706.《计算机组成原理》-存储器的校验
    基于mpvue的小程序项目搭建的步骤一
    微信小程序图片使用示例
    如何给小程序页面加载一张背景图片
    【组件】微信小程序input搜索框的实现
    基于cropper.js的图片上传和裁剪
    经典小程序源码及其下载地址
    【前端切图】用css画一个卡通形象-小猪佩奇
  • 原文地址:https://www.cnblogs.com/liuzhaoyzz/p/6198153.html
Copyright © 2011-2022 走看看