怎么解决模拟键盘向文本框输入,有时文本框会因为系统资源有关问题而不接受模拟键入
如何解决模拟键盘向文本框输入,有时文本框会因为系统资源问题而不接受模拟键入?
我的一段代码,主要是向另一个程序的文本框输入一串数字.
mStr= "9000678964 "
for i=1 to 10
hWnd = FindWindow(vbNullString, "输入小窗口 ") '窗口句柄,向窗口键入即是向文本框键入(那另一个程序的 "特性 ",所以不必找文本框控件的句柄也可以)
ret = PostMessage(hWnd, WM_KEYDOWN, Asc(Mid(mStr, i, 1)), 0&)
next
代码能够成功键入,但在我家调试时(电脑配置较低,0.8G,(126+256)M),总会经常弄丢一个字符(都是 "0 "),设置断点时,有时能够全部输入,有时还是丢字符.
今晚将代码放在一台较高配置的电脑上运行(2.39G,512M),在不设断点的情况下,每次都能准确全部输入.
后来,想加入检验输入的代码,通过get textbox text 来检验键盘有没有成功输入.
mStr= "0000678964 "
for i=1 to 10
hWnd = FindWindow(vbNullString, "输入小窗口 ") '窗口句柄,向窗口键入即是向文本框键入(那另一个程序的 "特性 ",所以不必找文本框控件的句柄也可以)
ret = PostMessage(hWnd, WM_KEYDOWN, Asc(Mid(mStr, i, 1)), 0&)
'在这里加入*************************
ret = FindWindow(vbNullString, "输入小窗口 ")
hwndEdit = FindWindowEx(ret, 0, "Edit ", vbNullString) '文本框控件句柄
checkStr = String(255, Chr$(0))
SendMessageByVal hwndEdit, WM_GETTEXT, ByVal 255, checkStr '获取文本框控件的内容
'***********************************
next
(不能达到预期的效果)
在配置较高的电脑上,文本框已显示输入 "00 "时,但checkStr= "0 "(我这里省略了占位符).
有谁能有办法解决无论电脑配置高低的情况下,都能完整全部输入?
------解决方案--------------------
测试没有问题：
Dim mStr As String, hwnd As Long, ret As Long
mStr = "9000678964 "
hwnd = FindWindow( "notepad ", "无标题 - 记事本 ")
hwnd = FindWindowEx(hwnd, 0, "Edit ", vbNullString)
If hwnd = 0 Then Exit Sub
For i = 1 To 10
ret = PostMessage(hwnd, WM_KEYDOWN, Asc(Mid(mStr, i, 1)), 0&)
Next i
------解决方案--------------------
直接发送 WM_SETTEXT不行吗?
或者直接用sendkeys语句(使用前要用api函数SetFocus使目标获得焦点),可以参考一下:
Option Explicit
Private Declare Function GetWindowThreadProcessId Lib "user32 " (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function SetFocusApi Lib "user32 " Alias "SetFocus " (ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32 " Alias "SendMessageA " (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function AttachThreadInput Lib "user32 " (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
Private Sub mSendKeys(ByVal mhwnd As Long, ByVal s As String)
Dim Tid1 As Long, Tid2 As Long, pid As Long
Tid1 = GetWindowThreadProcessId(mhwnd, pid)
Tid2 = App.ThreadID
Call AttachThreadInput(Tid1, Tid2, True)
SetFocusApi mhwnd
SendKeys s, True
End Sub
我的一段代码,主要是向另一个程序的文本框输入一串数字.
mStr= "9000678964 "
for i=1 to 10
hWnd = FindWindow(vbNullString, "输入小窗口 ") '窗口句柄,向窗口键入即是向文本框键入(那另一个程序的 "特性 ",所以不必找文本框控件的句柄也可以)
ret = PostMessage(hWnd, WM_KEYDOWN, Asc(Mid(mStr, i, 1)), 0&)
next
代码能够成功键入,但在我家调试时(电脑配置较低,0.8G,(126+256)M),总会经常弄丢一个字符(都是 "0 "),设置断点时,有时能够全部输入,有时还是丢字符.
今晚将代码放在一台较高配置的电脑上运行(2.39G,512M),在不设断点的情况下,每次都能准确全部输入.
后来,想加入检验输入的代码,通过get textbox text 来检验键盘有没有成功输入.
mStr= "0000678964 "
for i=1 to 10
hWnd = FindWindow(vbNullString, "输入小窗口 ") '窗口句柄,向窗口键入即是向文本框键入(那另一个程序的 "特性 ",所以不必找文本框控件的句柄也可以)
ret = PostMessage(hWnd, WM_KEYDOWN, Asc(Mid(mStr, i, 1)), 0&)
'在这里加入*************************
ret = FindWindow(vbNullString, "输入小窗口 ")
hwndEdit = FindWindowEx(ret, 0, "Edit ", vbNullString) '文本框控件句柄
checkStr = String(255, Chr$(0))
SendMessageByVal hwndEdit, WM_GETTEXT, ByVal 255, checkStr '获取文本框控件的内容
'***********************************
next
(不能达到预期的效果)
在配置较高的电脑上,文本框已显示输入 "00 "时,但checkStr= "0 "(我这里省略了占位符).
有谁能有办法解决无论电脑配置高低的情况下,都能完整全部输入?
------解决方案--------------------
测试没有问题：
Dim mStr As String, hwnd As Long, ret As Long
mStr = "9000678964 "
hwnd = FindWindow( "notepad ", "无标题 - 记事本 ")
hwnd = FindWindowEx(hwnd, 0, "Edit ", vbNullString)
If hwnd = 0 Then Exit Sub
For i = 1 To 10
ret = PostMessage(hwnd, WM_KEYDOWN, Asc(Mid(mStr, i, 1)), 0&)
Next i
------解决方案--------------------
直接发送 WM_SETTEXT不行吗?
或者直接用sendkeys语句(使用前要用api函数SetFocus使目标获得焦点),可以参考一下:
Option Explicit
Private Declare Function GetWindowThreadProcessId Lib "user32 " (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function SetFocusApi Lib "user32 " Alias "SetFocus " (ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32 " Alias "SendMessageA " (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function AttachThreadInput Lib "user32 " (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
Private Sub mSendKeys(ByVal mhwnd As Long, ByVal s As String)
Dim Tid1 As Long, Tid2 As Long, pid As Long
Tid1 = GetWindowThreadProcessId(mhwnd, pid)
Tid2 = App.ThreadID
Call AttachThreadInput(Tid1, Tid2, True)
SetFocusApi mhwnd
SendKeys s, True
End Sub