使用來自siriusxm.com的XHR進行網頁掃描

Question

我需要從http://www.siriusxm.com/siriusxmhits1中拉出當前播放的藝術家和歌曲。我可以通過Internet Explorer瀏覽到這個網站，但這需要很長時間，所以我嘗試使用WINHTTP.WinHTTPRequest.5.1和MSXML2.serverXMLHTTP，但都沒有提取我正在尋找的特定數據。我覺得我很接近，但是錯過了一些東西。

下面是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> 

這裏是我當前的代碼：

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有一種A PI可用。我瀏覽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模塊導入JSON處理的VBA項目。

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 

順便說一句，在this，this和this答案使用相同的方法。