json - Extraer ubicaciones de datos del mapa

vba google-maps

Question

Quiero extraer datos de un mapa y luego obtener y almacenar las ubicaciones de todas las estaciones de carga en un estado específico. (por ejemplo: https://www.plugshare.com/ )

¿Cómo se puede hacer esto? No me importa usar ningún lenguaje de programación, pero ¿cuál es el mejor para esta aplicación?

Answer 1

Puede recuperar los datos directamente desde https://www.plugshare.com/ con XHR. Debe analizar un poco cómo funciona un sitio web para raspar los datos. Para cualquier dato cargado dinámicamente, simplemente inspeccione los XHR que hace la página web, encuentre el que contiene los datos relevantes, haga el mismo XHR (ya sea que el sitio proporcione API o no) y analice la respuesta. Navegue por la página, por ejemplo, en Chrome, luego abra la ventana Herramientas para desarrolladores ( F12 ), pestaña Red, vuelva a cargar la página F5 y examine los XHR en la lista.

Hay una de las solicitudes para URL https://www.plugshare.com/api/locations/region?... que devuelve latitud, longitud y otra información para estaciones de carga en un área de ventana rectangular con coordenadas especificadas. Puede encontrar URL, parámetros de consulta y algunos encabezados necesarios como se muestra a continuación:

La respuesta está en formato JSON:

Debe agregar un encabezado de autorización básico para solicitar. Para recuperar las credenciales, vaya a la pestaña Fuentes, agregue XHR Breakpoint para que la URL contenga https://www.plugshare.com/api/locations/region , vuelva a cargar la página F5 , cuando la página esté en pausa en XHR, siga el marco Pila de llamadas marco:

Omita cualquier objeto NREUM y nrWrapper que forme parte de la funcionalidad New Relic . Haga clic en pretty-print {} para formatear la fuente. Busque, por ejemplo, Basic , Authorization o setRequestHeader en las fuentes, para ese caso particular, la primera coincidencia se encuentra en https://www.plugshare.com/js/main.js?_=1 :

Haga clic en una estación en el mapa y aparecerá un XHR más con URL como https://www.plugshare.com/api/locations/[id] con información detallada para esa estación, como se muestra a continuación:

La respuesta también está en formato JSON:

También puede obtener datos de estaciones de URL como https://www.plugshare.com/api/stations/[id] .

Puede usar el siguiente código de VBA para recuperar información como se describe anteriormente. Importe el módulo JSON.bas al proyecto VBA para el procesamiento JSON.

Option Explicit

Sub Test_www_plugshare_com()

    Const Transposed = False '' Output option
    Const Detailed = True '' Scrape option

    Dim sResponse As String
    Dim aQryHds()
    Dim oQuery As Object
    Dim sQuery As String
    Dim vRegionJSON
    Dim sState As String
    Dim aResult()
    Dim i As Long
    Dim vLocationJSON
    Dim aRows()
    Dim aHeader()

    '' Retrieve auth token
    XmlHttpRequest "GET", "https://www.plugshare.com/js/main.js?_=1", "", "", "", sResponse
    With RegExMatches(sResponse, "var s/=""(Basic [^""]*)"";")  '' var s="Basic *";
        If .Count > 0 Then
            aQryHds = Array( _
                Array("Authorization", .Item(0).SubMatches(0)), _
                Array("Accept", "application/json") _
            )
        Else
            MsgBox "Can''t retrieve auth token"
            Exit Sub
        End If
    End With
    '' Set query parameters
    Set oQuery = CreateObject("Scripting.Dictionary")
    With oQuery
        .Add "minimal", "1"
        .Add "count", "500"
        .Add "latitude", "19.697593650121235"
        .Add "longitude", "-155.06529816792295"
        .Add "spanLng", "0.274658203125"
        .Add "spanLat", "0.11878815323507652"
        .Add "access", "1,3"
        .Add "outlets", "[{""connector"":1},{""connector"":2},{""connector"":3},{""connector"":4},{""connector"":5},{""connector"":6,""power"":0},{""connector"":6,""power"":1},{""connector"":7},{""connector"":8},{""connector"":9},{""connector"":10},{""connector"":11},{""connector"":12},{""connector"":13},{""connector"":14},{""connector"":15}]"
        .Add "fast", "add"
    End With
    sQuery = EncodeQueryParams(oQuery)
    '' Retrieve a list of stations for the viewport
    XmlHttpRequest "GET", "https://www.plugshare.com/api/locations/region?" & sQuery, aQryHds, "", "", sResponse
    '' Parse JSON response
    JSON.Parse sResponse, vRegionJSON, sState
    If sState <> "Array" Then
        MsgBox "Invalid JSON response"
        Exit Sub
    End If
    '' Populate result array
    ReDim aResult(UBound(vRegionJSON))
    '' Extract selected properties from parsed JSON
    For i = 0 To UBound(aResult)
        Set aResult(i) = ExtractKeys(vRegionJSON(i), Array("id", "name", "latitude", "longitude"))
        DoEvents
    Next
    If Detailed Then
        '' Populate result array with detailed info for each location
        For i = 0 To UBound(aResult)
            '' Retrieve detailed info for each location
            XmlHttpRequest "GET", "https://www.plugshare.com/api/locations/" & aResult(i)("id"), aQryHds, "", "", sResponse
            '' Parse JSON response
            JSON.Parse sResponse, vLocationJSON, sState
            If sState = "Object" Then
                '' Extract selected properties from parsed JSON
                Set aResult(i) = ExtractKeys(vLocationJSON, Array("reverse_geocoded_address", "hours", "phone", "description"), aResult(i))
            End If
            DoEvents
        Next
    End If
    '' Convert resulting array to arrays for output
    JSON.ToArray aResult, aRows, aHeader
    '' Output
    With ThisWorkbook.Sheets(1)
        .Cells.Delete
        If Transposed Then
            Output2DArray .Cells(1, 1), WorksheetFunction.Transpose(aHeader)
            Output2DArray .Cells(1, 2), WorksheetFunction.Transpose(aRows)
        Else
            OutputArray .Cells(1, 1), aHeader
            Output2DArray .Cells(2, 1), aRows
        End If
        .Columns.AutoFit
    End With
    MsgBox "Completed"

End Sub

Sub XmlHttpRequest(sMethod As String, sUrl As String, arrSetHeaders, sFormData, sRespHeaders As String, sContent As String)

    Dim arrHeader

    ''With CreateObject("Msxml2.ServerXMLHTTP")
    ''    .SetOption 2, 13056 '' SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS
    With CreateObject("MSXML2.XMLHTTP")
        .Open sMethod, sUrl, False
        If IsArray(arrSetHeaders) Then
            For Each arrHeader In arrSetHeaders
                .SetRequestHeader arrHeader(0), arrHeader(1)
            Next
        End If
        .send sFormData
        sRespHeaders = .GetAllResponseHeaders
        sContent = .responseText
    End With

End Sub

Function RegExMatches(sText, sPattern, Optional bGlobal = True, Optional bMultiLine = True, Optional bIgnoreCase = True) As Object

    With CreateObject("VBScript.RegExp")
        .Global = bGlobal
        .MultiLine = bMultiLine
        .IgnoreCase = bIgnoreCase
        .Pattern = sPattern
        Set RegExMatches = .Execute(sText)
    End With

End Function

Function EncodeQueryParams(oParams As Object) As String

    Dim aParams
    Dim i As Long

    aParams = oParams.Keys()
    For i = 0 To UBound(aParams)
        aParams(i) = EncodeUriComponent((aParams(i))) & "=" & EncodeUriComponent((oParams(aParams(i))))
    Next
    EncodeQueryParams = Join(aParams, "&")

End Function

Function EncodeUriComponent(strText As String) As String

    Static objHtmlfile As Object

    If objHtmlfile Is Nothing Then
        Set objHtmlfile = CreateObject("htmlfile")
        objHtmlfile.parentWindow.execScript "function encode(s) {return encodeURIComponent(s)}", "jscript"
    End If
    EncodeUriComponent = objHtmlfile.parentWindow.encode(strText)

End Function

Function ExtractKeys(oSource, aKeys, Optional oTarget = Nothing) As Object

    Dim vKey

    If oTarget Is Nothing Then Set oTarget = CreateObject("Scripting.Dictionary")
    For Each vKey In aKeys
        If oSource.Exists(vKey) Then
            If IsObject(oSource(vKey)) Then
                Set oTarget(vKey) = oSource(vKey)
            Else
                oTarget(vKey) = oSource(vKey)
            End If
        End If
    Next
    Set ExtractKeys = oTarget

End Function

Sub OutputArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Sub Output2DArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize( _
                UBound(aCells, 1) - LBound(aCells, 1) + 1, _
                UBound(aCells, 2) - LBound(aCells, 2) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Cambie a Const Detailed = False si tiene muchos elementos para salida para evitar que la aplicación se bloquee, ya que los XHR están en modo síncrono. La salida para mí con coordenadas de ventana gráfica especificadas es la siguiente:

Por cierto, el mismo enfoque utilizado en this , this , this , this , this y this responde.