Reputation: 41
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 & "¢er=" & 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
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 & "¢er=" & 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
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 & "¢er=" & 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