|
'以下代码由由菜虫伊凡百度搜索得来,有错误的地方,请大大们指正,如果在您的电脑上不好用,那也别问我,因为我不懂。另外求个师父指导学习vb
Option Explicit
Private Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As INPUT_TYPE, ByVal cbSize As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Type INPUT_TYPE
dwType As Long
xi(0 To 23) As Byte
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
'KEYBDINPUT
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
Private Const KEYEVENTF_UNICODE = &H4
Private Const KEYEVENTF_KEYDOWN = &H0
'INPUT_TYPE
Private Const INPUT_MOUSE = 0
Private Const INPUT_KEYBOARD = 1
Private Const INPUT_HARDWARE = 2
Private Sub StuffBufferW(ByVal CharCode As Integer)
Dim Retval As Long, IT As INPUT_TYPE, KI(1) As KEYBDINPUT, I As Integer
With KI(0)
.wVk = 0
.wScan = CharCode
.dwFlags = KEYEVENTF_KEYDOWN Or KEYEVENTF_UNICODE
.time = 0
.dwExtraInfo = 0
End With
With KI(1)
.wVk = 0
.wScan = CharCode
.dwFlags = KEYEVENTF_KEYUP Or KEYEVENTF_UNICODE
.time = 0
.dwExtraInfo = 0
End With
With IT
.dwType = INPUT_KEYBOARD
End With
For I = 0 To UBound(KI)
MoveMemory IT.xi(0), KI(I), Len(KI(I))
Retval = SendInput(1&, IT, Len(IT))
If Retval = 0 Then
MsgBox " 发送失败"
End If
Next I
End Sub
Private Sub ProcessChar(this As String)
Dim code As Integer
code = AscW(this)
Call StuffBufferW(code)
End Sub
Public Sub SendStr(ByVal theStr As String)
Dim I As Long
For I = 1 To Len(theStr)
Call ProcessChar(Mid(theStr, I, 1))
Sleep 20
DoEvents
Next
End Sub
|
评分
-
查看全部评分
|