HTML, XML, and JSON Document Support

[GCuser99]

Usage case: I have a VBA script that automatically saves webpage data on a daily basis for future processing. The webpages are saved to *.html files. Later, when I'm ready to process these files, I read them back into SeleniumVBA and parse them all at once. One problem with this is that when I navigate to the saved files, dynamic html content (for example "src=" attributes in iframes) causes the navigation to take a long time (sometimes 10's of seconds) as the dynamic content attempts to resolve. I need a way to "render" the saved html files as "offline" content, by disabling (or "sanitizing") the dynamic content while leaving the DOM tree intact before saving.

Additionally, I have found that sometimes when trying to load an HTMLDocument object with unsanitized webpage source, I will get an unexpected "Windows Security Warning" popup along with an instance of the IE browser, even though I'm using Chrome/Edge driver. With sanitization, this behavior does not occur.

The above examples prompted me to develop functionality for sanitizing html source, and more generally methods for supporting HTML, XML, and JSON documents:

• GetHTMLDoc - returns an HTMLDocument object loaded with current (optionally sanitized) webpage source
• GetXMLDoc - returns an DOMDocument60 object loaded with current XML webpage source
• GetJsonObject - returns a JSON object (Dictionary or Collection) loaded with current JSON webpage source
• SaveHTMLToFile - saves the current (optionally sanitized) webpage source to file
• SaveXMLToFile - saves the current XML webpage source to file
• SaveJsonToFile - saves the current JSON webpage source to file

In addition to optional sanitization of the HTML source, the Json and XML methods optionally allow "pretty print" indentation for easier reading.

Comments welcome. Any suggestions on naming these methods?

Here is a test usage:

Sub test_sanitize_html()
    Dim driver As SeleniumVBA.WebDriver
    Dim htmlDoc As HTMLDocument
    
    Set driver = SeleniumVBA.New_WebDriver
    
    driver.StartChrome
    driver.OpenBrowser
    
    url = "https://www.wikipedia.org/"
    
    driver.NavigateTo url
    driver.Wait 1000
    
    Set htmlDoc = driver.GetHTMLDoc(sanitize:=True)
    
    'use DOM to parse htmlDoc here if desired....
    
    'and/or save sanitized source to file...
    driver.SaveHTMLToFile "source_sanitized.html", sanitize:=True
    
    driver.NavigateToFile "source_sanitized.html"
    driver.Wait 1000
    
    driver.Shutdown
End Sub

Here is the proposed code block for adding to WebDriver class.

Function GetHTMLDoc(Optional sanitize As Boolean = False) As HTMLDocument
    Dim htmlDoc As New HTMLDocument
    
    If sanitize Then
        htmlDoc.DocumentElement.innerHTML = sanitizeHTML(Me.GetPageSource)
    Else
        htmlDoc.DocumentElement.innerHTML = Me.GetPageSource
    End If
    
    Do While htmlDoc.readyState <> "complete"
        DoEvents
    Loop
    
    Set GetHTMLDoc = htmlDoc
End Function

Function GetXMLDoc() As MSXML2.DOMDocument60
    Dim str As String
    Dim xmlDoc As New MSXML2.DOMDocument60
    
    Select Case browser_
    Case svbaBrowser.Chrome, svbaBrowser.Edge
        str = Me.FindElementByXPath("//*[@id='webkit-xml-viewer-source-xml']").GetInnerHTML
    Case svbaBrowser.Firefox
        str = Me.GetPageSource
    End Select
    
    xmlDoc.LoadXML str
    
    Set GetXMLDoc = xmlDoc
End Function

Function GetJsonObject() As Object
    Dim str As String
    Dim jc As New WebJSonConverter
    
    If browser_ = svbaBrowser.Firefox Then
        'check to see if preference "devtools.jsonview.enabled" = True (default)
        If Me.FindElementsByTagName("pre").Count = 0 Then
            'Firefox using jsonview, so now click rawdata tab
            Me.FindElementByID("rawdata-tab").Click
        End If
    End If
    
    str = Me.FindElementByTagName("pre").GetText
    
    Set GetJsonObject = jc.ParseJSON(str)
End Function

Sub SaveHTMLToFile(ByVal filePath As String, Optional ByVal sanitize As Boolean = False)
    If sanitize Then
        Me.SaveStringToFile sanitizeHTML(Me.GetPageSource), filePath
    Else
        Me.SaveStringToFile Me.GetPageSource, filePath
    End If
End Sub

Sub SaveXMLToFile(ByVal filePath As String, Optional ByVal prettyPrint = False)
    Dim str As String
    Dim xmlDoc As New MSXML2.DOMDocument60
    
    Select Case browser_
    Case svbaBrowser.Chrome, svbaBrowser.Edge
        str = Me.FindElementByXPath("//*[@id='webkit-xml-viewer-source-xml']").GetInnerHTML
    Case svbaBrowser.Firefox
        str = Me.GetPageSource
    End Select
    
    If prettyPrint Then str = FormatXML(str)
    
    Me.SaveStringToFile str, filePath
End Sub

Sub SaveJsonToFile(ByVal filePath As String, Optional ByVal prettyPrint = False)
    Dim str As String
    Dim jc As New WebJSonConverter
    
    If browser_ = svbaBrowser.Firefox Then
        'check to see if preference "devtools.jsonview.enabled" = True (default)
        If Me.FindElementsByTagName("pre").Count = 0 Then
            'Firefox using jsonview, so now click rawdata tab
            Me.FindElementByID("rawdata-tab").Click
        End If
    End If
    
    str = Me.FindElementByTagName("pre").GetText
    
    If prettyPrint Then str = jc.ConvertToJson(jc.ParseJSON(str), 4)
    
    Me.SaveStringToFile str, filePath
End Sub

Private Function sanitizeHTML(ByVal str As String) As String
    Dim htmlDoc As New HTMLDocument
    Dim elems As IHTMLDOMChildrenCollection
    Dim elem As HTMLGenericElement
    Dim parentElem As HTMLDivElement
    Dim i As Long, j As Long
    Dim ipos1 As Long, ipos2 As Long
    Dim foundOne As Boolean
    Dim subStr As String
    Dim eventsArray() As Variant
    Dim eventStr As String
    
    'This function renders html source "offline" by disabling dynamic content, while leaving the DOM tree intact.
    
    'This following are disabled:
    
    '- script elements
    '- url redirects
    '- src attributes
    '- srcset attributes
    '- href attributes
    '- rel attributes
    '- url() function in style elements and attributes
    '- action attributes in form elements
    '- as attribute in link element when as='script'
    '- on* event attributes
    '- data attribute in object elements
    
    'To perform above in a reliable and efficient way, the source is loaded into a simulated document fragment using a div element as
    'the root. This way the source can be parsed using DOM while disconnected from a html document root.
    'html, head, and body tags in the input string are renamed prior to loading into the div element, and then renamed back
    'before returning the results.
    
    'rename html, head, and body tags
    'use vbTextCompare for case insensitivity
    str = Replace(str, "<html>", "<html_>", Compare:=vbTextCompare)
    str = Replace(str, "<html ", "<html_ ", Compare:=vbTextCompare)
    str = Replace(str, "</html>", "</html_>", Compare:=vbTextCompare)

    str = Replace(str, "<head>", "<head_>", Compare:=vbTextCompare)
    str = Replace(str, "<head ", "<head_ ", Compare:=vbTextCompare)
    str = Replace(str, "</head>", "</head_>", Compare:=vbTextCompare)
    
    str = Replace(str, "<body>", "<body_>", Compare:=vbTextCompare)
    str = Replace(str, "<body ", "<body_ ", Compare:=vbTextCompare)
    str = Replace(str, "</body>", "</body_>", Compare:=vbTextCompare)

    'create the simulated document fragment using a div element
    Set parentElem = htmlDoc.createElement("div")
    'assign the input string to inner html of the parent element
    parentElem.innerHTML = str
    
    'disable scripts
    Set elems = parentElem.querySelectorAll("script")
    For i = 0 To elems.Length - 1
        Set elem = elems.Item(i)
        elem.innerText = ""
    Next i
    
    'disable redirect
    Set elems = parentElem.querySelectorAll("meta[http-equiv='refresh']")
    For i = 0 To elems.Length - 1
        Set elem = elems.Item(i)
        elem.SetAttribute "content", ""
    Next i
    
    'disable src attributes
    Set elems = parentElem.querySelectorAll("*[src]")
    For i = 0 To elems.Length - 1
        Set elem = elems.Item(i)
        elem.SetAttribute "src", ""
    Next i
    
    'disable srcset attributes
    Set elems = parentElem.querySelectorAll("*[srcset]")
    For i = 0 To elems.Length - 1
        Set elem = elems.Item(i)
        elem.SetAttribute "srcset", ""
    Next i
    
    'disable href attributes
    Set elems = parentElem.querySelectorAll("*[href]")
    For i = 0 To elems.Length - 1
        Set elem = elems.Item(i)
        If Not (elem.GetAttribute("href") Like "about:blank*") Then
            elem.SetAttribute "href", ""
        End If
    Next i
    
    'disable rel attributes
    Set elems = parentElem.querySelectorAll("*[rel]")
    For i = 0 To elems.Length - 1
        Set elem = elems.Item(i)
        elem.SetAttribute "rel", ""
    Next i
    
    'disable url() function in style elements
    Set elems = parentElem.querySelectorAll("style")
    For i = 0 To elems.Length - 1
        Set elem = elems.Item(i)
        subStr = LCase(elem.innerHTML) 'this is needed to use much faster (>10x!) vbBinaryCompare
        foundOne = False
        ipos1 = InStr(1, subStr, "url(")
        Do While ipos1
            ipos2 = InStr(ipos1 + 4, subStr, ")")
            subStr = Mid(subStr, 1, ipos1 + 3) & Mid(subStr, ipos2)
            foundOne = True
            ipos1 = InStr(ipos1 + 5, subStr, "url(")
            DoEvents
        Loop
        If foundOne Then elem.innerHTML = subStr
    Next i
    
    'disable url() function in style attributes
    Set elems = parentElem.querySelectorAll("[style*='url(']")
    For i = 0 To elems.Length - 1
        Set elem = elems.Item(i)
        subStr = LCase(elem.GetAttribute("style"))
        foundOne = False
        ipos1 = InStr(1, subStr, "url(")
        Do While ipos1
            ipos2 = InStr(ipos1 + 4, subStr, ")")
            subStr = Mid(subStr, 1, ipos1 + 3) & Mid(subStr, ipos2)
            foundOne = True
            ipos1 = InStr(ipos1 + 5, subStr, "url(")
            DoEvents
        Loop
        If foundOne Then elem.SetAttribute "style", subStr
    Next i
    
    'disable action attributes in form elements
    Set elems = parentElem.querySelectorAll("form[action]")
    For i = 0 To elems.Length - 1
        Set elem = elems.Item(i)
        elem.SetAttribute "action", ""
    Next i
    
    'disable as attributes equal to "script" in link elements
    Set elems = parentElem.querySelectorAll("link[as='script']") 'make sure this doesnt need doublequotes
    For i = 0 To elems.Length - 1
        Set elem = elems.Item(i)
        elem.SetAttribute "as", ""
    Next i
    
    'disable as data attributes in object elements
    Set elems = parentElem.querySelectorAll("object[data]") 'make sure this doesnt need doublequotes
    For i = 0 To elems.Length - 1
        Set elem = elems.Item(i)
        elem.SetAttribute "data", ""
    Next i
    
    'disable as on* event attributes
    eventsArray = Array("onclick", "onload", "onoffline", "ononline", "onunload", "onpageshow", "onpagehide", "onerror", "onresize", "onhashchange", "onbeforeunload", "onpopstate", "onmessage")
    For j = 0 To UBound(eventsArray)
        eventStr = eventsArray(j)
        Set elems = parentElem.querySelectorAll("*[" & eventStr & "]")
        For i = 0 To elems.Length - 1
            Set elem = elems.Item(i)
            'can't use SetAttribute for on* event attributes so let's remove it instead
            elem.removeAttribute eventStr
            'add a replacement attribute with dummy suffix - will remove suffix with replace after dom processing
            elem.SetAttribute eventStr & "___xxx123", ""
        Next i
    Next j

    'load processed source back into str
    str = parentElem.innerHTML
    
    'rename dummy tags back to original tag names
    str = Replace(str, "<html_", "<html", , 1)
    str = Replace(str, "</html_>", "</html>", , 1)

    str = Replace(str, "<head_", "<head", , 1)
    str = Replace(str, "</head_>", "</head>", , 1)
    
    str = Replace(str, "<body_", "<body")
    str = Replace(str, "</body_>", "</body>")
    
    str = Replace(str, "___xxx123", "")
    
    sanitizeHTML = str
End Function

Private Function FormatXML(ByVal val As String) As String
    Dim xslDoc As New MSXML2.DOMDocument60
    Dim xmlDocFormatted As New MSXML2.DOMDocument60
    Dim xmlDoc As New MSXML2.DOMDocument60
    
    xmlDoc.LoadXML val
    
    xslDoc.LoadXML "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>" _
            & "<xsl:stylesheet version=" & Chr(34) & "1.0" & Chr(34) _
            & "                xmlns:xsl=" & Chr(34) & "http://www.w3.org/1999/XSL/Transform" & Chr(34) & ">" _
            & "<xsl:strip-space elements=" & Chr(34) & "*" & Chr(34) & " />" _
            & "<xsl:output method=" & Chr(34) & "xml" & Chr(34) & " indent=" & Chr(34) & "yes" & Chr(34) & "" _
            & "            encoding=" & Chr(34) & "UTF-8" & Chr(34) & "/>" _
            & " <xsl:template match=" & Chr(34) & "node() | @*" & Chr(34) & ">" _
            & "  <xsl:copy>" _
            & "   <xsl:apply-templates select=" & Chr(34) & "node() | @*" & Chr(34) & " />" _
            & "  </xsl:copy>" _
            & " </xsl:template>" _
            & "</xsl:stylesheet>"
    
    xslDoc.async = False
    xmlDoc.transformNodeToObject xslDoc, xmlDocFormatted
    FormatXML = xmlDocFormatted.XML
End Function

[6DiegoDiego9]

I have never needed separate download vs parsing yet, anyway, when opening the files, what about programmatically turn on an extension like "Work Offline" that blocks the browser (or single tab) communication with Internet?
https://chrome.google.com/webstore/detail/work-offline/gcjdagaoojgeilcobhibkgbodajcojda

[GCuser99]

Thx for the link. I'd like to do this without extensions (and that particular one does not have good reviews). I did do research on whether there was a clean capabilities solution and could not find one....

[GCuser99]

Open to suggestions on naming these methods - my preference is to name them in a way that they all end up in the same place on the intelisense properties/method list... Here are some options I came up with - again, suggestions welcome:

WebPageToHTMLFile
WebPageToHTMLDoc
WebPageToJSONFile
WebPageToJSONObject
WebPageToXMLFile
WebPageToXMLDoc

Set htmlDoc = driver.WebPageToHTMLDoc()

SaveToHTMLFile
SaveToHTMLDoc
SaveToJSONFile
SaveToJSONObject
SaveToXMLFile
SaveToXMLDoc

Set htmlDoc = driver.SaveToHTMLDoc()

SavePageToHTMLFile
SavePageToHTMLDoc
SavePageToJSONFile
SavePageToJSONObject
SavePageToXMLFile
SavePageToXMLDoc

Set htmlDoc = driver.SavePageToHTMLDoc()

PageToHTMLFile
PageToHTMLDoc
PageToJSONFile
PageToJSONObject
PageToXMLFile
PageToXMLDoc

Set htmlDoc = driver.PageToHTMLDoc()

SourceToHTMLFile
SourceToHTMLDoc
SourceToJSONFile
SourceToJSONObject
SourceToXMLFile
SourceToXMLDoc

Set htmlDoc = driver.SourceToHTMLDoc()

[6DiegoDiego9]

Good question and difficult answer.

I'd vote for:
PageTo...

or even a shorter:
To...