<%Server.ScriptTimeOut=9999%>
<html>
<head>
<META content=ywnt,云网互动影视管理系统 name=keywords>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title>云网互动影视6.0--采集管理</title>
<LINK href="css/css.css" type=text/css rel=stylesheet>
</head>
<BODY leftMargin=0 topMargin=0 scroll=yes MARGINHEIGHT="0" MARGINWIDTH="0">
<!--#include file="Conn.asp" -->

<!--#include file="Inc/Collect_Conf.Asp"-->
<!--#include file="Inc/YWNT_TMS_Function.asp" -->
<!--#include file="Inc/Function.asp" -->
<!--#include file="Inc/clsCache.asp"-->
<%
'===================================================================================================================
'软件名称：云网影视管理系统
'Copyright (C) 2002-2007 ywnt.net  All rights reserved.
'产品咨询QQ：489234,2813712
'程序版权：云网互动科技有限公司
'程序开发：云网互动科技有限公司
'官方网站：http://www.ywnt.net 
'郑重声明:
'    1、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
'    2、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
'    3、云网互动科技有限公司保留此软件的法律追究权利
'===================================================================================================================
Colledt_ListNum=Request.QueryString("ListNum")
Colledt_MovieNum=Request.QueryString("MovieNum")
sb=Request.QueryString("sb")
cg=Request.QueryString("cg")
txt=""
ErrMsg=""
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
'Call CheckLogin("Collect")
set Rs=Connx.execute("update Collect_Class set CollectTime=now() where id="&NoSqlHack(Request.QueryString("id")))
call DelCache()
sb=0
cg=0
'Call AddLog("采集栏目采集",9)
end if

dim cjlms,myCache
set myCache=new ywnt_clsCache
myCache.name="MovieCollect" '定义缓存名称 
if myCache.valid then '如果缓存有效
cjlms=myCache.value '读取缓存内容
else
	set rs=server.createobject("adodb.recordset")
	sql="select * from Collect_Class where id = "&NoSqlHack(Request.QueryString("id"))
	rs.open sql,connx,1,1
	If Not rs.Eof Then
	cjlms=rs.GetRows()
   	End If
   	rs.Close
   	Set rs=Nothing
myCache.add cjlms,dateadd("n",1000,now) '将内容赋值给缓存，并设置缓存有效期是当前时间＋1000分钟
end if 
set myCache=nothing '释放对象

ID=cjlms(0,0)
CollectName=cjlms(1,0)
selEncoding=cjlms(2,0)
ListPaingType=cjlms(3,0)
ListPaingStr=cjlms(4,0)
ListPaingStr2=cjlms(5,0)
ListPaingID1=cjlms(6,0)
ListPaingID2=cjlms(7,0)
ListPaingStr3=cjlms(8,0)
Script_Iframe=cjlms(9,0)
Script_Object=cjlms(10,0)
Script_Script=cjlms(11,0)
Script_Div=cjlms(12,0)
Script_Class=cjlms(13,0)
Script_Table=cjlms(14,0)
Script_Tr=cjlms(15,0)
Script_Span=cjlms(16,0)
Script_Img=cjlms(17,0)
Script_Font=cjlms(18,0)
Script_A=cjlms(19,0)
Script_Html=cjlms(20,0)
Script_Td=cjlms(21,0)
SaveFiles=cjlms(22,0)
CollecOrder=cjlms(23,0)
LsString=cjlms(24,0)
LoString=cjlms(25,0)
HsString=cjlms(26,0)
HoString=cjlms(27,0)
Htitle=cjlms(28,0)
Ftitle=cjlms(29,0)
Hname=cjlms(30,0)
Fname=cjlms(31,0)
Hdirector=cjlms(32,0)
Fdirector=cjlms(33,0)
Hdistrict=cjlms(34,0)
Fdistrict=cjlms(35,0)
Htupian=cjlms(36,0)
Ftupian=cjlms(37,0)
Hcontent=cjlms(38,0)
Fcontent=cjlms(39,0)
Hweburl=cjlms(40,0)
Fweburl=cjlms(41,0)
UrlType=cjlms(42,0)
Rurl=cjlms(43,0)
Reurl=cjlms(44,0)
Hpurl=cjlms(45,0)
Fpurl=cjlms(46,0)
PlayUrlMode=cjlms(47,0)
Select Case ListPaingType
	Case 0 
            If Colledt_ListNum<1 Then
            ListUrl=ListPaingStr
			Else
			ListEnd=1
			End if
	Case 1
          If CollecOrder=1 then
			 If (ListpaingID2-Colledt_ListNum)<ListPaingID1 or (ListpaingID2-Colledt_ListNum)<0 Then
				ListEnd=1
			 Else
				ListUrl=Replace(ListPaingStr2,"{$ID}",(ListpaingID2-Colledt_ListNum))
			 End if
		  Else
			 If (ListPaingID1+Colledt_ListNum)>ListPaingID2 Then
				ListEnd=1
			 Else
				ListUrl=Replace(ListPaingStr2,"{$ID}",(ListPaingID1+Colledt_ListNum))
			 End If
		  End If   
	Case 2
         ListArray=Split(ListPaingStr3,"|")
      If (Colledt_ListNum)>CInt(Ubound(ListArray)) Then
         ListEnd=1
      Else
         ListUrl=ListArray(Colledt_ListNum)
      End If  
End Select

sub Collecting(Url,MovieNumID)
On Error Resume Next
ListCode=GetHttpPage(Url,selEncoding)

Select Case ListCode
	Case False 
 	ErrMsg="在获取:" & Url & "网页源码时发生错误"
 	call WriteErrMsg(ErrMsg)
	exit sub
End Select

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
exit sub
else
	NewsArray=Split(NewsArrayCode,"$Array$")
	If CInt(Ubound(NewsArray))-MovieNumID<0 Then
	Colledt_ListNum=Colledt_ListNum+1
	Colledt_MovieNum=0
	exit sub
	End If
	
	UrlTest=DefiniteUrl(NewsArray(MovieNumID),Url)
	NewsCode=GetHttpPage(UrlTest,selEncoding)
	
	If NewsCode=False then
	txt=""&txt&"<font color=red><b>在获取内容页时出错。</b></font>"
	sb=sb+1
	exit sub
	Else
title=FilterScript(GetBody(NewsCode,Htitle,Ftitle))
namex=FpHtmlEnCode(GetBody(NewsCode,Hname,Fname))
'tupian=getHTTPimg(GetBody(NewsCode,Htupian,Ftupian),UrlTest)
content=FilterScript(GetBody(NewsCode,Hcontent,Fcontent))
'weburl=GetArray(NewsCode,Hweburl,Fweburl)

IF Cint(PlayUrlMode)=0 Then'处理内容页采集
 weburl=GetBody(NewsCode,Hweburl,Fweburl)
 weburl=GetArray(WebUrl,Hpurl,Fpurl)'PlayUrlMode
Else'处理播放页采集
 weburl=GetArray(NewsCode,Hweburl,Fweburl)
End if 

daoyan=FpHtmlEnCode(GetBody(NewsCode,Hdirector,Fdirector))
chandi=FpHtmlEnCode(GetBody(NewsCode,Hdistrict,Fdistrict))

txt="来源地址："&UrlTest&"<br>电影名称："&title&"<br>演员："&namex&"<br>导演："&daoyan&"<br>产地："&chandi&"<br>图片："&tupian&"<br>介绍："&content&"<br>"
		If weburl=False Then
		txt=""&txt&"<font color=red><b>在获取播放列表链接时出错。</b></font>"
		sb=sb+1
		exit sub
		else
		set rs=server.createobject("adodb.recordset")
		sql="select id,UrlTest,title,name,daoyan,chandi,tupian,tupiansmall,content,ClassName,TimeDate from movie where UrlTest='"&UrlTest&"' order by ID desc"      '查询数据库是否已经添加过
		rs.Open sql,connx,1,3
		if not rs.eof then
		sburl=1
		else
		bigtupian=GetBody(NewsCode,Htupian,Ftupian)
		tupian=PicCode(bigtupian)
		cg=cg+1
	   	rs.addnew
		rs("UrlTest")=UrlTest
		rs("title")=title
		rs("name")=namex
		rs("daoyan")=daoyan
		rs("chandi")=PicCodex(chandi)
		'rs("tupian")=PicCodex(tupian)
		'rs("tupiansmall")=PicCodex(smalltupian)
		If Cint(AdminId(4))=1 And Instr(tupian,"http://")>0 Then'判断远程图片本地化
	        rs("tupian")=GetPicurl(tupian,"../../"&AdminId(13))
		   If Cint(AdminId(6))=1 Then 
		    rs("tupiansmall")=GetPicurll(tupian,"../../"&AdminId(13))
		   End if
		Else
	        rs("tupian")=tupian
		    rs("tupiansmall")=tupian
	    End If 
		'Response.Write tupian&"<br>"&smalltupian
		'REsponse.End() 
		rs("content")=content
		rs("ClassName")=CollectName
		rs("TimeDate")=now()
	   	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
			exit sub
			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=GetHttpPage(WebTestx,selEncoding)
				   'url=GetBody(webCode,Hpurl,Fpurl)
				   if  Cint(PlayUrlMode)=0 Then
		              url=WebTestx
		           else
		              url=GetBody(webCode,Hpurl,Fpurl)
		           end if
				   txt=""&txt&"播放列表:"&WebTestx&"<br>影片地址："&url&"<br>"
				   connx.Execute("insert into url(url,nameid,weburl) values('"&url&"','"&movieid&"','"&WebTestx&"')")
				   Next
			end if
		End If
	End If
End If
end sub

Function FilterScript(Content)
   If Script_Iframe=1 Then
      Content=ScriptHtml(Content,"Iframe",1)
   End If
   If Script_Object=1 Then
      Content=ScriptHtml(Content,"Object",2)
   End If
   If Script_Script=1 Then
      Content=ScriptHtml(Content,"Script",2)
   End If
   If Script_Div=1 Then
      Content=ScriptHtml(Content,"Div",3)
   End If
   If Script_Table=1 Then
      Content=ScriptHtml(Content,"table",3)
   End If
   If Script_Tr=1 Then
      Content=ScriptHtml(Content,"tr",3)
   End If
   If Script_Td=1 Then
      Content=ScriptHtml(Content,"td",3)
   End If
   If Script_Span=1 Then
      Content=ScriptHtml(Content,"Span",3)
   End If
   If Script_Img=1 Then
      Content=ScriptHtml(Content,"Img",3)
   End If
   If Script_Font=1 Then
      Content=ScriptHtml(Content,"Font",3)
   End If
   If Script_A=1 Then
      Content=ScriptHtml(Content,"A",3)
   End If
   If Script_Html=1 Then
      Content=noHtml(Content)
   End If
  FilterScript=Content
End Function

sub WriteErrMsg(ErrMsg)
	strErr=strErr & "<table cellpadding=3 cellspacing=1 border=0 width=400 align=center class=table>" & vbcrlf
	strErr=strErr & "  <tr align='xingmu' class='title'><td height='22'><strong>错误信息</strong></td></tr>" & vbcrlf
	strErr=strErr & "  <tr class='hback'><td height='100' valign='top'><b>产生错误的可能原因：</b>" & ErrMsg &"</td></tr>" & vbcrlf
	strErr=strErr & "</table>" & vbcrlf
	response.write strErr
	response.end
end sub

sub DelCache()
set myCache=new ywnt_clsCache
myCache.name="MovieCollect"
Call myCache.clean()
Set myCache=Nothing
end sub

Select Case ListEnd
Case 1
call DelCache()
txt=""&txt&"采集完成"
Case else
call Collecting(ListUrl,Colledt_MovieNum)
response.write"<meta http-equiv=""refresh"" content=""0;url=QvodCms_Collecting.asp?id="&id&"&ListNum="&Colledt_ListNum&"&MovieNum="&Colledt_MovieNum+1&"&sb="&sb&"&cg="&cg&""">"
end Select
call connxclose()%>
<table width="98%" border="0" align="center" cellpadding="3" cellspacing="1" class=table>
    <tr>
      <td class=xingmu>采集统计</td>
    </tr>
    <tr>
      <td class="hback">采集统计：成功采集--<%=cg%>  条记录，失败--<%=sb%>  条</td>
    </tr>
</table>
<table width="98%" border="0" align="center" cellpadding="2" cellspacing="1" class=table>
  <tr>
    <td class="hback"><%=txt%></td>
  </tr>
</table>
