Rakesh Swain
Rakesh Swain

Reputation: 41

Is there a way to use Microsoft Edge or Google Chrome to send http requests

I am trying to save the google maps static image using their maps.googleapis API for a use case in our application and later delete it. It had been working great by calling Microsoft.XMLHTTP request in a VBScript which uses Internet Explorer for its functionality until recently, access to websites using Internet Explorer has been banned in our organization due to some security policies. Below is the code snippet. Is there a way to create a similar object that would use Microsoft Edge? I did try the ServerXMLHTTP but that errors by timing out.

xsize = "640"
ysize = "640"
maptype = "hybrid"
zoom = "5"
lat = "38.725160"
lon = "105.155810"
format ="png32"
key = "***************"
outfile = "test.png"

URL = "http://maps.googleapis.com/maps/api/staticmap?size="& xsize & "x" & ysize & "&sensor=true&maptype=" & maptype & "&format=" & format & "&zoom=" & zoom & "&center=" & lat & "," & lon & "&key=" & key

Set xml = CreateObject("Microsoft.XMLHTTP")
xml.Open "GET", URL, False
xml.Send

If xml.readyState = 4 And xml.status = 200 Then
  set oStream = createobject("Adodb.Stream")
  Const adTypeBinary = 1
  Const adSaveCreateOverWrite = 2
  Const adSaveCreateNotExist = 1

  oStream.type = adTypeBinary
  oStream.open
  oStream.write xml.responseBody

  oStream.savetofile outfile, adSaveCreateOverWrite

  oStream.close

  set oStream = nothing
  Set xml = Nothing
End If

Upvotes: 1

Views: 659

Answers (2)

Rakesh Swain
Rakesh Swain

Reputation: 41

Option Explicit

Dim width, height, mapType, zoom, lat, lon, format, apiKey, outFile, url
Dim chromePath

width = "640"
height = "640"
mapType = "hybrid"
zoom = "15"
lat = "38.725160"
lon = "-105.155810"
format ="png32"
apiKey = "AIzaSyAh9c_y5b9cC1OwMrO7BwCNvEbgbDcYg-g"
outFile = CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName) & "\" & "test.png"
url = "http://maps.googleapis.com/maps/api/staticmap?size=" & width & "x" & height & "&sensor=true&maptype=" & mapType & "&format=" & format & "&zoom=" & zoom & "&center=" & lat & "," & lon & "&key=" & apiKey

chromePath = getChromePath()
If chromePath = "" Then MsgBox "Could not find chrome executable.": WScript.Quit
CreateObject("WScript.Shell").Run """" & chromePath & """ --headless --disable-gpu --screenshot=""" & outFile & """ --window-size=" & width & "," & height & " """ & url & """", 1, True
MsgBox "Saved to " & outFile, vbInformation

function readFromRegistry (strRegistryKey, strDefault)
    Dim WSHShell, value
    On Error Resume Next
    Set WSHShell = CreateObject ("WScript.Shell")
    value = WSHShell.RegRead (strRegistryKey)

    if err.number <> 0 then
        readFromRegistry= strDefault
    else
        readFromRegistry=value
    end if

    set WSHShell = nothing
end function

Function getChromePath()
    Dim chromePath, chromeVersion
    Dim WShellChrome

    chromePath = readFromRegistry ( "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\chrome.exe\Path", "") 
    if (chromePath = "") then
        chromePath = "chrome.exe"
    else
        chromePath = chromePath & "\chrome.exe"
    end if
    getChromePath = chromePath
End Function

Upvotes: 1

omegastripes
omegastripes

Reputation: 12612

Option Explicit

Dim width, height, mapType, zoom, lat, lon, format, apiKey, outFile, url
width = "640"
height = "640"
mapType = "hybrid"
zoom = "5"
lat = "38.725160"
lon = "105.155810"
format ="png32"
apiKey = "***************"
outFile = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop") & "\" & "test.png"
url = "http://maps.googleapis.com/maps/api/staticmap?size=" & width & "x" & height & "&sensor=true&maptype=" & mapType & "&format=" & format & "&zoom=" & zoom & "&center=" & lat & "," & lon & "&key=" & apiKey
Dim chromePath
chromePath = getChromePath()
If chromePath = "" Then MsgBox "Need Chrome v59+": WScript.Quit
CreateObject("WScript.Shell").Run """" & chromePath & """ --headless --disable-gpu --screenshot=""" & outFile & """ --window-size=" & width & "," & height & " """ & url & """", 1, True
MsgBox "Saved to " & outFile, vbInformation

Function getChromePath()

    Const HKLM = &H80000002 ' HKEY_LOCAL_MACHINE
    Dim stdRegProv
    Set stdRegProv = GetObject("winmgmts://./root/default:StdRegProv")
    Dim regKey
    For Each regKey In Array("SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\", "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\")
        Dim subKeys
        stdRegProv.EnumKey HKLM, regKey, subKeys
        If Not IsNull(subKeys) Then
            Dim subKey
            For Each subKey In subKeys
                Dim ret, value
                ret = stdRegProv.GetStringValue(HKLM, regKey & subKey, "DisplayName", value)
                If ret <> 0 Then stdRegProv.GetStringValue HKLM, regKey & subKey, "QuietDisplayName", value
                If value = "Google Chrome" Then
                    Dim chromePath, chromeVersion
                    stdRegProv.GetStringValue HKLM, regKey & subKey, "InstallLocation", chromePath
                    stdRegProv.GetStringValue HKLM, regKey & subKey, "Version", chromeVersion
                    If Not (IsNull(chromePath) Or IsNull(chromeVersion)) Then
                        chromePath = chromePath & "\chrome.exe"
                        If CreateObject("Scripting.FileSystemObject").FileExists(chromePath) Then
                            If chromeVersion <> "" Then
                                value = Split(chromeVersion, ".", 2)(0)
                                If IsNumeric(value) Then
                                    chromeVersion = CLng(value)
                                    If chromeVersion >= 59 Then
                                        getChromePath = chromePath
                                        Exit Function
                                    End If
                                End If
                            End If
                        End If
                    End If
                End If
            Next
        End If
    Next

End Function

Upvotes: 2

Related Questions