VB调用sendinput API

http://files.cnblogs.com/files/liuzhaoyzz/VB%E8%B0%83%E7%94%A8sendinput_API.rar

sendinput只支持发送字符或者组合键给前台程序，相当于keybd_event和vb的sendkeys。

好像他比keybd_event稍强，能够支持CTRL+C，ctrl+X，ctrl+V。

http://bbs.csdn.net/topics/90509805
hd378发表于： 2006-12-24 14:35:39

在网络上大神的指引下，我完善了两个函数， SendKeyCTRLplus和SendKeyALTplus。调用方法举例：

MySendKey vbKeyA

SendKeyCTRLplus vbKeyA

SendKeyALTplus vbKeyH, vbKeyA

'尝试用SendInput按住ALT，Postmessage发送H键到记事本失败：前台也不行，但是直接用SendInput成功：

'keybd_event在前台按住ALT，Postmessage发送H键到记事本成功，但是继续按A失败，他们是一对儿。

还能够直接发送中文字符到另一个进程，例如记事本。

'form1的代码：------------------------------------

Private Sub Command1_Click() '发送A到记事本
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
SetForegroundWindow dHwnd
MySendKey vbKeyA
'等价于以下语句：
' MySendKeyStep vbKeyA, 0 '按下
' Sleep 100
' MySendKeyStep vbKeyA, 1 '弹起
End Sub

Private Sub Command2_Click() '发送CTRL+A到记事本
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
SetForegroundWindow dHwnd
SendKeyCTRLplus vbKeyA
End Sub

Private Sub Command3_Click() '发送ALT+H,A到记事本
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
SetForegroundWindow dHwnd
SendKeyALTplus vbKeyH, vbKeyA '发送ALT+H,A到记事本成功

'尝试用SendInput按住ALT，Postmessage发送H键到记事本失败：前台也不行，但是直接用SendInput成功：
' MySendKeyStep vbKeyMenu, 0 '按下
' Sleep 100
' ' PostMessage dHwnd, WM_KEYDOWN, vbKeyH, MakeKeyLparam(vbKeyH, WM_KEYDOWN)'失败
' ' Sleep 200
' ' PostMessage dHwnd, WM_KEYUP, vbKeyH, MakeKeyLparam(vbKeyH, WM_KEYUP)'失败
' MySendKeyStep vbKeyH, 0 '按下
' Sleep 100
' MySendKeyStep vbKeyH, 1 '弹起
' Sleep 100
' MySendKeyStep vbKeyMenu, 1 '弹起
' Sleep 100
' MySendKeyStep vbKeyA, 0 '按下
' Sleep 100
' MySendKeyStep vbKeyA, 1 '弹起
End Sub

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

Private Sub Command4_Click() '发送F3到记事本
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
SetForegroundWindow dHwnd
MySendKey vbKeyF3
'等价于以下语句：
' MySendKeyStep vbKeyF3, 0 '按下
' Sleep 100
' MySendKeyStep vbKeyF3, 1 '弹起
End Sub

Private Sub Command5_Click() '发送CTRL+C到记事本
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
SetForegroundWindow dHwnd
SendKeyCTRLplus vbKeyC
End Sub

Private Sub Command6_Click() '发送CTRL+V到记事本
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
SetForegroundWindow dHwnd
SendKeyCTRLplus vbKeyV
End Sub

'模块1：------------------------------------------------------------------------------------------

Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As GENERALINPUT, ByVal cbSize As Long) As Long
'Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Type GENERALINPUT
dwType As Long
xi(0 To 23) As Byte
End Type

Type KEYBDINPUT
wVk As Integer
wScan As Integer
dwFlags As Long
time As Long
dwExtraInfo As Long
End Type

Const INPUT_KEYBOARD = 1
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public 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
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Const KEYEVENTF_KEYUP = &H2
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'调用方法举例：
'MySendKey vbKeyA '向前台窗口发送字符A
Sub MySendKey(bkey As Long)
'参数bkey传入要模拟按键的虚拟码即可模拟按下指定键
Dim GInput(0 To 1) As GENERALINPUT
Dim KInput As KEYBDINPUT
KInput.wVk = bkey '你要模拟的按键
KInput.dwFlags = 0 '按下键标志
GInput(0).dwType = INPUT_KEYBOARD
CopyMemory GInput(0).xi(0), KInput, Len(KInput) '这个函数用来把内存中KInput的数据复制到GInput
KInput.wVk = bkey
KInput.dwFlags = KEYEVENTF_KEYUP ' 释放按键
GInput(1).dwType = INPUT_KEYBOARD ' 表示该消息为键盘消息
CopyMemory GInput(1).xi(0), KInput, Len(KInput)
'以上工作把按下键和释放键共2条键盘消息加入到GInput数据结构中
SendInput 2, GInput(0), Len(GInput(0)) '把上面的按键消息插入到windows消息队列
End Sub

'把一个按键消息分成两步，第一步按下，第二步弹起，调用方法举例1：
' MySendKeyStep vbKeyControl, 0'按下
' Sleep 100
' MySendKeyStep vbKeyA, 0'按下
' Sleep 100
' MySendKeyStep vbKeyA, 1'弹起
' Sleep 100
' MySendKeyStep vbKeyControl, 1'弹起
'举例2：
' MySendKeyStep vbKeyF3, 0 '按下
' Sleep 100
' MySendKeyStep vbKeyF3, 1 '弹起
Sub MySendKeyStep(bkey As Long, press)
'参数bkey传入要模拟按键的虚拟码即可模拟按下指定键
Dim GInput(0 To 1) As GENERALINPUT
Dim KInput As KEYBDINPUT
If press = 0 Then '如果按键按下
KInput.wVk = bkey '你要模拟的按键
KInput.dwFlags = 0 '按下键标志
GInput(0).dwType = INPUT_KEYBOARD
CopyMemory GInput(0).xi(0), KInput, Len(KInput) '这个函数用来把内存中KInput的数据复制到GInput
Call SendInput(1, GInput(0), Len(GInput(0))) '把上面的按键消息插入到windows消息队列
Else '如果按键弹起
KInput.wVk = bkey
KInput.dwFlags = KEYEVENTF_KEYUP ' 释放按键
GInput(0).dwType = INPUT_KEYBOARD ' 表示该消息为键盘消息
CopyMemory GInput(0).xi(0), KInput, Len(KInput)
Call SendInput(1, GInput(0), Len(GInput(0))) '把上面的按键消息插入到windows消息队列
End If
End Sub

'调用方法举例：
'SendKeyCTRLplus vbKeyA 'ctrl+a
Sub SendKeyCTRLplus(bkey As Long)
'参数bkey传入要模拟按键的虚拟码即可模拟按下指定键
Dim GInput(0 To 8) As GENERALINPUT
Dim KInput As KEYBDINPUT
'按下ctrl
KInput.wVk = vbKeyControl '你要模拟的按键
KInput.dwFlags = 0 '按下键标志
GInput(0).dwType = INPUT_KEYBOARD
CopyMemory GInput(0).xi(0), KInput, Len(KInput) '这个函数用来把内存中KInput的数据复制到GInput
Call SendInput(1, GInput(0), Len(GInput(0))) '把上面的按键消息插入到windows消息队列
Sleep 100

'按下bkey
KInput.wVk = bkey '你要模拟的按键
KInput.dwFlags = 0 '按下键标志
GInput(1).dwType = INPUT_KEYBOARD
CopyMemory GInput(1).xi(0), KInput, Len(KInput) '这个函数用来把内存中KInput的数据复制到GInput
Call SendInput(1, GInput(1), Len(GInput(1))) '把上面的按键消息插入到windows消息队列
Sleep 100

'弹起bkey
KInput.wVk = bkey
KInput.dwFlags = KEYEVENTF_KEYUP ' 释放按键
GInput(2).dwType = INPUT_KEYBOARD ' 表示该消息为键盘消息
CopyMemory GInput(2).xi(0), KInput, Len(KInput) '这个函数用来把内存中KInput的数据复制到GInput
Call SendInput(1, GInput(2), Len(GInput(2))) '把上面的按键消息插入到windows消息队列
Sleep 100

'弹起ctrl
KInput.wVk = vbKeyControl
KInput.dwFlags = KEYEVENTF_KEYUP ' 释放按键
GInput(3).dwType = INPUT_KEYBOARD ' 表示该消息为键盘消息
CopyMemory GInput(3).xi(0), KInput, Len(KInput) '这个函数用来把内存中KInput的数据复制到GInput
Call SendInput(1, GInput(3), Len(GInput(3))) '把上面的按键消息插入到windows消息队列
End Sub

'调用方法举例：
'SendKeyALTplus vbKeyH, vbKeyA 'ALT+H,A
Sub SendKeyALTplus(bkey As Long, bkey2 As Long)
'参数bkey传入要模拟按键的虚拟码即可模拟按下指定键
Dim GInput(0 To 8) As GENERALINPUT
Dim KInput As KEYBDINPUT
'按下alt
KInput.wVk = vbKeyMenu '你要模拟的按键
KInput.dwFlags = 0 '按下键标志
GInput(0).dwType = INPUT_KEYBOARD
CopyMemory GInput(0).xi(0), KInput, Len(KInput) '这个函数用来把内存中KInput的数据复制到GInput
Call SendInput(1, GInput(0), Len(GInput(0))) '把上面的按键消息插入到windows消息队列
Sleep 100

'弹起alt
KInput.wVk = vbKeyMenu
KInput.dwFlags = KEYEVENTF_KEYUP ' 释放按键
GInput(3).dwType = INPUT_KEYBOARD ' 表示该消息为键盘消息
CopyMemory GInput(3).xi(0), KInput, Len(KInput) '这个函数用来把内存中KInput的数据复制到GInput
Call SendInput(1, GInput(3), Len(GInput(3))) '把上面的按键消息插入到windows消息队列
Sleep 100

'按下bkey2
KInput.wVk = bkey2 '你要模拟的按键
KInput.dwFlags = 0 '按下键标志
GInput(4).dwType = INPUT_KEYBOARD
CopyMemory GInput(4).xi(0), KInput, Len(KInput) '这个函数用来把内存中KInput的数据复制到GInput
Call SendInput(1, GInput(4), Len(GInput(4))) '把上面的按键消息插入到windows消息队列
Sleep 100

'弹起bkey2
KInput.wVk = bkey2
KInput.dwFlags = KEYEVENTF_KEYUP ' 释放按键
GInput(5).dwType = INPUT_KEYBOARD ' 表示该消息为键盘消息
CopyMemory GInput(5).xi(0), KInput, Len(KInput) '这个函数用来把内存中KInput的数据复制到GInput
Call SendInput(1, GInput(5), Len(GInput(5))) '把上面的按键消息插入到windows消息队列
End Sub

巴特西

VB调用sendinput API

最新文章

热门文章