html - Raspado web usando XHR de siriusxm.com

vba excel-vba

Question

Necesito obtener el artista y la canción que se está reproduciendo actualmente en http://www.siriusxm.com/siriusxmhits1 . Puedo hacer que esto funcione al navegar por el sitio web con Internet Explorer, pero lleva demasiado tiempo, así que he intentado usar WINHTTP.WinHTTPRequest.5.1 y MSXML2.serverXMLHTTP pero ninguno MSXML2.serverXMLHTTP los datos específicos que estoy buscando. Creo que estoy cerca pero me falta algo.

A continuación se muestra el fragmento de HTML:

<div id="on-the-air-content" style="display: block;">
    <div class="module-content theme-color-content-bg clearfix">
        <div id="onair-pdt" style="display: block;">
            <img alt="" src="//www.siriusxm.com/albumart/Live/2000/chainsmokers_58C328AC_t.jpg">
            <p class="onair-pdt-artist">Chainsmokers/Coldplay</p>
            <p class="onair-pdt-song">Something Just Like This</p>
        </div>
        ...
    </div>
    ...
</div>

Aquí está mi código actual:

Sub GetData()

    Dim getArtist As Object
    Dim getSong As Object

    Set xmHtml = New HTMLDocument
    With CreateObject("WINHTTP.WinHTTPRequest.5.1")
        .Open "GET", "http://www.siriusxm.com/siriusxmhits1", False
        .send
        xmHtml.body.innerHTML = .responseText
    End With
    Set getArtist = xmHtml.getElementById("onair-pdt").getElementsByTagName("p")(0)
    MsgBox (getArtist.innerText)
    Set getSong = xmHtml.getElementById("onair-pdt").getElementsByTagName("p")(1)
    MsgBox (getSong.innerText)

End Sub

Si activo Internet Explorer, funcionará con el siguiente código, pero eso toma demasiado tiempo para lo que necesito hacer:

Sub GetData()

    Dim DivID As HTMLObjectElement
    Dim getArtist As Variant
    Dim getSong As Variant

    URL = "http://www.siriusxm.com/siriusxmhits1"
    With IExplore
        .Navigate URL
        .Visible = False
        Do While .readyState <> 4: DoEvents: Loop
        Set doc = .document
        Set DivID = doc.getElementById("onair-pdt")
        getArtist = DivID.getElementsByClassName("onair-pdt-artist")(0).innerText
        getSong = doc.getElementsByClassName("onair-pdt-song")(0).innerText
    End With

End Sub

Answer 1

El sitio web http://www.siriusxm.com tiene una especie de API disponible. Navegué una página por el enlace http://www.siriusxm.com/hits1 en Chrome, luego abrí la ventana Herramientas para desarrolladores ( F12 ), la pestaña Red y examiné los XHR en la lista. La información de la canción actual se puede recuperar, por ejemplo, en los siguientes pasos:

• Haga XHR por URL http://www.siriusxm.com/sxm_date_feed.tzi para recuperar la marca de tiempo actual.

• Haga XHR usando la marca de tiempo actual en los últimos números de URL http://www.siriusxm.com/metadata/pdt/en-us/json/channels/siriushits1/timestamp/04-29-02:02:55

• Parse recibió la respuesta de JSON.

• Obtenga el nombre de la canción como JSON.channelMetadataResponse.metaData.currentEvent.song.name , artistas como JSON.channelMetadataResponse.metaData.currentEvent.artists.name , etc.

A continuación se muestra el ejemplo que muestra la estructura de respuesta JSON. Utilizo la herramienta en línea http://jsonviewer.stack.hu :

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_siriusxm_com()

    Dim s As String
    Dim d As Date
    Dim sUrl As String
    Dim vJSON As Variant
    Dim sState As String
    Dim sArtists As String
    Dim sComposer As String
    Dim sAlbum As String
    Dim sSong As String

    '' Retrieve timestamp
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "http://www.siriusxm.com/sxm_date_feed.tzi", False
        .send
        s = .responseText
    End With
    '' Parse timestamp to Date type
    d = CDate(DateSerial(Mid(s, 5, 4), Mid(s, 3, 2), Mid(s, 1, 2)) + TimeSerial(Mid(s, 9, 2), Mid(s, 11, 2), Mid(s, 13, 2)))
    '' Add 4 hours to get UTC from EDT timezone
    d = DateAdd("h", 4, d)
    '' Combine URL with timestamp
    sUrl = "http://www.siriusxm.com/metadata/pdt/en-us/json/channels/siriushits1/timestamp/" & _
            LZ(Month(d), 2) & "-" & _
            LZ(Day(d), 2) & "-" & _
            LZ(Hour(d), 2) & ":" & _
            LZ(Minute(d), 2) & ":" & _
            "00"
    '' Retrieve channelMetadataResponse JSON data
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", sUrl, False
        .send
        s = .responseText
    End With
    '' Parse JSON response
    JSON.Parse s, vJSON, sState
    '' Check if valid
    If sState <> "Object" Then
        MsgBox "Invalid JSON response"
        Exit Sub
    End If
    '' Check if available
    If vJSON("channelMetadataResponse")("messages")("code") <> "100" Then
        MsgBox "Unavailable content"
        Exit Sub
    End If
    '' Get necessary properties
    Set vJSON = vJSON("channelMetadataResponse")("metaData")("currentEvent")
    sArtists = vJSON("artists")("name")
    sComposer = vJSON("song")("composer")
    sAlbum = vJSON("song")("album")("name")
    sSong = vJSON("song")("name")
    '' Output results
    MsgBox "On the Air" & vbCrLf & _
        "Artists: " & sArtists & vbCrLf & _
        "Composer: " & sComposer & vbCrLf & _
        "Album: " & sAlbum & vbCrLf & _
        "Song: " & sSong

End Sub

Function LZ(n As String, q As Long) As String '' Add leading zeroes
    LZ = Right(String(q, "0") & n, q)
End Function

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