Извлечь данные местоположения из карты
Я хочу извлечь данные из карты, затем получить и сохранить местоположения всех зарядных станций в определенном состоянии. (например: https://www.plugshare.com/)
Как это может быть сделано? Я не против использования какого-либо языка программирования, но какой из них лучше всего подходит для этого приложения?
1 ответ
Вы можете получить данные непосредственно с https://www.plugshare.com/ с помощью XHR. Вам нужно немного разобраться, как работает веб-сайт для очистки данных. Для любых динамически загружаемых данных вы просто проверяете XHR, которые делает веб-страница, найдите тот, который содержит соответствующие данные, создайте тот же XHR (либо сайт предоставляет API, либо нет) и проанализируйте ответ. Перейдите на страницу, например, в Chrome, затем откройте окно "Инструменты разработчика" (F12), вкладку "Сеть", перезагрузите страницу F5 и изучите XHR в списке.
Есть один из запросов на URL https://www.plugshare.com/api/locations/region?... которая возвращает широту, долготу и другую информацию для зарядных станций в области просмотра прямоугольника с указанными координатами. Вы можете найти URL, параметры запроса и некоторые необходимые заголовки, как показано ниже:
Ответ в формате JSON:
Вам необходимо добавить базовый заголовок авторизации для запроса. Чтобы получить учетные данные, перейдите на вкладку "Источники" и добавьте точку останова XHR для URL-адреса. https://www.plugshare.com/api/locations/regionперезагрузите страницу F5, когда страница приостановлена в XHR, следуйте кадрам стека вызовов кадр за кадром:
Пропустить любой NREUM а также nrWrapper объекты, которые являются частью функциональности New Relic. Нажмите pretty-print {} для форматирования источника. Поиск например Basic, Authorization или же setRequestHeader в источниках, для этого конкретного случая первое совпадение найдено в https://www.plugshare.com/js/main.js?_=1:
Нажмите на станцию на карте, и вы получите еще один XHR с URL, например https://www.plugshare.com/api/locations/[id] с подробной информацией для этой станции, как показано ниже:
Ответ также в формате JSON:
Также вы можете получить данные для станций с URL, как https://www.plugshare.com/api/stations/[id],
Вы можете использовать приведенный ниже код VBA для получения информации, как описано выше. Импортируйте модуль JSON.bas в проект VBA для обработки 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
Изменить на Const Detailed = False если у вас есть много элементов для вывода, чтобы предотвратить зависание приложения, так как XHR находятся в синхронном режиме. Вывод для меня с указанными координатами области просмотра выглядит следующим образом:
Кстати, тот же самый подход, использованный в этом, этом, этом, этом, этом и этом ответах.