वेब खरोंच siriusxm.com से एक्सएचआर का उपयोग कर

वोट
1

मैं से वर्तमान में चल रहे कलाकार और गीत को खींचने के लिए की जरूरत है http://www.siriusxm.com/siriusxmhits1 । मैं इस इंटरनेट एक्सप्लोरर के साथ वेबसाइट के लिए नेविगेट काम करने के लिए प्राप्त कर सकते हैं, लेकिन यह बहुत समय लगता है तो मैं का उपयोग कर की कोशिश की है 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

मैं इंटरनेट एक्सप्लोरर को सक्रिय करते हैं यह निम्नलिखित कोड का उपयोग कर काम करेंगे, लेकिन है कि मैं क्या करने की जरूरत है के लिए बहुत समय लगता है:

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
09/04/2017 को 20:34
का स्रोत उपयोगकर्ता
अन्य भाषाओं में...                            


1 जवाब

वोट
0

वेबसाइट http://www.siriusxm.com एक API उपलब्ध का एक प्रकार है। मैं कड़ी से एक पेज नेविगेट http://www.siriusxm.com/hits1 क्रोम में डेवलपर उपकरण विंडो (, तो खोला F12), नेटवर्क टैब, और सूची में XHRs की जांच की। वर्तमान गीत की जानकारी प्राप्त किए जा सकें निम्न चरणों में जैसे:

  • यूआरएल द्वारा एक्सएचआर बनाओ http://www.siriusxm.com/sxm_date_feed.tzi वर्तमान टाइमस्टैम्प पुनः प्राप्त करने के।

  • बनाओ यूआरएल के अंतिम संख्या में वर्तमान टाइमस्टैम्प का उपयोग कर एक्सएचआर http://www.siriusxm.com/metadata/pdt/en-us/json/channels/siriushits1/timestamp/04-29-02:02:55

  • पार्स JSON प्रतिक्रिया मिली है।

  • के रूप में गीत का नाम मिलता है JSON.channelMetadataResponse.metaData.currentEvent.song.name, के रूप में कलाकारों JSON.channelMetadataResponse.metaData.currentEvent.artists.name, आदि

नीचे JSON उत्तर संरचना को दर्शाता है नमूना है, मैं ऑनलाइन उपकरण का उपयोग http://jsonviewer.stack.hu :

JSON उत्तर

यदि आपने ऊपर बताए जानकारी प्राप्त करने में नीचे 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

Btw, एक ही दृष्टिकोण में इस्तेमाल इस , यह और यह जवाब।

29/04/2017 को 02:28
का स्रोत उपयोगकर्ता

Cookies help us deliver our services. By using our services, you agree to our use of cookies. Learn more