<!-- #include File="conn.asp" -->
<!-- #include file = "Cls_AspHttp.asp" -->
<!-- #include File="function_www_888wang_com.asp" -->
<!-- #include File="888wang.com_url.asp" -->
<!-- #include File="function.asp" -->
<%CheckAdmin3%>
<%
			
			Dim DoGet
			Dim sCookie
			Dim sUserAgent
			Set DoGet = New FlyCms_AspHttp
		cookieServer = "http://dj.dj400.com/hi.htm"
	    TempStr = HttpGet(100000,100000,200000,200000,"GET",cookieServer,"","","","zh-cn","application/x-www-form-urlencoded","Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)","gzip, deflate","*/*","gb2312")

	    'TempStr = GetBody(TempStr, "document.cookie=""", """;", False, False)
	    'sCookie = TempStr
	   sUserAgent = "NSPlayer/10.0.0.3997 WMFSDK/10.0"	'这句模拟Media Player身份
'技术支持 www.888wang.com
'此程序为www.888wang.com 提供，如发现乱传播，将取消所有技术支持，追究责任，后果自负.

Dim StarPage,EndPage,Co,Msg,Fid,ID
dim mp3save,picsave
Server.ScriptTimeOut=99999
StarPage=Request("StarPage")
EndPage=Request("EndPage")
mp3save=Request("mp3save")
picsave=Request("picsave")
auto=Request("auto")

ID=EndPage
Co=Request("Co")
If Co="" or Not IsNumeric(Co) Then Co=1
If StarPage="" or Not IsNumeric(StarPage) Or EndPage="" Or Not IsNumeric(EndPage) Then
   Response.write "您输入的ID参数有错误<br><A HREF=# onclick=""Javascript:history.back(-1)""><FONT  COLOR=#FF0000>请点这里返回</FONT></A>"
   Response.End
ElseIf (StarPage-EndPage)<0 Then
   Response.write "您输入的起始ID小于结束ID<br><A HREF=# onclick=""Javascript:history.back(-1)""><FONT  COLOR=#FF0000>请点这里返回</FONT></A>"
   Response.End
End If
If StarPage=EndPage Then
   Msg="你所请求的功能已经完成,谢谢使用<a href=http://www.888wang.com target=_blank>888网</a>的采集系统!<p>为站长们提供源动力<br>网站程序:<a href=http://www.888wang.com target=_blank>音乐 FLASH  MTV  小游戏  DJ  美女图片 墙纸.</a><br>联系QQ：56566918 电话020-85668247 手机:15918529718<br>良好售后服务，终身技术支持咨询，免费升级!!<p>"
   MusicMake
	Response.Write("<p><font color=0033ff><h2>采集完成<h2></font>")
   '采集完成，转至生成播放页]
    if auto ="yes" then
		Response.Write("<p><font color=0033ff>您使用的是《一键采集并生成》，3秒后转至生成播放页</font>")
		Response.write "<meta http-equiv=""refresh"" content=""3;url='Make_playall_all.asp?auto=yes'"">"
		Response.End
 	end if 
Else
   Msg="正在取得远程HTML中,请等待......<br>"
   MusicMake
   MakeNextPage
End IF

Sub MusicMake
Response.write "<HTML>"
Response.write "<HEAD>"
Response.write "<TITLE>全自动歌曲采集&下载在本地 版本号：www.x0746.com</TITLE>"
Response.write "<META http-equiv=Content-Type content=""text/html; charset=gb2312"">"
Response.write "<META content=""MSHTML 6.00.2800.1400"" name=GENERATOR>"
Response.write "</HEAD>"
Response.write "<BODY text=#000000 bgColor=#ffffff leftMargin=0 topMargin=0 marginheight=0 marginwidth=0>"
Response.write "<b><font color=#FF0000>"&StarPage&"</font>/<font color=#FF0000>"&EndPage&"</font>"
Response.write Msg&"</b>"
Response.write "<IE:Download ID=""oDownload"" STYLE=""behavior:url(#default#download)"" />"
MakeIMG
End Sub

'采集过程开始
Sub MakeIMG
Dim k:k=0
'on error resume next 
Response.write "<table border=0 width=100% height=300 align=center><tr>"
Response.write  "<td width=80% height=200 valign=top>"
URL="http://www.dj400.com/dj/"&ID&".htm"
response.write url&"<br>"
'on error resume next 

zlp=GetHttp(URL)
zlp=Replace(Replace(zlp,Chr(34),""),Chr(39),"")'过滤"
'如果此专辑为空，则跳过
if len(zlp)<1088 then
Response.Write("888wang.com提醒您：此ID数据为空，跳至采集下一数据")
Response.write "<meta http-equiv=""refresh"" content=""0;url='888wamg.com_musiccj.asp?auto="&auto&"&mp3save="&mp3save&"&picsave="&picsave&"&StarPage="&StarPage&"&EndPage="&EndPage+1&"&Co="&Co+1&"'"">"
Response.End
end if

dim mp3url,mp3name,mp3type
'body=GetStr(zlp,"试听本歌手的所有歌曲","value=反")
body=GetStr(zlp,"/2009/play.css","id=lyric>")
	mp3name=fixdata(GetStr(body,"play_title>","</a>"))

	'numTemp=len(bodyText)-InstrRev(bodyText,chr(40))
 	'mp3type=trim(left(Right(bodyText,numTemp),numTemp-1))
	
	mp3url="mix/"&trim(GetStr(body,"|mix/","|"))

'写入sclass表，歌手分类
'on error resume next 
'当没有的情况下，新增

'与dj19类一样
' if mp3type="国外舞曲" then
' 	mp3type="英文舞曲"
' end if
' 
' if mp3type="现场串烧" then
' 	mp3type="现场舞曲"
' end if
 '与dj19一起结束
 
'set rs=server.CreateObject("ADODB.RecordSet")
'Sql="Select * From SClass Where SClass='"&mp3type&"'"
'Rs.Open Sql,Conn,1,3
'		If Rs.Eof And Rs.Bof Then
'		Rs.AddNew
'		End If
'	rs("SClass")=mp3type
'	rs("Classid")=1
'	Rs.Update
'	Rs.Close
'
'获得刚写入的歌手分类ID
'Set rsc = Conn.Execute("select * from SClass where SClass='"&mp3type&"'")
'	SClassID=rsc("SClassID")
'	rsc.close
'	set rsc=Nothing

 
'写入音乐表
'当没有的情况下，新增
'^[\u0391-\uFFE5]
If mp3name<>"" then
set rs=server.CreateObject("ADODB.RecordSet")
Sql="Select * From MusicList Where wma='"&mp3url&"'"

Rs.Open Sql,Conn,1,3
		If Rs.Eof And Rs.Bof Then
		Rs.AddNew
		Response.Write("正在写入数据库信息..<br/>")
		End If
	rs("Classid")=1
	'rs("SClassid")=SClassID
	rs("SClassid")=1 '无分类默认为1
	rs("MusicName")=mp3name
	rs("Wma")=mp3url
	rs("hits")=0
	rs("IsGood")=0
	rs("addDate")=now()
	
	if RegExpTest("^[\u0391-\uFFE5]", mp3name) then
		rs("url")=1
	else
		rs("url")=2
	end if
	rs("getUrl")=ID
	Rs.Update
	Rs.Close
	

	
'采集完，写入采集的专辑ID

conn.execute("update MakeConfig set Mp3Get="&id&"")


'on error resume next 
Response.Write "<br>歌曲编号："&ID&"<br>"
response.flush
Response.Write "歌手分类："&mp3type&"<br>"
response.flush
Response.Write "歌曲名称："&mp3name&"<br>"
response.flush
Response.Write "歌曲路径："&mp3url&"<br>"
response.flush
Response.Write "[<font color=red>正在下载文件和添加数据，请耐心等待.....</font>]<br>"
response.flush

'是否下载音乐到本地
dim fldr,GetNewsFold
fldr=""
	mp3path=mp3url
	if mp3save="mp3save" then
		If CheckDir(mp3path)=false then 
			GetNewsFold=split(mp3path,"/")
				For i=0 to Ubound(GetNewsFold)-1
				
					if fldr="" then
					fldr=GetNewsFold(i)
					else
					fldr=fldr&"/"&GetNewsFold(i)
					end if
					If CheckDir(fldr)=false then
					call MakeNewsDir(fldr)
					End if
				next

		end if
				
			dim ttt8down
			ttt8down=""&getUrl&""&mp3path'数据下载路径，
			fldr="../musiccode/"&mp3path'数据保存文件夹，函数文件要相同
			Response.write fldr &"<br>"
			'下载数据
			Call SaveData(ttt8down, fldr, sCookie, sUserAgent, 1, 1)
			Set DoGet = Nothing
	end if
Response.write "<span id=last></span></td><td  valign=top><span id=showImport></span></td></tr></table>"
 End If
 
 set rs=nothing
 conn.close
 set conn=nothing
End Sub

'采集过程结束
Sub MakeNextPage
Response.write "<meta http-equiv=""refresh"" content=""0;url='888wamg.com_musiccj.asp?auto="&auto&"&mp3save="&mp3save&"&picsave="&picsave&"&StarPage="&StarPage&"&EndPage="&EndPage+1&"&Co="&Co+1&"'"">"
Response.write "</body>"
Response.write "</html>"
End Sub
'此程序为www.888wang.com 提供，如发现乱传播，将取消所有技术支持，追究责任，后果自负.

Function RegExpTest(patrn, strng) 
Dim regEx ' 建立变量。 
Set regEx = New RegExp ' 建立规范表达式。 
regEx.Pattern = patrn ' 设置模式。 
regEx.IgnoreCase = True ' 设置是否区分字母的大小写。 
regEx.Global = True ' 设置全程性质。 
RegExpTest = regEx.Test(strng) ' 执行搜索。 
End Function
%>


</body>
</html>




