[asp]天枫AJAX百度音乐即时听附下载

　　<%@ 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=ms&tn=baidump3&ct=134217728&lf=&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&""">点击鼠标右键－目标另存为下载歌曲<a></div>"

　　Getlrc(songname)

　　End Function

　　Function mp3url(url)

　　page=ajax("http://box.zhangmen.baidu.com/m?gate=1&ct=134217728&tn=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=baidump3lyric&word="&songname&"&ct=150994944&lm=-1&lf=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"">点击下载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

　　%>