使用来自 siriusxm.com 的 XHR 进行网络抓取

Question

我需要从http://www.siriusxm.com/siriusxmhits1 中提取当前正在播放的艺术家和歌曲。我可以使用 Internet Explorer 导航到该网站，但这需要很长时间，所以我尝试使用 WINHTTP.WinHTTPRequest.5.1 和 MSXML2.serverXMLHTTP 但都没有提取我正在寻找的特定数据。我想我已经很接近了，但我错过了一些东西。

下面是 HTML sn-p:

<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>

这是我当前的代码：

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

如果我激活 Internet Explorer，它将使用以下代码工作，但这对于我需要做的事情来说太长了：

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

http://www.siriusxm.com 网站有一种可用的 API。我在 Chrome 中通过链接 http://www.siriusxm.com/hits1 浏览了一个页面，然后打开了开发者工具窗口 (F12)、网络选项卡，并检查了列表中的 XHR。可以检索当前歌曲信息 e。 G。在以下步骤中：

• 通过 URL http://www.siriusxm.com/sxm_date_feed.tzi 制作 XHR 以检索当前时间戳。

• 在 URL http://www.siriusxm.com/metadata/pdt/en-us/json/channels/siriushits1/timestamp/04-29-02:02:55的最后一个数字中使用当前时间戳制作 XHR

• 解析收到的 JSON 响应。

• 获取歌曲名称为JSON.channelMetadataResponse.metaData.currentEvent.song.name，艺术家为JSON.channelMetadataResponse.metaData.currentEvent.artists.name等

下面是显示JSON响应结构的示例，我使用在线工具http://jsonviewer.stack.hu：

您可以使用下面的 VBA 代码来检索上述信息。 将JSON.bas 模块导入VBA 项目进行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

顺便说一句，类似的方法适用于in other answers。