输入歌名自动会自动联想歌名
读取音乐地址时，背景变暗不可操作
同步LRC歌词显示，
用户可自己进行扩展，整合音乐站
![[asp]天枫AJAX百度音乐即时听附下载_第1张图片](http://img.e-com-net.com/image/info11/22b6fe9672d84f6eb4bff4917554d028.jpg)
![[asp]天枫AJAX百度音乐即时听附下载_第2张图片](http://img.e-com-net.com/image/info11/227f221c8a2f4dd89c76c190400d44bf.jpg)
![[asp]天枫AJAX百度音乐即时听附下载_第3张图片](http://img.e-com-net.com/image/info11/7275afcf17c5448990f759798ea8e86d.jpg)
mp3.asp
复制代码 代码如下:
<%@ 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))&"
")
'Next
Randomize
i=Int(rnd()*urls.count)
If Len(urls(i))<30 Then i=Int(rnd()*urls.count)
url=mp3url(urls(i))
geturl="
"&mplay(url)&"
点击鼠标右键－目标另存为下载歌曲"
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"
"
echo""
echo""
echo""
echo""
echo""
echo""
echo""
echo""
echo""
echo""
echo""
echo""
echo""
echo""
echo""
echo""
echo""
End Function
Sub Getlrc(songname)
echo" "
echo"
"
echo""
echo""
echo""
echo"歌词:点击下载LRC歌词"
echo"
"
echo""
echo" |
"
echo" |
"
echo" |
"
echo""
echo""
echo"|
"
echo""
echo"
"
echo""
echo""
echo" | "
echo" | "
echo""
echo" "
echo"
"
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
%>
