[转载]WEBBROWSER中模拟鼠标点击(SendMessage/PostMessage) - 云上2014 - 博客园

baacloud免费翻墙vpn注册使用

[转载]WEBBROWSER中模拟鼠标点击(SendMessage/PostMessage) – 云上2014 – 博客园.

好久没有写文章,发一篇顶顶博客访问量。别人建议转一些比较好的代码也贴过来,但是我打算这里主要发自己原创的代码,所以么。。流量该多少就多少吧。。。

 

回到主题,在webbrowser中点击某链接网上几乎都是用document对象模拟点击,这个方法基本能应对一般的情况,但是例如广告联盟的点 击XXX就有检测机制(不多解释,你们懂的)。所以完全模拟鼠标的点击事件就比较完美。于是我用了最常见的SendMessage。

 

接下来就要解决一个问题,webbrowser的句柄问题。从控件本身得到的句柄不是真正的浏览窗口的句柄,用SPY++看一下就能看出来,这里不贴图了。按照这个窗体的结构,用以下代码可以获取到网页的窗口的句柄。
‘获得webbrowser的句柄
Private Function GetBrowserWindow(hWnd As Long) As Long
Dim lngHnd As Long
lngHnd = FindWindowEx(hWnd, 0, “Shell Embedding”, vbNullString) ‘
lngHnd = FindWindowEx(lngHnd, 0, “Shell DocObject View”, vbNullString)
lngHnd = FindWindowEx(lngHnd, 0, “Internet Explorer_Server”, vbNullString)
GetBrowserWindow = lngHnd
End Function

 

然后就是网页元素的定位,向哪个坐标发送点击。这里用了DOM对象遍历来获取具体位置。都知道网页上一个元素有 offsetLeft,offsetWidth,offsetHeight,offsetTop属性,但是都是相对容器来说的,所以可以通过遍历相加得到 这个元素的绝对位置(这个绝对也是相对于网页浏览器窗口来说的。。)。于是代码如下:
Private Sub GetPos(objA As Object)
On Error Resume Next
adW = objA.offsetWidth
adH = objA.offsetHeight
adX = objA.offsetLeft
adY = objA.offsetTop
Set objA = objA.parentNode   ‘遍历结点 获取绝对位置
Do While Not (objA Is Nothing)
adX = adX + objA.offsetLeft
adY = adY + objA.offsetTop
Set objA = objA.parentNode
Loop
txtX.Text = CStr(adX)
txtY.Text = CStr(adY)
Debug.Print “X:” & adX, “Y:” & adY, “W:” & adW, “H:” & adH, “P:” & adPos
End Sub

 

好了,主要的问题分析完毕,我不多说废话了,直接贴代码看吧。

 

‘获得webbrowser的句柄
Private Function GetBrowserWindow(hWnd As Long) As Long
Dim lngHnd As Long
lngHnd = FindWindowEx(hWnd, 0, “Shell Embedding”, vbNullString) ‘
lngHnd = FindWindowEx(lngHnd, 0, “Shell DocObject View”, vbNullString)
lngHnd = FindWindowEx(lngHnd, 0, “Internet Explorer_Server”, vbNullString)
GetBrowserWindow = lngHnd
End Function

 

Private Function IsURL(objHTML As Object) As Boolean
On Error Resume Next

 

Dim strHTML As String, strURL As String

IsURL = False
strURL = LCase$(txtHost.Text)
strHTML = LCase$(objHTML.innerhtml)   ‘都转成小写

If InStr(strHTML, strURL) > 0 Then IsURL = True  ‘是这个域名 返回true

 

End Function

 

Private Sub GetPos(objA As Object)
On Error Resume Next

 

adW = objA.offsetWidth
adH = objA.offsetHeight
adX = objA.offsetLeft
adY = objA.offsetTop
Set objA = objA.parentNode   ‘遍历结点 获取绝对位置

 

Do While Not (objA Is Nothing)
adX = adX + objA.offsetLeft
adY = adY + objA.offsetTop
Set objA = objA.parentNode
Loop

 

txtX.Text = CStr(adX)
txtY.Text = CStr(adY)
Debug.Print “X:” & adX, “Y:” & adY, “W:” & adW, “H:” & adH, “P:” & adPos
End Sub

 

”获取坐标按钮点击事件
Private Sub cmdGetXY_Click()
On Error Resume Next

 

Dim objHTML As Object
Dim i       As Integer

If txtHost.Text = “” Then
‘MsgBox “不写域名,搞我呀。。。”
Exit Sub
End If

 

txtX.Text = “”
txtY.Text = “”
adX = 0
adY = 0
adW = 0
adH = 0

For i = 0 To 9
Set objHTML = webB.Document.GetElementByID(“bdfs” & CStr(i))

 

If Not (objHTML Is Nothing) Then
If IsURL(objHTML) Then
Set objHTML = webB.Document.GetElementByID(“dfs” & CStr(i))
adPos = 1   ‘右侧链接区
Call GetPos(objHTML)
Exit For
End If
End If

 

Set objHTML = webB.Document.GetElementByID(“400” & CStr(i))

 

If Not (objHTML Is Nothing) Then
If IsURL(objHTML) Then
Set objHTML = webB.Document.GetElementByID(“aw” & CStr(i – 1))
adPos = 0
Call GetPos(objHTML)
Exit For
End If
End If

 

Set objHTML = webB.Document.GetElementByID(“300” & CStr(i))

 

If Not (objHTML Is Nothing) Then
If IsURL(objHTML) Then
Set objHTML = webB.Document.GetElementByID(“aw” & CStr(i – 1))
adPos = 2
Call GetPos(objHTML)
Exit For
End If
End If

 

Next

‘If adX = 0 And adY = 0 Then MsgBox “没有找到。。。”

Set objHTML = Nothing

End Sub

 

”’发送点击按钮点击事件
Private Sub cmdClick_Click()
On Error Resume Next
Dim x      As Long, y As Long
Dim intRnd As Integer

 

Randomize   ‘启动随机数

 

If adX = 0 And adY = 0 Then
‘MsgBox “没有找到链接你也点。。。”
Exit Sub
End If

wbHwnd = GetBrowserWindow(Me.hWnd)  ‘得到句柄

 

If adPos = 0 Then  ‘在搜索结果区的上面
webB.Document.parentwindow.Scroll 0, adY – adH + 8  ‘修正下数据 正好对准
x = 30 + Int((Rnd * adW) / 2)
y = (Int((Rnd * adH) / 2) + 2) * &H10000
ElseIf adPos = 1 Then ‘在右侧的推广链接区
webB.Document.parentwindow.Scroll adX, adY – 11 ‘修正下数据
x = 150 + Int((Rnd * adW) / 2)
y = (Int((Rnd * adH) / 2) + 2) * &H10000
ElseIf adPos = 2 Then ‘在搜索结果当中
webB.Document.parentwindow.Scroll 0, adY – 11  ‘修正下数据
x = 30 + Int((Rnd * adW) / 2)
y = (Int((Rnd * adH) / 2) + 2) * &H10000
End If

Debug.Print “Click:”, x, y / &H10000
PostMessage wbHwnd, WM_LBUTTONDOWN, 1&, x + y
PostMessage wbHwnd, WM_LBUTTONUP, 1&, x + y

End Sub

 

 

有什么问题可以加我Q跟我讨论

赞(0) 打赏
分享到: 更多 (0)

觉得文章有用就打赏一下文章作者

支付宝扫一扫打赏

微信扫一扫打赏