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でページをナビゲートし、Developer Toolsウィンドウ（F12）、ネットワークタブを開いてリスト内のXHRを調べました。現在の曲情報を取得できます。e。 g。

• XHRをURL http://www.siriusxm.com/sxm_date_feed.tziで作成し、現在のタイムスタンプを取得します。

• 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などのアーティストを曲の名前を取得します。私はオンラインツールhttp://jsonviewer.stack.hu使用し、JSONレスポンス構造を示すサンプルです：あなたは

をします上記のVBAコードを使用して、上記の情報を取得します。 JSON.basモジュールをVBAプロジェクトにインポートしてJSON処理を行います。 BTW

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回答に使用したのと同じ手法。