WEBBROWSER中模拟鼠标点击(SendMessage/PostMessage)

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

回到主题，在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跟我讨论。

WEBBROWSER中模拟鼠标点击(SendMessage/PostMessage),布布扣,bubuko.com

时间： 2024-10-25 06:20:26

WEBBROWSER中模拟鼠标点击(SendMessage/PostMessage)的相关文章

QT中模拟鼠标点击事件

传入座标,模拟鼠标点击QWebView中网页上的某一点 qDebug()<<"mouse clicked"; QPoint pos(403,34); QMouseEvent event0(QEvent::MouseButtonPress, pos, Qt::LeftButton, Qt::LeftButton, Qt::NoModifier); QApplication::sendEvent(view->page(), &event0); QMouseEven

求助:程序如何模拟鼠标点击一个TreeView节点?

void CreateTreeViewControl(HWND hMainWnd) { g_hTreeView = CreateWindow(WC_TREEVIEW, _T("Tree View"), WS_VISIBLE | WS_CHILD | WS_BORDER | TVS_HASLINES | TVS_LINESATROOT, 5, 5, 320, 480, hMainWnd, NULL, hInst, NULL); TVINSERTSTRUCT tvInsertStruct

模拟鼠标点击按钮的简单示例

原理 首先枚举到目标按钮所在程序的窗口,然后在该窗口内枚举控件获取控件的句柄,获取到按钮的句柄后可通过SendMessage或者PostMessage来发送消息模拟鼠标点击按钮等交互方式.但是因为枚举窗口和句柄都是使用WIN32 API,所以只能枚举到WIN32的控件,对于那些不是微软提供的控件则表示无能为力了.本示例简单地模拟一个往打字机里面写入数据,点击确认的方法. 主要代码 HWND hBtnAdd = NULL; HWND hEditAdd = NULL; HWND hEditMain

使用powershell/vbs自动化模拟鼠标点击操作

今天想做windows上的自动化,所以才有了模拟鼠标点击的需求,先考虑用powershell实现: 首先先安装一个名为“WASP”免费可用的Powershell扩展程序,下载地址:http://wasp.codeplex.com/ 下载解压之后放到C:\Windows\System32\WindowsPowerShell\v1.0\Modules\下,如图: 之后,在开始->运行处输入powershell,以管理员方式运行, 执行Import-Module WASP,则引入了扩展程序, 假如有个

jQuery模拟鼠标点击事件失效的问题

最近使用jQuery操作浏览器获取数据,需要对分页的信息进行处理,发现直接使用$('div#pager a.next').click();的这种写法无法触发点击事件. 使用trigger('click')的写法也是无济于事. 在网上一顿扒拉后,发现使用$('div#pager a.next')[0].click();就OK了. $('div#pager a.next')[0]这种写法其实就相当于把jQuery对象转换为Dom对象了. 模拟点击不生效的原因 如果使用jQuery的写法:$('a#t

利用python模拟鼠标点击自动完成工作，提升你的工作效率！

没有什么能比学以致用让学习变得更有动力的了. 不知道大家在工作中有没有一些工作需要重复的点击鼠标,因为会影响到财务统计报表的关系,我们每个月底月初都要修改ERP中的单据日期,单据多的时候光修改就能让你点鼠标点到手麻.(这里要吐槽一下浪沙软件,别的单据都可以批量修改日期,就是这个移仓单不行,你们研发怎么就这么懒?剩下这么点工作就不完成他?)之前同事有跟我提到过键盘精灵,因为当时负责别的工作,一直没有去了解.现在公司人员减少了,这工作又回到我身上了,刚好之前我在学习连连看的时候,知道Python 也

模拟鼠标点击键盘按下

#include <Windows.h> #include <stdlib.h> //打开程序或网页 void open(char *str) { ShellExecuteA(0, "open", str, 0, 0, 1); } //关闭程序 void close() { system("http://taskkill /f /im liebao.exe"); } //模拟键盘按下实现输入 void search() { keybd_eve

Webbrowser中模拟连接点击（非鼠标模拟）

Delphi [delphi] view plaincopy uses mshtml, ActiveX; //初始加载网易主页 procedure TForm1.FormCreate(Sender: TObject); begin Webbrowser1.Navigate('http://www.163.com/'); end; procedure TForm1.Button1Click(Sender: TObject); var I: Integer; Document: IHTMLDocum

如何使用python来模拟鼠标点击（将通过实例自动化模拟在360浏览器中自动搜索&quot;python&quot;）

一.准备工作: 安装pywin32,后面开发需要pywin32的支持,否则无法完成与windows层面相关的操作. pywin32的具体安装及注意事项: 1.整体开发环境: 基于windows7操作系统; 提前安装python(因为篇幅问题,在此不详细讲解python环境的安装,大家可以自备楼梯): 大家可以在cmd中测试下python环境是否安装好: 大家可以看到我电脑上已经安装好了Python,并显示版本与是V 3.6.2. 注:自己电脑上的Python版本号一定要知道,后面安装pywin3