Monday, 22 January 2018

VBA - Querying an IE's javascript namespace

So once you have hold of an IE instance then you can begin to poke around in its namespace :) In the following program we query all the keys of the top level window object and then we show all the keys to jQuery the (near) ubiquitous javascript library. We write a one-line helper function to get jQuery.

Option Explicit

'* Tools->References
'Shell32                Microsoft Shell Controls And Automation         C:\Windows\SysWOW64\shell32.dll
'MSHTML                 Microsoft HTML Object Library                   C:\Windows\SysWOW64\mshtml.tlb
'Scripting              Microsoft Scripting Runtime                     C:\Windows\SysWOW64\scrrun.dll
'MSScriptControl        Microsoft Script Control 1.0                    C:\Windows\SysWOW64\msscript.ocx
'MSXML2                 Microsoft XML, v6.0                             C:\Windows\SysWOW64\msxml6.dll


Private Function SC() As ScriptControl
    'End
    Static soSC As ScriptControl
    If soSC Is Nothing Then

        Set soSC = New ScriptControl
        soSC.Language = "JScript"

        soSC.AddCode "function deleteValueByKey(obj,keyName) { delete obj[keyName]; } "
        soSC.AddCode "function setValueByKey(obj,keyName, newValue) { obj[keyName]=newValue; } "
        soSC.AddCode "function enumKeysToMsDict(jsonObj,msDict) { for (var i in jsonObj) { msDict.Add(i,0); }  } "
        soSC.AddCode GetJavaScriptLibrary("https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js")
        soSC.AddCode "function JSON_stringify(value, replacer,spacer) { return JSON.stringify(value, replacer,spacer); } "
        soSC.AddCode "function JSON_parse(sJson) { return JSON.parse(sJson); } "


        soSC.AddCode "function getjQuery(window) { return window.jQuery; } "
    End If
    Set SC = soSC
End Function

Private Function GetJavaScriptLibrary(ByVal sURL As String) As String

    Dim xHTTPRequest As MSXML2.XMLHTTP60
    Set xHTTPRequest = New MSXML2.XMLHTTP60
    xHTTPRequest.Open "GET", sURL, False
    xHTTPRequest.send
    GetJavaScriptLibrary = xHTTPRequest.responseText

End Function

Sub Test()

    Dim objIE As Object
    Set objIE = FindInternetExplorer()

    If Not objIE Is Nothing Then

        Dim objWindow As Object
        Set objWindow = objIE.document.parentWindow

        Dim dicWindowKeys As Scripting.Dictionary
        Set dicWindowKeys = New Scripting.Dictionary
        Call SC.Run("enumKeysToMsDict", objWindow, dicWindowKeys)

        Debug.Print vbNewLine & "The window interface " & vbNewLine & Join(dicWindowKeys.Keys, vbTab)

        If dicWindowKeys.Exists("jQuery") Then

            Dim objJQuery As Object
            Set objJQuery = SC.Run("getjQuery", objWindow)

            Dim dicJQueryKeys As Scripting.Dictionary
            Set dicJQueryKeys = New Scripting.Dictionary
            Call SC.Run("enumKeysToMsDict", objJQuery, dicJQueryKeys)

            Debug.Print vbNewLine & "The jQuery interface " & vbNewLine & Join(dicJQueryKeys.Keys, vbTab)


        End If



        Stop


    End If

End Sub



Private Function FindInternetExplorer(Optional sMatchURL As String)

    Dim oShell As Shell32.Shell
    Set oShell = New Shell32.Shell

    Dim wins As Object 'Shell32.Windows
    Set wins = oShell.Windows

    Dim winLoop As Variant
    For Each winLoop In oShell.Windows
        If "C:\Program Files (x86)\Internet Explorer\IEXPLORE.EXE" = winLoop.FullName Then

            Dim oApp As Object
            Set oApp = winLoop.Application
            If oApp.Visible = False Then
                '* why have invisible IE lying around, must have hung, get rid
                oApp.Quit
            End If
            If Len(sMatchURL) > 0 Then
                If sMatchURL = winLoop.LocationURL Then

                    Set FindInternetExplorer = winLoop.Application
                    Exit Function

                End If
            Else
                '* we're not fussy, return the first one and exit
                Set FindInternetExplorer = winLoop.Application
                Exit Function
            End If

        End If

    Next

End Function



No comments:

Post a Comment