使用来自siriusxm.com的XHR进行网页扫描


1

我需要从http://www.siriusxm.com/siriusxmhits1中拉出当前播放的艺术家和歌曲。我可以通过Internet Explorer浏览到这个网站,但这需要很长时间,所以我尝试使用WINHTTP.WinHTTPRequest.5.1MSXML2.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 
0

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

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

JSON response

您可能如上所述,使用下面的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 

顺便说一句,在thisthisthis答案使用相同的方法。

  0

谢谢omegastripes。我添加了json.bas和所有适当的引用。我有一个问题,行JSON.Parse s,vJSON,sState我得到的错误说:“编译错误:错误数量的参数或无效的属性分配”当我去json.bas文件中的解析函数,它看起来就像它只查找一个字符串,在这种情况下是变量s。如果我更改为“JSON.Parse s”,我可以让它运行,但sState从未分配一个值,并在接下来的几行中退出。如果我跳过该语句,尝试设置vJSON时会出现“类型不匹配”错误。谢谢。 30 4月. 172017-04-30 19:19:28

  0

@ mh2017我贴的JSON.bas的链接是错误的,我编辑了答案,请检查链接。 01 5月. 172017-05-01 07:11:38

  0

是的,它做到了。谢谢您的意见。实际上你教了我很多。 02 5月. 172017-05-02 18:26:33