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

输入歌名自动会自动联想歌名

读取音乐地址时，背景变暗不可操作

同步LRC歌词显示，

用户可自己进行扩展，整合音乐站
screen.width-333)this.width=screen.width-333" border=0>

screen.width-333)this.width=screen.width-333" border=0>

screen.width-333)this.width=screen.width-333" border=0>
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
%>

在线演示https://www.jb51.net/demo/mp4/index.html
本地下载