找回密码
 加入我们

QQ登录

只需一步,快速开始

搜索
查看: 5910|回复: 2

[其它源码] SendInput发送中文

[复制链接]

1

主题

1

回帖

0

精华

初来乍到

积分
123
发表于 2013-5-17 17:57:30 | 显示全部楼层 |阅读模式
'以下代码由由菜虫伊凡百度搜索得来,有错误的地方,请大大们指正,如果在您的电脑上不好用,那也别问我,因为我不懂。另外求个师父指导学习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

评分

参与人数 1水晶币 +20 收起 理由
Tesla.Angela + 20 新人发帖,鼓励一下吧。

查看全部评分

858

主题

2638

回帖

2

精华

管理员

此生无悔入华夏,  长居日耳曼尼亚。  

积分
36138
发表于 2013-5-17 19:51:43 | 显示全部楼层
新人发帖,鼓励一下吧。

30

主题

693

回帖

0

精华

钻石会员

积分
2815
发表于 2015-5-5 09:29:39 | 显示全部楼层
很好 继续加油哦
您需要登录后才可以回帖 登录 | 加入我们

本版积分规则

快速回复 返回顶部 返回列表