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

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

实现的办法：

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

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

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

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

Private Sub TimerProgress_Tick(sender As Object, e As EventArgs) Handles TimerProgress.Tick

       If Gethtmel Then

           Dim bb As HtmlElement

           bb = FindHtmlElement("all_jzts", ExtendedWebBrowser1.Document, "div", "id", True)

           If Not bb Is Nothing Then

               'WriteRunLog("Style ：  " + bb.Style)

               WriteRunLog(bb.OuterHtml)

           Else

               WriteRunLog("all_jzts没找到")

           End If

           bb = FindHtmlElement("jzts", ExtendedWebBrowser1.Document, "div", "id", True)

           If Not bb Is Nothing Then

               'WriteRunLog("Style ：  " + bb.Style)

               WriteRunLog(bb.OuterHtml)

           Else

               WriteRunLog("jzts没找到")

           End If

           'Gethtmel = False

       End If

       '系统处理中，请稍候...

       Application.DoEvents()

   End Sub

 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

       'cTagName：检索具有指定 html 标记的元素，标记需要输入完整的，缺省时查找所有。

       '例如：，不能只输入"i"，需要输入"input"

       'cGetAttribute ：比较的属性类型，取值为：Id、InnerText、Name、title、classname、value、

       'Id、InnerText可以通过GetAttribute获取，也可以通过HtmlElement.Id、HtmlElement.InnerText获取，所以代码简化为用GetAttribute获取。

       'doc：WebBrowserExt1.Document

       'GetAttribute("classname")   '例如显示class="commonTable"的值commonTable

       'StrictMatching：True严格匹配FindText

       'WriteRunLog("FindHtmlElement开始：" + FindText)

       Try

           Dim i, k As Integer

           FindHtmlElement = Nothing

           FindHtmlElementOfDocument = doc

           If doc Is Nothing Then  '2023.11.15在递归调用中，因为有些iFrames还未真正加载，从而导致传入的doc = doc.Window.Frames.Item(k).Document 为 Nothing ，从而引发异常：未将对象引用设置到对象的实例。

               Exit Function

           End If



           If LCase(cGetAttribute) = "innertext" Then  'InnerText必须严格匹配，否则找到的结果是错误的。

               ’StrictMatching = True

           End If



           If cTagName <> "" Then

               Dim EE As HtmlElementCollection = doc.GetElementsByTagName(cTagName)

               For i = 0 To EE.Count - 1

                   If InStr(EE.Item(i).GetAttribute(cGetAttribute), FindText) > 0 _

             And (Not StrictMatching Or InStr(FindText, EE.Item(i).GetAttribute(cGetAttribute)) > 0) Then



                       FindHtmlElement = EE.Item(i)

                       'WriteRunLog("Loop1")

                       'WriteRunLog("FindHtmlElement结束0")

                       Exit Function                       '找到就退出

                   End If

               Next

           Else

               For i = 0 To doc.All.Count - 1

                   If InStr(doc.All.Item(i).GetAttribute(cGetAttribute), FindText) > 0 _

               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

                       FindHtmlElement = doc.All.Item(i)

                       'WriteRunLog("Loop1")

                       'WriteRunLog("FindHtmlElement结束0")

                       Exit Function                       '找到就退出

                   End If

               Next

           End If

           '上面没找到，进行递归调用，递归会查找所有嵌套的Frame。

           For k = 0 To doc.Window.Frames.Count - 1

               'If k = 0 Then

               '    WriteRunLog("递归调用 doc.Window.Frames.Count：" + doc.Window.Frames.Count.ToString)     'For Test

               'End If

               '2018.3.14 直接 递归调用

               'WriteRunLog("递归调用：" + Str(k))

               ' WriteRunLog("doc.Window.Frames.Item(k).Name：" + doc.Window.Frames.Item(k).Name)

               FindHtmlElementOfDocument = doc.Window.Frames.Item(k).Document

               FindHtmlElement = FindHtmlElement(FindText, doc.Window.Frames.Item(k).Document, cTagName, cGetAttribute, StrictMatching)

               If Not FindHtmlElement Is Nothing Then  '找到就退出循环

                   'WriteRunLog("FindHtmlElement结束1")

                   Exit Function

               End If

           Next

       Catch ex As Exception

           FindHtmlElement = Nothing

           WriteRunLog("FindHtmlElement发生异常：" + ex.Message)

       End Try

   End Function


 Sub WriteRunLog(ByVal MyMsg As String)

       'Using w As StreamWriter = File.AppendText("RunLog.txt")

       Dim w As StreamWriter

       If File.Exists("RunLog.txt") Then

           If My.Computer.FileSystem.GetFileInfo("RunLog.txt").Length > 10485760 Then  '2017.5.4 文件大于10M，清0

               w = File.CreateText("RunLog.txt")

               w.Write("文件大于10M，置0从头开始！")

               w.Write(Chr(9))

           Else

               w = File.AppendText("RunLog.txt")

           End If

       Else

           w = File.CreateText("RunLog.txt")

       End If

       w.Write(Now)

       w.Write(Chr(9))     '插入Tab键

       w.WriteLine(MyMsg)

       w.Flush()

       w.Close()

       'End Using

   End Sub