📄 collecting.asp

📁 一款不错的影音视频网站源代码。asp的程序。后台有自动采集功能
💻 ASP
字号:
<%Server.ScriptTimeOut=9999%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3c.org/TR/1999/REC-html401-19991224/loose.dtd">
<HTML xmlns="http://www.w3.org/1999/xhtml">
<HEAD>
<TITLE>采集管理--雷风影视系统</TITLE>
<META http-equiv=Content-Type content="text/html; charset=gb2312">
<META content="MSHTML 6.00.3790.4275" name=GENERATOR>
<LINK href="../images/css_body.css" type=text/css rel=stylesheet>
</HEAD>
<BODY>
<!--#include file="../../inc/conn.asp"-->
<!-- #include file="collecting_function.asp" -->
<!--#include file="../../inc/page.asp"-->
<%
call login_check()
Colledt_ListNum=Request.QueryString("ListNum")
Colledt_MovieNum=Request.QueryString("MovieNum")
sb=Request.QueryString("sb")
cg=Request.QueryString("cg")
txt=""
ListEnd=0
if Colledt_ListNum="" then
	Colledt_ListNum=0
end if
if Colledt_MovieNum="" then
	Colledt_MovieNum=0
end if
if sb="" and cg="" then
	set rs=conn.execute("update "&web_dbtop&"collect set CollectTime=now() where id="&Request.QueryString("id"))
	sb=0
	cg=0
	call addlog("采集影片")
	session.abandon()
end if

Set rs = server.CreateObject("Adodb.RecordSet")
sql="select * from "&web_dbtop&"collect where id = "&Request.QueryString("id")
rs.open sql,conn,1,1
If not rs.Eof Then
	id=rs("id")
	CollectName=rs("CollectName")
	selEncoding=rs("selEncoding")
	ListPaingType=rs("ListPaingType")
	ListPaingStr=rs("ListPaingStr")
	ListPaingStr2=rs("ListPaingStr2")
	ListPaingID1=rs("ListPaingID1")
	ListPaingID2=rs("ListPaingID2")
	ListPaingStr3=rs("ListPaingStr3")
	SaveFiles=rs("SaveFiles")
	LsString=rs("LsString")
	LoString=rs("LoString")
	HsString=rs("HsString")
	HoString=rs("HoString")
	Htitle=rs("Htitle")
	Ftitle=rs("Ftitle")
	Hname=rs("Hname")
	Fname=rs("Fname")
	Htupian=rs("Htupian")
	Ftupian=rs("Ftupian")
	ClassType=rs("ClassType")
	CollectClass=rs("CollectClass")
	HClass=rs("HClass")
	FClass=rs("FClass")
	RegionType=rs("RegionType")
	CollectRegion=rs("CollectRegion")
	HRegion=rs("HRegion")
	FRegion=rs("FRegion")
	Hcontent=rs("Hcontent")
	Fcontent=rs("Fcontent")
	ScopeOn=rs("ScopeOn")
	Hscope=rs("Hscope")
	Fscope=rs("Fscope")
	Hweburl=rs("Hweburl")
	Fweburl=rs("Fweburl")
	UrlType=rs("urlType")
	Rurl=rs("Rurl")
	Reurl=rs("Reurl")
	Hpurl=rs("Hpurl")
	Fpurl=rs("Fpurl")
End If
rs.Close
Set rs=Nothing
Select Case ListPaingType
	Case 0 
		If Colledt_ListNum<1 Then
		ListUrl=ListPaingStr
		Else
		ListEnd=1
		End if
	Case 1,3
		 If (ListPaingID1+Colledt_ListNum)>ListPaingID2 Then
			ListEnd=1
		 Else
			ListUrl=Replace(ListPaingStr2,"{id}",(ListPaingID1+Colledt_ListNum))
		 End If
	Case 2
		  ListArray=Split(ListPaingStr3,vbcrlf)
		  If (Colledt_ListNum)>CInt(Ubound(ListArray)) Then
			 ListEnd=1
		  Else
			 ListUrl=ListArray(Colledt_ListNum)
		  End If  
End Select

if ListEnd=1then
	txt=""&txt&"采集完成"
	session.abandon()
	call connclose()
else
	MovieNumID=Colledt_MovieNum
	ListCode=GetHttp(ListUrl,selEncoding)
	if ListCode=False then
		call showerr("在获取:"&ListUrl&"网页源码时发生错误","collecting.asp")
	end if
	Select Case ListPaingType
	Case 3
		Colledt_ListNum=Colledt_ListNum+1
		NewsCode=ListCode
		UrlTest=ListUrl
	Case Else
		If Session(ID&Colledt_ListNum)="" Then
			ListCode=GetBody(ListCode,LsString,LoString)
			NewsArrayCode=GetArray(ListCode,HsString,HoString)
			If NewsArrayCode=False Then
				txt=txt&"<font color=red><b>在获取链接列表时出错</b></font>"
				sb=sb+1
			End If
			Session(ID&Colledt_ListNum)=NewsArrayCode
			Session(ID&Colledt_ListNum-1)=""
		End If
			NewsArray=Split(Session(ID&Colledt_ListNum),"$Array$")
			If CInt(Ubound(NewsArray))-MovieNumID<=0 Then
				Colledt_ListNum=Colledt_ListNum+1
				Colledt_MovieNum=0
			else
				Colledt_MovieNum=Colledt_MovieNum+1
			End If
		UrlTest=DefiniteUrl(NewsArray(MovieNumID),ListUrl)
		NewsCode=GetHttp(UrlTest,selEncoding)
	End Select
	If NewsCode=False then
		txt=txt&"<font color=red><b>在获取内容页时出错。</b></font>"
		sb=sb+1
	Else
		moviename=DelHtml(GetBody(NewsCode,Htitle,Ftitle))
		movieactor=DelHtml(GetBody(NewsCode,Hname,Fname))
		moviepic=DefiniteUrl(GetBody(NewsCode,Htupian,Ftupian),UrlTest)
		if ClassType=1 then
			typeidname=DelHtml(GetBody(NewsCode,HClass,FClass))
		else
			typeidname=showcontent("type","typename",CollectClass)
		end if
		if RegionType=1 then
			regionname=DelHtml(GetBody(NewsCode,HRegion,FRegion))
		else
			regionname=showcontent("region","regionname",CollectRegion)
		end if
		content=DelHtml(GetBody(NewsCode,Hcontent,Fcontent))
		if ScopeOn=1 then
		Urlscope=GetBody(NewsCode,Hscope,Fscope)
		weburl=GetArray(Urlscope,Hweburl,Fweburl)
		else
		weburl=GetArray(NewsCode,Hweburl,Fweburl)
		end if
		txt="来源地址："&UrlTest&"<br>电影名称："&moviename&"<br>演员："&movieactor&"<br>图片："&moviepic&"<br>栏目："&typeidname&"<br>地区："&regionname&"<br>介绍："&content&"<br>"
		If weburl=False Then
			txt=txt&"<font color=red><b>在获取播放列表链接时出错。</b></font>"
			sb=sb+1
		else
			Set rs = server.CreateObject("Adodb.RecordSet")
			sql="select * from "&web_dbtop&"collect_movie where UrlTest='"&UrlTest&"'"
			rs.open sql,conn,1,3
			if not rs.eof then
				sburl=1
			else
				cg=cg+1
				if SaveFiles=1 then
				moviepic=GetImage(moviepic)
				end if
				rs.addnew
				rs("UrlTest")=UrlTest
				rs("typeid")=typeidname
				rs("regionid")=regionname
				rs("moviename")=moviename
				rs("movieactor")=movieactor
				rs("moviepic")=moviepic
				rs("content")=content
				rs("CollectName")=CollectName
				rs("TimeDate")=date()
				rs("ClassType")=ClassType
				rs("RegionType")=RegionType
				rs.update
				movieid=rs("id")
			end if
			rs.close   
			set rs=nothing
				
			if sburl=1 then
				txt=txt&"<font color=red><b>采集失败 数据库中已经有此记录重复采集</b></font>"
				sb=sb+1
			else
			   webArray=Split(weburl,"$Array$")
			   For i=0 To Ubound(webArray)
				   Select Case UrlType
				   Case 1
					   Keyurl = Split(Rurl,"[变量]",-1,1)
					   urli=GetBody(webArray(i),Keyurl(0),Keyurl(1))
					   if urli=False then
						   Exit For
					   end if
					   WebTest=Replace(Reurl,"[变量]",urli)
					   WebTestx=DefiniteUrl(WebTest,UrlTest)
				   Case else
					   WebTestx=DefiniteUrl(webArray(i),UrlTest)
				   End Select
				   webCode=GetHttp(WebTestx,selEncoding)
				   movieurl=GetBody(webCode,Hpurl,Fpurl)
				   txt=txt&"播放列表:"&WebTestx&"<br>影片地址："&movieurl&"<br>"
				   movie_url=movie_url&movieurl&vbcrlf
			   Next
			   movie_url=rtrimVBcrlf(movie_url)
			   conn.Execute("Update "&web_dbtop&"collect_movie set movieurl='"&movie_url&"' where id="&movieid&"")
			end if
		End If
	End If
	response.write"<meta http-equiv=""refresh"" content=""0;url=collecting.asp?id="&id&"&ListNum="&Colledt_ListNum&"&MovieNum="&Colledt_MovieNum&"&sb="&sb&"&cg="&cg&""">"
End If
%>
<TABLE width="96%" border=0 align=center cellpadding="4" cellSpacing=1 class=tbtitle style="BACKGROUND: #cad9ea;">
    <tr>
      <td bgColor=#f5fafe>采集统计</td>
    </tr>
    <tr>
      <td bgColor=#ffffff>采集统计：成功采集--<%=cg%>  条记录，失败--<%=sb%>  条</td>
    </tr>
</table>
<TABLE width="96%" border=0 align=center cellpadding="4" cellSpacing=1 class=tbtitle style="BACKGROUND: #cad9ea;">
  <tr>
    <td bgColor=#ffffff><%=txt%></td>
  </tr>
</table>
💿 文件大小 699 K
👤 上传用户 awake2
📂 所属分类其他
🏷️ 相关标签

#asp #音视频 #网站 #源代码
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -