好久没有写文章，发一篇顶顶博客访问量。别人建议转一些比较好的代码也贴过来，但是我打算这里主要发自己原创的代码，所以么。。流量该多少就多少吧。。。
回到主题，在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跟我讨论。