请问老师【Webbrowser】控件模拟有关问题

2012-01-19

请教老师【Webbrowser】控件模拟问题。需求：模拟在网页文本框中输入字符串（类是sendkeys）。1.别用【sendkeys】；2

请教老师【Webbrowser】控件模拟问题。
需求：
模拟在网页文本框中输入字符串（类是sendkeys）。

1.别用【sendkeys】；
2.执行时不要影响桌面用户操作（包括键盘操作）；
3.不用直接赋值；类似Form1.WebBrowser1.Document.getElementsByTagName("input")("q").value="csdn"。

我自己先前用google做了个实验还是不行：

VB code

Private Sub Command1_Click()Set doc = Form1.WebBrowser1.Document.getElementsByTagName("input")("q")Set e = Form1.WebBrowser1.Document.CreateEventObject()e.keyCode = 66'Call doc.FireEvent("onkeydown", e)'单独测试都不行'Call doc.FireEvent("onselect", e)'单独测试都不行Call doc.FireEvent("onkeyup", e)End SubPrivate Sub Form_Load()Form1.WebBrowser1.Navigate "www.google.com"End Sub

请老师指点一下，有其他方式也欢迎提供。

[解决办法]
你是想真实的模拟按键过去？这样好像不行的吧，按了键才触发onkeydown事件的，这里估计不行的，以前好像也有个人跟你问同样的问题的
[解决办法]
改用AutoHotKey软件脚本吧。
[解决办法]
我找到了一个办法,测试了对于我程序中的Webbrowser控件可行,当然,你还需要整合找窗体句柄的代码,以及用js将相应input focus()一下:
是用POST WM_KEYDOWN,WM_KEYUP消息实现的,参考自:
http://www.vbgood.com/viewthread.php?tid=54223

VB code

Option Explicit
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType 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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim doc As Object, e As Object
Private Function MakelParam(ByVal VirtualKey As Long, ByVal flag As Boolean) As Long
Dim s As String
Dim Firstbyte As String 'lparam参数的24-31位
If flag = False Then 'keydown
Firstbyte = "00"
Else
Firstbyte = "C0" 'keyup
End If
Dim Scancode As Long
'获得虚拟键扫描码
Scancode = MapVirtualKey(VirtualKey, 0)
Dim Secondbyte As String 'lparam参数的16-23位，即虚拟键扫描码
Secondbyte = Right("00" & Hex(Scancode), 2)
s = Firstbyte & Secondbyte & "0001" '0001为lparam参数的0-15位，即发送次数
MakelParam = Val("&H" & s)
End Function

Private Sub Command1_Click()
Call SendWindowKeys(CLng("&H" & txtWindow.Text), "ABC")
' Call SendWindowKeys(Text1.hwnd, "ABC")
End Sub

Private Sub Form_Load()
Me.WebBrowser1.Navigate "www.google.com"
End Sub

'---------------------------------------------------
' 过程名 : SendWindowKeys
' 时间 : 2010-3-17 13:45
' 作者 : 杨过.网狐.cn
' 功能 :
' 说明 : 暂只适合ascii字符串
'---------------------------------------------------

'
Public Sub SendWindowKeys(ByVal hWindow As Long, ByVal strKey As String)
Dim i As Integer, iKeyCode As Long
Dim lParam As Long
For i = 1 To Len(strKey)
iKeyCode = Asc(Mid$(strKey, i, 1))
lParam = MakelParam(iKeyCode, False)
PostMessage hWindow, WM_KEYDOWN, iKeyCode, lParam
lParam = MakelParam(iKeyCode, True)
PostMessage hWindow, WM_KEYUP, iKeyCode, lParam

Next i
End Sub

[解决办法]
直接用ShellExcute函数打开网址即可：

VB code

Option ExplicitPrivate Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) As LongPrivate Sub Command1_Click() Dim lngP As Long lngP = ShellExecute(0&, _ vbNullString, _ "www.csdn.net", _ vbNullString, _ vbNullString, _ vbNormalFocus)End Sub

热点排行