驱动级键盘模拟的问题

[futosky]

从网上找的帖子，好像是老马写的，说了3种键盘模拟的方法，用keybd-event模拟A按下能够控制CS1.6的人向左移动，但是确是一直移动，好像键盘弹起事件不管用。用的第三种方法，即winio驱动级模拟，但是测试时对一些输入框都行，就是对CS不管用。这是哪里出了问题呢？CS是测试用的，就这一个游戏

[futosky]

我已经模拟弹起了，但是人还是一直移动

[贝隆]

代码是什么样的？？靠猜我是猜不出原因的：）

[futosky]

你可以搜一下老马 驱动级键盘模拟

[futosky]

你可以搜一下老马 驱动级键盘模拟

[贝隆]

好的，谢谢

[futosky]

有没有人能给解释一下呢？

[嗷嗷叫的老马]

回头我测试一下再说......

这几天刚回来,事情堆积如山啊........

[futosky]

谢谢哈

[yangbo_cuit]

mark

[futosky]

这个，失误失误！但是用直接操作键盘为何不能控制cs呢

[嗷嗷叫的老马]

[Quote=引用楼主 jbwd1 的回复:]
从网上找的帖子，好像是老马写的，说了3种键盘模拟的方法，用keybd-event模拟A按下能够控制CS1.6的人向左移动，但是确是一直移动，好像键盘弹起事件不管用。用的第三种方法，即winio驱动级模拟，但是测试时对一些输入框都行，就是对CS不管用。这是哪里出了问题呢？CS是测试用的，就这一个游戏
[/Quote]
帖子不是我写的,是HD37写的:

用VB模拟键盘输入的N种方法

我当时测试的时候是使用SendInput完成的,星际里需要输入多次show me the money时用得上......

[嗷嗷叫的老马]

测试了一下,估计你是没有加入延迟吧.

我这里一切正常.

代码:

'代码位于窗体内.添加一个Command1与Timer1.
Option Explicit

Private Declare Sub Sleep Lib "kernel32.dll" ( _
     ByVal dwMilliseconds As Long)

Private Sub Command1_Click()
    Timer1.Tag = "1"
    Timer1.Interval = 3000                  '3秒时间用于切换到游戏界面
    Timer1.Enabled = Not Timer1.Enabled
    Me.Caption = Timer1.Enabled
End Sub

Private Sub Form_Load()
    If InitWinIO = False Then
        MsgBox "驱动程序加载失败!"
        Unload Me
    End If
    Me.Caption = Timer1.Enabled
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnloadWinIO '程序结束时记得用ShutdownWinIo函数卸载驱动程序
End Sub

Private Sub Timer1_Timer()
    Const VK_A As Long = &H41
    
    If Timer1.Tag <> "" Then
        Timer1.Tag = ""
        Timer1.Interval = 500
    End If
    
    MyKeyDown vbKeySpace        '0.1秒后放开空格键
    Sleep 100
    MyKeyUp vbKeySpace
    
    Sleep 2000
    
    MyKeyDown vbKeyW            '各按下1秒后放开
    Sleep 1000
    MyKeyUp vbKeyW
    
    MyKeyDown vbKeyA
    Sleep 1000
    MyKeyUp vbKeyA
    
    MyKeyDown vbKeyS
    Sleep 1000
    MyKeyUp vbKeyS
    
    MyKeyDown vbKeyD
    Sleep 1000
    MyKeyUp vbKeyD
End Sub

其效果为跳一下,然后前左后右各走1秒.

点击按钮后有3秒时间让你切换到游戏界面.

模块内的代码我封装了一下:

'代码位于ModSSendKeysD.bas.
Option Explicit

'利用WINIO驱动来模拟按键
'       WINIO.SYS与WINIO.DLL需要放在EXE所在目录(或系统目录内).
'       如果需要在WIN98下工作,则WINIO.VXD也需要放在上面目录内.
'WINIO驱动源代码及BIN文件下载地址:
'       http://www.m5home.com/bbs/dispbbs.asp?boardid=27&Id=1283   3楼
'
'BY 嗷嗷叫的老马
'http://www.m5home.com/

Private Declare Function MapPhysToLin Lib "WinIo.dll" (ByVal PhysAddr As Long, ByVal PhysSize As Long, ByRef PhysMemHandle) As Long
Private Declare Function UnmapPhysicalMemory Lib "WinIo.dll" (ByVal PhysMemHandle, ByVal LinAddr) As Boolean
Private Declare Function GetPhysLong Lib "WinIo.dll" (ByVal PhysAddr As Long, ByRef PhysVal As Long) As Boolean
Private Declare Function SetPhysLong Lib "WinIo.dll" (ByVal PhysAddr As Long, ByVal PhysVal As Long) As Boolean
Private Declare Function GetPortVal Lib "WinIo.dll" (ByVal PortAddr As Integer, ByRef PortVal As Long, ByVal bSize As Byte) As Boolean
Private Declare Function SetPortVal Lib "WinIo.dll" (ByVal PortAddr As Integer, ByVal PortVal As Long, ByVal bSize As Byte) As Boolean
Private Declare Function InitializeWinIo Lib "WinIo.dll" () As Boolean
Private Declare Function ShutDownWinIO Lib "WinIo.dll" Alias "ShutdownWinIo" () As Boolean
Private Declare Function InstallWinIoDriver Lib "WinIo.dll" (ByVal DriverPath As String, ByVal Mode As Integer) As Boolean
Private Declare Function RemoveWinIoDriver Lib "WinIo.dll" () As Boolean

' ------------------------------------以上是WINIO函数声明-------------------------------------------

Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long

'-----------------------------------以上是WIN32 API函数声明-----------------------------------------

Private Const KBC_KEY_CMD = &H64    '键盘命令端口
Private Const KBC_KEY_DATA = &H60   '键盘数据端口

Private Sub KBCWait4IBE()   '等待键盘缓冲区为空
    Dim dwVal As Long
    
    Do
        GetPortVal &H64, dwVal, 1
        '这句表示从&H64端口读取一个字节并把读出的数据放到变量dwVal中
        'GetPortVal函数的用法是GetPortVal 端口号,存放读出数据的变量,读入的长度
    Loop While (dwVal And &H2)
End Sub

Public Function InitWinIO() As Boolean
    '初始化驱动
    On Error Resume Next
    
    InitWinIO = ShutDownWinIO
End Function

Public Function UnloadWinIO() As Boolean
    '卸载驱动
    On Error Resume Next
    
    UnloadWinIO = ShutDownWinIO
End Function

Public Sub MyKeyDown(ByVal vKeyCoad As KeyCodeConstants)
    '这个用来模拟按下键，参数vKeyCoad传入按键的虚拟码
    Dim btScancode As Long
    
    btScancode = MapVirtualKey(vKeyCoad, 0)
    
    Call KBCWait4IBE   '发送数据前应该先等待键盘缓冲区为空
    SetPortVal KBC_KEY_CMD, &HD2, 1     '发送键盘写入命令
        'SetPortVal函数用于向端口写入数据，它的用法是SetPortVal 端口号,欲写入的数据，写入数据的长度
    Call KBCWait4IBE
    SetPortVal KBC_KEY_DATA, btScancode, 1  '写入按键信息,按下键
End Sub

Public Sub MyKeyUp(ByVal vKeyCoad As KeyCodeConstants)
    '这个用来模拟释放键，参数vKeyCoad传入按键的虚拟码
    Dim btScancode As Long
    
    btScancode = MapVirtualKey(vKeyCoad, 0)
    
    Call KBCWait4IBE   '等待键盘缓冲区为空
    SetPortVal KBC_KEY_CMD, &HD2, 1  '发送键盘写入命令
    Call KBCWait4IBE
    SetPortVal KBC_KEY_DATA, (btScancode Or &H80), 1  '写入按键信息，释放键
End Sub

[嗷嗷叫的老马]

模块里的InitWinIO函数写错了:

Public Function InitWinIO() As Boolean
    '初始化驱动
    On Error Resume Next
    
    InitWinIO = ShutDownWinIO
End Function

改为:

Public Function InitWinIO() As Boolean
    '初始化驱动
    On Error Resume Next
    
    InitWinIO = InitializeWinIo
End Function

[futosky]

谢谢了，不过我暂时不能用本（特殊情况），我会尽快测试，十分感谢。

[贝隆]

向老马学习一下！

[futosky]

测试了一下，这次行了。又学到了不少东西，感谢老马＾＾。不过手机还是结不了帖＾_＾||

[一笑拔剑]

[Quote=引用 1 楼 getemail 的回复:]
这个我知道，不过现在不能公开。
[/Quote]
干嘛这么能装，键盘模拟又不是什么高级技术

[赵4老师]

AutoHotKey

[贝隆]

根据老马的例子，我完成了我的软键盘，献个丑：http://download.csdn.net/source/1745426

[chyb1]

ddddddddddddddddddddddddddd