caiji.asp 盘锦DJ舞曲网商业版源码程序 - ASP源码程序

www.gusucode.com > 盘锦DJ舞曲网商业版源码程序 > admin/caiji/caiji.asp
    <!--#include file="../../conn.asp"-->
<%
On Error Resume Next
Server.ScriptTimeOut=9999999
Function getHTTPPage(Path)
        t = GetBody(Path)
        getHTTPPage=BytesToBstr(t,"GB2312")
End function 
Function GetBody(url) 
        on error resume next
        Set Retrieval = CreateObject("Microsoft.XMLHTTP") 
        With Retrieval 
        .Open "Get", url, False, "", "" 
        .Send 
        GetBody = .ResponseBody
        End With 
        Set Retrieval = Nothing 
End Function

Function BytesToBstr(body,Cset)
        dim objstream
        set objstream = Server.CreateObject("adodb.stream")
        objstream.Type = 1
        objstream.Mode =3
        objstream.Open
        objstream.Write body
        objstream.Position = 0
        objstream.Type = 2
        objstream.Charset = Cset
        BytesToBstr = objstream.ReadText 
        objstream.Close
        set objstream = nothing
End Function

Function Newstring(wstr,strng)
        Newstring=Instr(lcase(wstr),lcase(strng))
        if Newstring<=0 then Newstring=Len(wstr)
End Function

'Asp过滤Html代码

function htmllen(strHtml) 
     dim regex 
     Set regex = New RegExp 
         regex.Pattern = "<\/?[^>]*>" 
         regex.Global = True 
         regex.IgnoreCase = True 
         htmllen = regex.Replace(strHtml,"") 
         regex.Pattern = "\n" 
         regex.Global = True 
         regex.IgnoreCase = True 
         htmllen = regex.Replace(htmllen ,"") 
    Set regex = Nothing 
End function 
%>
<html>
<style type="text/css">
<!--
body,td,th {
	font-size: 12px;
	color:#0080BD;
	background-color:#EAF3FA;
}
-->
</style>
<body style="margin:0px;font-size:12px; color:#0080BD;">
<!-- 开始 -->    
<%
siteurl="http://www.111ttt.com"
classid=request("classid")
serverid=request("serverid")
surl=request("surl")
smin=request("smin")
smax=request("smax")
n=0
for j=smin to smax
url=replace(surl,"{id}",j)
wstr=getHTTPPage(url)
wstr=replace(wstr,"""","")
wstr=replace(wstr,VBcrlf,"")
'leen=len(wstr)
start=Newstring(wstr,"<form name=myform><ul>")
over=Newstring(wstr,"铃声</a></li></ul></div>")
body=mid(wstr,start,over-start)

cc=split(body,"铃声")
for i=lbound(cc) to ubound(cc)
'for i=0 to 1
minlen=len("><a href=")
musicurlmin=Newstring(cc(i),"><a href=")
musicurlmax=Newstring(cc(i)," target=c")
musicurl=mid(cc(i),musicurlmin+minlen,musicurlmax-musicurlmin-minlen)

murl=siteurl&musicurl
murlbody=getHTTPPage(murl)
murlbody=replace(murlbody,"""","")
murlbody=replace(murlbody,"'","")
murlbody=replace(murlbody,VBcrlf,"")
ulen=len("<param name=src value=")
ustart=Newstring(murlbody,"<param name=src value=")
uover=Newstring(murlbody,"><param name=CONTROLS ")
ustr=mid(murlbody,ustart+ulen,uover-ustart-ulen)
ustr1=left(ustr,instr(8,ustr,"/",0)-1)&"/"
uurl=replace(ustr,ustr1,"")

minnamelen=len("target=c>")
musicnamemin=Newstring(cc(i),"target=c>")
musicnamemax=Newstring(cc(i),"</a></li><li class=gqst>")
musicname=mid(cc(i),musicnamemin+minnamelen,musicnamemax-musicnamemin-minnamelen)
musicname=replace(musicname,"111ttt","")
musicname=replace(musicname,"111TTT","")

set rs=server.createobject("adodb.recordset")
sql="select * from musiclist" 
rs.open sql,conn,1,3
rs.addnew
rs("classid")=classid
rs("serverid")=serverid
rs("musicpath")=uurl
rs("musicname")=musicname
rs("adddate")=date()
rs.update
n=n+1
'response.Write "<input type=""text"" name=""textfield"" value='"&musicname&""&uurl&"'/>"
response.Write "第"&n&"首歌曲　"&musicname&"　采集成功"&"<br>"
response.flush
next
next
response.Write "任务完成！"&n&"首歌曲采集成功！<font color=#ff0000>服务器地址是："&ustr1&"</font>"
%>
<!-- <textarea name="textarea" cols="130" rows="35"></textarea>-->
<!-- 结束 -->
</body></html>