[asp]天楓AJAX百度音樂即時(shí)聽附下載

%@ language="vbscript" CodePage="936"%>
%
response.charset="gb2312"
set regex = New regexp
regex.IgnoreCase=True
regex.Global=True
songname=unescape(query("songname"))
Select Case query("s")
   case"geturl":echo geturl(songname)
   case"suggest":echo suggest()
End select

Function geturl(songname)
    page=ajax("http://mp3.baidu.com/m?f=mstn=baidump3ct=134217728lf=rn=word="songname"lm=0","","","")
    regex.Pattern="(http)\S+\.(mp3)"
    Set urls= regex.execute(page)
    'For i=0 To urls.count-1
       'geturl=geturl(mp3url(urls(i))"br/>")
    'Next
    Randomize
    i=Int(rnd()*urls.count)
    If Len(urls(i))30 Then i=Int(rnd()*urls.count)
    url=mp3url(urls(i))
    geturl="div>"mplay(url)"a href="""url""">點(diǎn)擊鼠標(biāo)右鍵－目標(biāo)另存為下載歌曲a>/div>"
    Getlrc(songname)

End Function

Function mp3url(url)
    page=ajax("http://box.zhangmen.baidu.com/m?gate=1ct=134217728tn=baidumt,word=mp3,"url"lm=16777216","","","")
    regex.Pattern="(http)\S+\.(mp3)"
    Set urls= regex.execute(page)
    If urls.count>0 Then mp3url=urls(2)
End Function

Function mplay(fileUrl)
    echo"object classid=""CLSID:6BF52A52-394A-11d3-B153-00C04F79FAA6"" codebase=""http://activex.microsoft.com/activex/controls/mplayer/en/nsmp2inf.cab#Version=6,4,7,1112"" align=""baseline"" standby=""Loading Microsoft Windows Media Player components..."" type=""application/x-oleobject"" id=""mediaPlayerObj""  style=""width:300px;height:64px;border:1px solid #CCCCCC"">"
    echo"param name=""url"" value='"fileUrl"'>"
    echo"param name=""rate"" value=""10"">"
    echo"param name=""balance"" value=""0"">"
    echo"param name=""currentPosition"" value=""0"">"
    echo"param name=""playCount"" value=""1"">"
    echo"param name=""autoStart"" value=""-1"">"
    echo"param name=""volume"" value=""60"">"
    echo"param name=""currentMarker"" value=""0"">"
    echo"param name=""invokeURLs"" value=""-1"">"
    echo"param name=""stretchToFit"" value=""-1"">"
    echo"param name=""windowlessVideo"" value=""0"">"
    echo"param name=""enabled"" value=""-1"">"
    echo"param name=""enableContextMenu"" value=""0"">"
    echo"param name=""fullScreen"" value=""0"">"
    echo"param name=""enableErrorDialogs"" value=""0"">"
    echo"embed src="""fileUrl""" align=""baseline"" type=""application/x-mplayer2"" pluginspage="""" id=""mediaPlayerObj"" showcontrols=""1"" showpositioncontrols=""0"" showaudiocontrols=""1"" showtracker=""1"" showdisplay=""0"" showstatusbar=""1"" autosize=""0"" showgotobar=""0"" showcaptioning=""0"" autostart=""1"" autorewind=""0"" animationatstart=""0"" transparentatstart=""0"" allowscan=""1"" enablecontextmenu=""1"" clicktoplay=""0""  defaultframe=""datawindow"" invokeurls=""0"" style=""width:300px;height:68px;border:1px solid #FF0000"">/embed>"
    echo"/object>"
End Function

Sub Getlrc(songname)
    echo"div id=""lrcxx"" style=""display:none"">/div>" 
    echo"span id=""lrcdata"">"
    echo"!--"
     page=ajax("http://mp3.baidu.com/m?tn=baidump3lyricword="songname"ct=150994944lm=-1lf=3","","","")
    If InStr(page,"抱歉，沒有找到")>0 Then
        echo "沒有找到歌詞"
        lrcurl=""
    else
        regex.Pattern="(http://)\S+\.(lrc)"
        set lrcs=regex.Execute(page)
        lrcurl=lrcs(0)
        If lrcs.count>0 Then
            echo ajax(lrcurl,"","","")
        Else
            echo "沒有找到歌詞"
        End If
    End if
    echo"-->"
    echo"/span>"
    echo"div id=""bkk"">"
    echo"div id=""lrcstart"">歌詞:a href="""lrcurl""" target=""new"">點(diǎn)擊下載LRC歌詞/a>/div>"
    echo"div id=""lrcollbox"">"
    echo"table id=""lrcoll"" style=""position:relative;top:30px;width:100%;text-align:center"">"
    echo"tr>td>div id=""lrcwt1"">/div>/td>/tr>"
    echo"tr>td>div id=""lrcwt2"">/div>/td>/tr>"
    echo"tr>td>div id=""lrcwt3"">/div>/td>/tr>"
    echo"tr>td class=""kong"">"
    echo"table border=""0"" cellspacing=""0"" cellpadding=""0"">"
    echo"tr>td nowrap height=""30"">span id=""lrcbox"" style=""width:0;"">/span>/td>/tr>"
    echo"tr style=""position:relative; top: -30px; z-index:6;"">td nowrap height=""30"">span id=""lrcbc"" style=""overflow:hidden; width:0;"">/span>/td>"
    echo"/tr>"
    echo"/table>"
    echo"/td>/tr>"
    echo"tr style=""position:relative; top: -30px;"">td>div id=""lrcwt4"">/div>/td>/tr>"
    echo"tr style=""position:relative; top: -30px;"">td>div id=""lrcwt5"">/div>/td>/tr>"
    echo"/table>"
    echo"/div>"
    echo"/div>"
End Sub

Function Suggest()
   If Trim(query("songname"))>"" then     
       songname=Replace((query("songname")),"!","%")
       'Suggest=ajax("http://mp3.sogou.com/suggest/suggest.jsp?key="escape(query("songname"))"asc=1","","","UTF-8")
      Suggest=ajax("http://music.soso.com/wh.php?"songname,"","","")
   End if
End Function

Function Query(byval var)
    Query = request.form(var)
    if Query = "" then Query = request(var)
End Function

Function Echo(byval str)
    response.write str
End Function


Public Function AJAX(url,method,data,bm)
    If method="" Then method="get"
    If bm="" Then  bm="gb2312"
    dim http 
    Set http=Server.createobject("Microsoft.XMLHTTP") 
    Http.open method,url,false
    if LCase(method)="post" then
        Http.setrequestheader "content-length",len(data)
        Http.setrequestheader "content-type","application/x-www-form-urlencoded"
    end if
    Http.send(data) 
    if Http.readystate=4 and Http.status=200 then 
        AJAX=bytesToBSTR(Http.responseBody,"GB2312")
    end If
    set http=nothing 
End function

Public Function BytesToBstr(body,Cset)
    dim objstream
    set objstream = Server.CreateObject("ADODB"+"."+"Stream")
    with objstream
        .Type = 1
        .Mode =3
        .Open
        .Write body
        .Position = 0
        .Type = 2
        .Charset = Cset
        BytesToBstr = .ReadText 
        .Close
    end with
    set objstream = nothing
End Function

Set regex=Nothing
%>