VB模拟广告点击(包括二次点击)
2009年10月19日
网上找来的,就存个档,以便以后查询是用。哈哈。
因为是实验性质的,所以就用比较简单易用的VB来实现吧.当然,一个东西一旦简单了,那么就肯定有他相对复杂的地方.我的实现方法肯定不是最好的,但是非常简单.
先说一下思路吧,采用WebBrowser控件,以及模拟鼠标操作的API,首先由WebBrowser打开网站页面,然后移动到广告显示的位置, 接着模拟鼠标移动到广告所在位置进行点击,打开的内容在第二个WebBrowser中显示,然后移动到二次点击(也就是第二跳)的连接所在位置进行点击. 基本上没有再做第三跳的必要了.
下面就是全部的代码.
窗体上有两个COMMAND和两个WebBrowser,FORM1的启动显示位置要设置为屏幕中央
'对于API的调用
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Sub Command1_Click()
Mouse_click 500, 300
End Sub
Private Sub Command2_Click()
Mouse_click 520, 440
End Sub
Private Sub Form_Load()
WebBrowser1.Navigate "your ad url"
End Sub
Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
'webbrowser的newwindow2事件中设置新开窗口的对象为webbrowser2
Set ppDisp = WebBrowser2.Objec
End Sub
Private Sub WebBrowser2_DocumentComplete(ByVal pDisp As Object, URL As Variant)
'当下载完毕时移动到二点连接所在位置
WebBrowser2.Document.parentWindow.scrollBy 20, 144
End Sub
Private Sub Mouse_click(x As Integer, y As Integer)
SetCursorPos x, y '模拟鼠标移动到指定坐标(相对于屏幕)
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0 '模拟鼠标左键按下
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 '模拟鼠标左键抬起
End Sub
2009年10月19日
网上找来的,就存个档,以便以后查询是用。哈哈。
因为是实验性质的,所以就用比较简单易用的VB来实现吧.当然,一个东西一旦简单了,那么就肯定有他相对复杂的地方.我的实现方法肯定不是最好的,但是非常简单.
先说一下思路吧,采用WebBrowser控件,以及模拟鼠标操作的API,首先由WebBrowser打开网站页面,然后移动到广告显示的位置, 接着模拟鼠标移动到广告所在位置进行点击,打开的内容在第二个WebBrowser中显示,然后移动到二次点击(也就是第二跳)的连接所在位置进行点击. 基本上没有再做第三跳的必要了.
下面就是全部的代码.
窗体上有两个COMMAND和两个WebBrowser,FORM1的启动显示位置要设置为屏幕中央
'对于API的调用
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Sub Command1_Click()
Mouse_click 500, 300
End Sub
Private Sub Command2_Click()
Mouse_click 520, 440
End Sub
Private Sub Form_Load()
WebBrowser1.Navigate "your ad url"
End Sub
Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
'webbrowser的newwindow2事件中设置新开窗口的对象为webbrowser2
Set ppDisp = WebBrowser2.Objec
End Sub
Private Sub WebBrowser2_DocumentComplete(ByVal pDisp As Object, URL As Variant)
'当下载完毕时移动到二点连接所在位置
WebBrowser2.Document.parentWindow.scrollBy 20, 144
End Sub
Private Sub Mouse_click(x As Integer, y As Integer)
SetCursorPos x, y '模拟鼠标移动到指定坐标(相对于屏幕)
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0 '模拟鼠标左键按下
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 '模拟鼠标左键抬起
End Sub