论坛广场 › 源码分享 › 【分享】马大哈系列功能模块----模拟按键(使用SendInput)(2011-07-16更新)

马大哈 发表于 2010-4-29 23:11:12

【分享】马大哈系列功能模块----模拟按键(使用SendInput)(2011-07-16更新)

以下代码保存为ModSSendKeys.bas:Option Explicit
'*************************************************************************
'**模 块 名：ModSSendKeys
'**说    明：模拟按键(直接发按键消息到输入队列,多数情况下与直接按键盘效果相等)
'**创 建 人：嗷嗷叫的老马
'**日    期：2006年5月10日
'**描    述：网上收集,更改了部分代码.
'**备    注: 紫水晶工作室 版权所有
'**          更多模块/类模块请访问我站: http://www.m5home.com
'**版    本：V2.0
'**日    期：2011年7月16日
'**描    述：更新了ASCII到虚拟键码的转换.
'*************************************************************************

Private Const KEYEVENTF_KEYUP = &H2
Private Const INPUT_MOUSE = 0
Private Const INPUT_KEYBOARD = 1
Private Const INPUT_HARDWARE = 2

Private Type MOUSEINPUT
    dx As Long
    dy As Long
    mouseData As Long
    dwFlags As Long
    time As Long
    dwExtraInfo As Long
End Type
Private Type KEYBDINPUT
    wVk As Integer
    wScan As Integer
    dwFlags As Long
    time As Long
    dwExtraInfo As Long
End Type
Private Type HARDWAREINPUT
    uMsg As Long
    wParamL As Integer
    wParamH As Integer
End Type
Private Type GENERALINPUT
    dwType As Long
    xi(0 To 23) As Byte
End Type
Private Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As GENERALINPUT, ByVal cbSize As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Sub Sleep Lib "kernel32.dll" ( _
      ByVal dwMilliseconds As Long)
Private Declare Function VkKeyScan Lib "user32.dll" Alias "VkKeyScanA" ( _
      ByVal cChar As Byte) As Integer

Public Sub SendKey(ByVal bKey As KeyCodeConstants, ByVal PressORRelease As Long)
    Dim GInput(0 To 1) As GENERALINPUT
    Dim KInput As KEYBDINPUT
    Dim I As Long, iH As Integer, iL As Integer
   
    I = VkKeyScan(bKey)
    Call CopyMemory(iL, I, 2)
    Call CopyMemory(iH, I + 2, 2)
   
    Debug.Print Hex(iL), Hex(iH)
   
    If PressORRelease = 0 Then
      I = 0
    Else
      I = 1
    End If
   
    KInput.wVk = iL 'the key we're going to press
    KInput.dwFlags = 0 'press the key
    'copy the structure into the input array's buffer.
    GInput(0).dwType = INPUT_KEYBOARD ' keyboard input
    CopyMemory GInput(0).xi(0), KInput, Len(KInput)
    'do the same as above, but for releasing the key
    KInput.wVk = bKey ' the key we're going to realease
    KInput.dwFlags = KEYEVENTF_KEYUP ' release the key
    GInput(1).dwType = INPUT_KEYBOARD ' keyboard input
    CopyMemory GInput(1).xi(0), KInput, Len(KInput)
    'send the input now
    Call SendInput(1, GInput(I), Len(GInput(I)))
    DoEvents
End Sub

Public Sub SendStr(ByVal theStr As String)
    '发送字符串
    Dim I As Long
   
    For I = 1 To Len(theStr)
      Call SendKey(Asc(Mid(theStr, I, 1)), 0)
      Sleep 100
      Call SendKey(Asc(Mid(theStr, I, 1)), 1)
    Next
End Sub使用:
Call SendStr("www.m5hoome.com")
已更新...

马大哈 发表于 2010-4-29 23:11:54

我晕,缩进全都没了.

有待改进.

Tesla.Angela 发表于 2010-5-1 15:06:42

这个要支持一下！

sgp_003 发表于 2010-5-20 18:12:26

不会用啊，能提示下怎么用吗

马大哈 发表于 2010-5-21 11:03:36

回复 4# sgp_003


    注意看完整个帖子:)

乔丹二世 发表于 2010-7-4 17:42:36

回复 5# 马大哈


    测试失败啊！

马大哈 发表于 2010-7-6 02:58:25

回复 6# 乔丹二世


    如果失败,则有可能是目标进程或安全软件防止了的.

你先在记事本中测试吧,我现在打星际时都用这个输入作弊码呢.....show me the money x 10....

zmh886 发表于 2010-10-18 03:21:25

马大哈 发表于 2010-10-18 10:01:08

回复 8# zmh886 Private Sub Form_Load()
    '完全不知道要发到哪里去。
    Call SendStr("www.m5hoome.com")
End Sub你写在这里。。。。。窗体启动时有可以输入的地方么。。。。

用个定时器吧，然后切换焦点到一个可以输入的地方，比如记事本。。。。。

这个函数与SendKeys是一样的使用条件，汗，你还是看看SendKeys的说明吧。

zmh886 发表于 2010-10-19 11:39:03

哦 知道了 不是后台的啊。 用惯别人的DZ用你这个真不习惯 什么都是在一个窗口打开

马大哈 发表于 2010-10-19 18:34:34

别人的DZ是啥样的.

我现在也很不习惯这个.....

zmh886 发表于 2010-11-24 21:03:40

回复 马大哈 的帖子

现在和别人的一样了 :)

马大哈 发表于 2010-11-25 10:26:29

回复 zmh886 的帖子

:)

falcon4585 发表于 2011-11-3 13:58:27

本帖最后由 falcon4585 于 2011-11-3 19:06 编辑

只能发送字符，都说sendinput能发送中文，可我没弄出来。

upring 发表于 2015-5-22 11:59:40

马老的代码值得期待

查看完整版本: 【分享】马大哈系列功能模块----模拟按键(使用SendInput)(2011-07-16更新)