• VB.net WebBrowser网页元素抓取分析方法


    在用WebBrowser编程实现网页操作自动化时,常要分析网页Html,例如网页在加载数据时,常会显示“系统处理中,请稍候..”,我们需要在数据加载完成后才能继续下一步操作,如何抓取这个信息的网页html元素变化,从而判断数据加载完毕呢?用IE开发者工具是不可能抓取到的,太快了。(当然,设置足够长的延时,也是可以实现的,只是不够科学及稳妥,毕竟有时因为网络原因,数据加载时间可能超过原来设定时间,其次,设置延时过长也导致程序不够友好)

    实现的办法:

    1、先用“系统处理中”查找(泛查找),并在找到html中,再细找缩小html元素范围。

    bb = FindHtmlElement("系统处理中", ExtendedWebBrowser1.Document, "", "InnerText", false)

    2、添加一个Timer控件,设定100毫秒。根据 1中找到的元素,进行不断抓取,并将抓到的结果输出到文本。

    3、将2中输出,导入Excel,进行筛选,并从中找到重复次数少的行,便是数据加载、加载完成之间的变化。

    1. Private Sub TimerProgress_Tick(sender As Object, e As EventArgs) Handles TimerProgress.Tick
    2. If Gethtmel Then
    3. Dim bb As HtmlElement
    4. bb = FindHtmlElement("all_jzts", ExtendedWebBrowser1.Document, "div", "id", True)
    5. If Not bb Is Nothing Then
    6. 'WriteRunLog("Style : " + bb.Style)
    7. WriteRunLog(bb.OuterHtml)
    8. Else
    9. WriteRunLog("all_jzts没找到")
    10. End If
    11. bb = FindHtmlElement("jzts", ExtendedWebBrowser1.Document, "div", "id", True)
    12. If Not bb Is Nothing Then
    13. 'WriteRunLog("Style : " + bb.Style)
    14. WriteRunLog(bb.OuterHtml)
    15. Else
    16. WriteRunLog("jzts没找到")
    17. End If
    18. 'Gethtmel = False
    19. End If
    20. '系统处理中,请稍候...
    21. Application.DoEvents()
    22. End Sub
    1. Function FindHtmlElement(ByVal FindText As String, ByVal doc As HtmlDocument, ByVal cTagName As String, ByVal cGetAttribute As String, Optional ByVal StrictMatching As Boolean = False) As HtmlElement
    2. 'cTagName:检索具有指定 html 标记的元素,标记需要输入完整的,缺省时查找所有。
    3. '例如:,不能只输入"i",需要输入"input"
    4. 'cGetAttribute :比较的属性类型,取值为:Id、InnerText、Name、title、classname、value、
    5. 'Id、InnerText可以通过GetAttribute获取,也可以通过HtmlElement.Id、HtmlElement.InnerText获取,所以代码简化为用GetAttribute获取。
    6. 'doc:WebBrowserExt1.Document
    7. 'GetAttribute("classname") '例如显示class="commonTable"的值commonTable
    8. 'StrictMatching:True严格匹配FindText
    9. 'WriteRunLog("FindHtmlElement开始:" + FindText)
    10. Try
    11. Dim i, k As Integer
    12. FindHtmlElement = Nothing
    13. FindHtmlElementOfDocument = doc
    14. If doc Is Nothing Then '2023.11.15在递归调用中,因为有些iFrames还未真正加载,从而导致传入的doc = doc.Window.Frames.Item(k).Document 为 Nothing ,从而引发异常:未将对象引用设置到对象的实例。
    15. Exit Function
    16. End If
    17. If LCase(cGetAttribute) = "innertext" Then 'InnerText必须严格匹配,否则找到的结果是错误的。
    18. ’StrictMatching = True
    19. End If
    20. If cTagName <> "" Then
    21. Dim EE As HtmlElementCollection = doc.GetElementsByTagName(cTagName)
    22. For i = 0 To EE.Count - 1
    23. If InStr(EE.Item(i).GetAttribute(cGetAttribute), FindText) > 0 _
    24. And (Not StrictMatching Or InStr(FindText, EE.Item(i).GetAttribute(cGetAttribute)) > 0) Then
    25. FindHtmlElement = EE.Item(i)
    26. 'WriteRunLog("Loop1")
    27. 'WriteRunLog("FindHtmlElement结束0")
    28. Exit Function '找到就退出
    29. End If
    30. Next
    31. Else
    32. For i = 0 To doc.All.Count - 1
    33. If InStr(doc.All.Item(i).GetAttribute(cGetAttribute), FindText) > 0 _
    34. And (Not StrictMatching Or InStr(FindText, doc.All.Item(i).GetAttribute(cGetAttribute)) > 0) And (cTagName = "" Or LCase(cTagName) = LCase(doc.All.Item(i).TagName)) Then
    35. FindHtmlElement = doc.All.Item(i)
    36. 'WriteRunLog("Loop1")
    37. 'WriteRunLog("FindHtmlElement结束0")
    38. Exit Function '找到就退出
    39. End If
    40. Next
    41. End If
    42. '上面没找到,进行递归调用,递归会查找所有嵌套的Frame。
    43. For k = 0 To doc.Window.Frames.Count - 1
    44. 'If k = 0 Then
    45. ' WriteRunLog("递归调用 doc.Window.Frames.Count:" + doc.Window.Frames.Count.ToString) 'For Test
    46. 'End If
    47. '2018.3.14 直接 递归调用
    48. 'WriteRunLog("递归调用:" + Str(k))
    49. ' WriteRunLog("doc.Window.Frames.Item(k).Name:" + doc.Window.Frames.Item(k).Name)
    50. FindHtmlElementOfDocument = doc.Window.Frames.Item(k).Document
    51. FindHtmlElement = FindHtmlElement(FindText, doc.Window.Frames.Item(k).Document, cTagName, cGetAttribute, StrictMatching)
    52. If Not FindHtmlElement Is Nothing Then '找到就退出循环
    53. 'WriteRunLog("FindHtmlElement结束1")
    54. Exit Function
    55. End If
    56. Next
    57. Catch ex As Exception
    58. FindHtmlElement = Nothing
    59. WriteRunLog("FindHtmlElement发生异常:" + ex.Message)
    60. End Try
    61. End Function
    62. Sub WriteRunLog(ByVal MyMsg As String)
    63. 'Using w As StreamWriter = File.AppendText("RunLog.txt")
    64. Dim w As StreamWriter
    65. If File.Exists("RunLog.txt") Then
    66. If My.Computer.FileSystem.GetFileInfo("RunLog.txt").Length > 10485760 Then '2017.5.4 文件大于10M,清0
    67. w = File.CreateText("RunLog.txt")
    68. w.Write("文件大于10M,置0从头开始!")
    69. w.Write(Chr(9))
    70. Else
    71. w = File.AppendText("RunLog.txt")
    72. End If
    73. Else
    74. w = File.CreateText("RunLog.txt")
    75. End If
    76. w.Write(Now)
    77. w.Write(Chr(9)) '插入Tab键
    78. w.WriteLine(MyMsg)
    79. w.Flush()
    80. w.Close()
    81. 'End Using
    82. End Sub
  • 相关阅读:
    neo4j4.0+与JDK11知识图谱安装与配置
    js中ECharts的显示相关、动画、交互API、Koa2
    Flink--4、DateStream API(执行环境、源算子、基本转换算子)
    Android 下的usb框架及功能点
    简单看懂编译链接
    LeetCode 290. Word Pattern
    【Rust 入门学习】1.1 Rust 的安装、升级、卸载
    Netty 的整体架构是怎样的?
    Service 层异常抛到 Controller 层处理还是直接处理?
    【Linux网络】手把手实操Linux系统网络服务DHCP
  • 原文地址:https://blog.csdn.net/zslefour/article/details/134442328