|
|
以下代码保存为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:12
发表于 2010-5-20 18:12:26
发表于 2010-7-4 17:42:36
