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