【分享】vb过滤得到网页元素的通用函数

无·法 2017-01-17 09:12:46
加精

Option Explicit

Private Declare Function SafeArrayGetDim Lib "oleaut32.dll " (ByRef saArray() As Any) As Long

'名称:getElementsByAttributes
'功能:根据一个或多个条件对dom对象所有元素进行过滤得到目标元素
'参数:WebBrowser1,WebBrowser类型,要处理的webbrowser
' strAttributes,string型,内容为属性列表,多项的话用逗号隔开,
'返回:如果有匹配到的结果那么返回的就是html元素对象数组,用户需要执行判断使用
'范例:getElementsByAttributes(WebBrowser1,"id='kw'")(0).value="vb" '设置百度搜索框内容为vb
' getElementsByAttributes(WebBrowser1,"value='百度一下',type='submit'")(0).click '点击百度的搜索按钮
' getElementsByAttributes(WebBrowser1,"tagname='input',value^='百度'")(0).click '得到文本开头为“百度”的按钮并执行点击
' Dim v
' For Each v In getElementsByAttributes(WebBrowser1, "tagname=img,src<>''")
' Print v.src
' Next

'作者:sysdzw
'日期:23:53 2017-1-17
Public Function getElementsByAttributes(WebBrowser1 As Object, ByVal strAttributes As String) As Variant
Dim vTag As Object
Dim i&, strTiaojians$, isElementOk As Boolean, intElement%, vrt()
Dim reg As Object
Dim matchs As Object
Dim strAttrName As String, strAttrValue As String

Set reg = CreateObject("vbscript.regExp")
reg.Global = True
reg.IgnoreCase = True
reg.MultiLine = True
reg.Pattern = "([a-z\dA-Z-_.]+)([!=<>^$*|~]+)(['""]?)([^,]*)\3"
Set matchs = reg.Execute(strAttributes)

For Each vTag In WebBrowser1.Document.All
isElementOk = True
For i = 0 To matchs.Count - 1 '循环判断strAttributes中的多个条件,只有都符合才能返回true,如果有一个不符合就返回false并且退出其他条件的判断
strAttrName = LCase(matchs(i).SubMatches(0))
If strAttrName = "classname" Then strAttrName = "class"
If strAttrName = "tagname" Then
If Not isConditionOk(LCase(vTag.tagname), matchs(i).SubMatches(1), LCase(matchs(i).SubMatches(3))) Then
isElementOk = False
Exit For
End If
ElseIf strAttrName = "innerhtml" Then
If Not isConditionOk(LCase(vTag.innerhtml), matchs(i).SubMatches(1), LCase(matchs(i).SubMatches(3))) Then
isElementOk = False
Exit For
End If
ElseIf strAttrName = "innertext" Then
If Not isConditionOk(LCase(vTag.innertext), matchs(i).SubMatches(1), LCase(matchs(i).SubMatches(3))) Then
isElementOk = False
Exit For
End If
ElseIf strAttrName = "class" Then
strAttrValue = "NULL"
If Not IsNull(vTag.getattribute("class")) Then
strAttrValue = vTag.getattribute("class")
ElseIf Not IsNull(vTag.getattribute("classname")) Then
strAttrValue = vTag.getattribute("classname")
End If
If strAttrValue = "NULL" Then
isElementOk = False
Exit For
ElseIf Not (isConditionOk(strAttrValue, matchs(i).SubMatches(1), LCase(matchs(i).SubMatches(3))) Or isConditionOk(strAttrValue, matchs(i).SubMatches(1), LCase(matchs(i).SubMatches(3)))) Then
isElementOk = False
Exit For
End If
ElseIf IsNull(vTag.getattribute(strAttrName)) Then
isElementOk = False
Exit For
ElseIf Not isConditionOk(vTag.getattribute(strAttrName), matchs(i).SubMatches(1), matchs(i).SubMatches(3)) Then
isElementOk = False
Exit For
End If
Next

If isElementOk Then
ReDim Preserve vrt(intElement)
Set vrt(intElement) = vTag
intElement = intElement + 1
End If
Next
If SafeArrayGetDim(vrt) = 0 Then
getElementsByAttributes = Split("", "")
Else
getElementsByAttributes = vrt
End If
End Function
'简略的调用方式
Public Function g(WebBrowser1 As Object, ByVal strAttributes As String) As Variant
g = getElementsByAttributes(WebBrowser1, strAttributes)
End Function
'根据运算符检查条件是否符合
Private Function isConditionOk(ByVal strTagValue$, ByVal strCondition$, ByVal strValueForCheck$) As Boolean
If strCondition = "=" Then
isConditionOk = (strTagValue = strValueForCheck)
ElseIf strCondition = "!=" Or strCondition = "<>" Then
isConditionOk = (strTagValue <> strValueForCheck)
ElseIf strCondition = "^=" Then '选取开头为strValueForCheck的
isConditionOk = (Left(strTagValue, Len(strValueForCheck)) = strValueForCheck)
ElseIf strCondition = "$=" Then '选取末尾为strValueForCheck的
isConditionOk = (Right(strTagValue, Len(strValueForCheck)) = strValueForCheck)
ElseIf strCondition = "*=" Then '选取包含strValueForCheck的
isConditionOk = (InStr(strTagValue, strValueForCheck) > 0)
ElseIf strCondition = "|=" Then '选取值为strValueForCheck或者值为strValueForCheck前缀的,即strValueForCheck后面加个-
isConditionOk = (InStr(strTagValue, strValueForCheck) > 0 Or InStr(strTagValue, strValueForCheck & "-") > 0)
ElseIf strCondition = "~=" Then '选取属性值用空格分隔的值中包含给定值的元素
isConditionOk = (InStr(" " & strTagValue & " ", " " & strValueForCheck & " ") > 0)
End If
End Function




使用范例,获取所有src属性不为空的元素并打印出来
Private Sub Command1_Click()
Dim v
For Each v In getElementsByAttributes(WebBrowser1, "tagname=img,src<>''")
Print v.src
Next
End Sub


条件可以组合,比如得到input按钮上名字为搜索的按钮对象,并且name不为search那么strAttributes条件就用"tagname='input',value='搜索',name!='search'"
...全文
12068 29 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
29 条回复
切换为时间正序
请发表友善的回复…
发表回复
无·法 2019-05-13
  • 打赏
  • 举报
回复
引用 30 楼 weixin_40174192 的回复:
可以再举个详细一点的使用方法吗,有点不太懂,例如要拿到a标签,并且class="bcd"的内容怎么办


Private Sub Command1_Click()
Dim v
For Each v In getElementsByAttributes(WebBrowser1, "tagname=a,class=bcd")
Print v.href
Next
End Sub
猿使人有钱 2019-05-13
  • 打赏
  • 举报
回复
可以再举个详细一点的使用方法吗,有点不太懂,例如要拿到a标签,并且class="bcd"的内容怎么办
VB业余爱好者 2018-12-05
  • 打赏
  • 举报
回复
强大的正则表达式
6742 2017-02-13
  • 打赏
  • 举报
回复
linsondean 2017-02-13
  • 打赏
  • 举报
回复
正则表达式是个好东西
无·法 2017-02-11
  • 打赏
  • 举报
回复
引用 25 楼 Topc008 的回复:
呵呵,支持楼主分享。 不知道利用document.all和callback是不是可以实现?没试验过,如果可行的话,应该更简单
这个dom这么会和callback扯上联系?不明白
一如既往哈 2017-02-10
  • 打赏
  • 举报
回复
呵呵,支持楼主分享。 不知道利用document.all和callback是不是可以实现?没试验过,如果可行的话,应该更简单
狮子座鹰 2017-02-09
  • 打赏
  • 举报
回复
收藏,值得拥有
xiaoxiangqing 2017-02-07
  • 打赏
  • 举报
回复
cattpon 2017-02-04
  • 打赏
  • 举报
回复
learning~
hugh_z 2017-02-03
  • 打赏
  • 举报
回复
6666666666666
cattpon 2017-02-03
  • 打赏
  • 举报
回复
learning~
三断笛 2017-02-02
  • 打赏
  • 举报
回复
把jquery加载到DOM就更简单更强大啦
只有150M 2017-02-02
  • 打赏
  • 举报
回复
好高深。没有看懂。支持了
hugh_z 2017-02-01
  • 打赏
  • 举报
回复
6666666666
nettman 2017-01-31
  • 打赏
  • 举报
回复
cattpon 2017-01-31
  • 打赏
  • 举报
回复
learning~
hugh_z 2017-01-31
  • 打赏
  • 举报
回复
666666666666666
cattpon 2017-01-30
  • 打赏
  • 举报
回复
learning~
hugh_z 2017-01-30
  • 打赏
  • 举报
回复
6666666
加载更多回复(9)

7,785

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧