<!--#include file="inc/function.asp" -->
<!--#include file="../inc/function.asp" -->
<%

Server.ScriptTimeOut=999999
if isnul(Request.QueryString("id")) then writeend "<script>alert('禁止访问');top.location.href='../index.asp';</script>"
%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<TITLE>采集开始 - 采集项目管理 - 126电影程序CMS</TITLE>
<META http-equiv=Content-Type content="text/html; charset=gb2312">
<LINK href="../images/css_body.css" type=text/css rel=stylesheet>
<script language="javascript" src="../images/admin.js"></script>
</head>

<body>
<%

Dim down_image,image_dir

down_image = True   
image_dir = "../../uploadimg/" & getSavePicPath() & "/" 


Class SYC_CachE
'----------------------------
private cache           
private cacheName      
private expireTime     
private expireTimeName 
private vaild           
private sub class_initialize()
end sub
	
private sub class_terminate()
end sub

Public Property Get Version
	Version="缓存类_动网迷城浪子"
End Property

public property get valid '读取缓存是否有效/属性
if isempty(cache) or (not isdate(expireTime)) then
vaild=false
else
valid=true
end if
end property

public property get value '读取当前缓存内容/属性
if isempty(cache) or (not isDate(expireTime)) then
value=null
elseif CDate(expireTime)<now then
value=null
else
value=cache
end if
end property

public property let name(str) '设置缓存名称/属性
cacheName=str
cache=application(cacheName)
expireTimeName=str&"expire"
expireTime=application(expireTimeName)
end property

public property let expire(tm) '设置缓存过期时间/属性
expireTime=tm
application.Lock()
application(expireTimeName)=expireTime
application.UnLock()
end property

public sub add(varCache,varExpireTime) '对缓存赋值/方法
if isempty(varCache) or not isDate(varExpireTime) then
exit sub
end if
cache=varCache
expireTime=varExpireTime
application.lock
application(cacheName)=cache
application(expireTimeName)=expireTime
application.unlock
end sub

public sub clean() '释放缓存/方法
application.lock
application(cacheName)=empty
application(expireTimeName)=empty
application.unlock
cache=empty
expireTime=empty
end sub
 
public function verify(varcache2) '比较缓存值是否相同/方法——返回是或否
if typename(cache)<>typename(varcache2) then
	verify=false
elseif typename(cache)="Object" then
	if cache is varcache2 then
		verify=true
	else
		verify=false
	end if
elseif typename(cache)="Variant()" then
	if join(cache,"^")=join(varcache2,"^") then
		verify=true
	else
		verify=false
	end if
else
	if cache=varcache2 then
		verify=true
	else
		verify=false
	end if
end if
end function
end class

dim Colledt_ListNum,Colledt_MovieNum,sb,cg,txt,ListEnd,errmsgs,id
dim rs,sql,CollectName,selEncoding,ListPaingType,ListPaingStr,ListPaingStr2,ListPaingID1
dim ListPaingID2,ListPaingStr3,Script_Iframe,Script_Object,Script_Script,Script_Div,Script_Class,Script_Table,Script_Tr,Script_Span,Script_Img,Script_Font,Script_A,Script_Html,Script_Td,SaveFiles,CollecOrder,RepeatCollect,LsString,LoString,HsString,HoString,Htitle,Ftitle,Hname,Fname,Htupian,Ftupian,ClassType,CollectClass,HClass,FClass,RegionType,CollectRegion,HRegion,FRegion,Hcontent,Fcontent,ScopeOn,Hscope,Fscope,Hweburl,Fweburl,UrlType,Rurl,Reurl,Hpurl,Fpurl,Harea,Farea,Timea1,Timea2,ListUrl,LRs,NoSqlHack_AllStr

Colledt_ListNum=Request.QueryString("ListNum")
Colledt_MovieNum=Request.QueryString("MovieNum")
sb=Request.QueryString("sb")
cg=Request.QueryString("cg")
txt=""
errmsgs=""
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=connc.execute("update [programe] set [CollectTime]='"&now()&"' where [id]="&Request.QueryString("id"))
	call DelCache()
	sb=0
	cg=0
end if
dim cjlms,myCache,Server1,ClassID
set myCache=new SYC_CachE
myCache.name="MovieCollect"
if myCache.valid then
cjlms=myCache.value
else
	set rs=server.createobject("adodb.recordset")
	sql="select ID,CollectName,selEncoding,ListPaingType,ListPaingStr,ListPaingStr2,ListPaingID1,ListPaingID2,ListPaingStr3,Script_Iframe,Script_Object,Script_Script,Script_Div,Script_Class,Script_Table,Script_Tr,Script_Span,Script_Img,Script_Font,Script_A,Script_Html,Script_Td,SaveFiles,CollecOrder,RepeatCollect,LsString,LoString,HsString,HoString,Htitle,Ftitle,Hname,Fname,Htupian,Ftupian,ClassType,CollectClass,HClass,FClass,RegionType,CollectRegion,HRegion,FRegion,Hcontent,Fcontent,ScopeOn,Hscope,Fscope,Hweburl,Fweburl,UrlType,Rurl,Reurl,Hpurl,Fpurl,Harea,Farea,Timea1,Timea2 from programe where id = "&Request.QueryString("id")
	rs.open sql,connc,1,1
	If Not rs.Eof Then
	cjlms=rs.GetRows()
   	End If
   	rs.Close
   	Set rs=Nothing
myCache.add cjlms,dateadd("n",100,now)
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)
RepeatCollect=cjlms(24,0)
LsString=cjlms(25,0)
LoString=cjlms(26,0)
HsString=cjlms(27,0)
HoString=cjlms(28,0)
Htitle=cjlms(29,0)
Ftitle=cjlms(30,0)
Hname=cjlms(31,0)
Fname=cjlms(32,0)
Htupian=cjlms(33,0)
Ftupian=cjlms(34,0)
ClassType=cjlms(35,0)
CollectClass=cjlms(36,0)
HClass=cjlms(37,0)
FClass=cjlms(38,0)
RegionType=cjlms(39,0)
CollectRegion=cjlms(40,0)
HRegion=cjlms(41,0)
FRegion=cjlms(42,0)
Hcontent=cjlms(43,0)
Fcontent=cjlms(44,0)
ScopeOn=cjlms(45,0)
Hscope=cjlms(46,0)
Fscope=cjlms(47,0)
Hweburl=cjlms(48,0)
Fweburl=cjlms(49,0)
UrlType=cjlms(50,0)
Rurl=cjlms(51,0)
Reurl=cjlms(52,0)
Hpurl=cjlms(53,0)
Fpurl=cjlms(54,0)
Harea=cjlms(55,0)
Farea=cjlms(56,0)
Timea1=cjlms(57,0)
Timea2=cjlms(58,0)
Select Case ListPaingType
	Case 0 
			If Colledt_ListNum<1 Then
            ListUrl=ListPaingStr
			Else
			ListEnd=1
			End if
	Case 1,3
          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

Select Case ListEnd
Case 1
call DelCache()
txt=""&txt&"<font color='red'><b>采集完成</b></font>"
Case else
 set LRs=server.createobject("adodb.recordset")
 sql="select * from programe where id = "&NoSqlHack(Request.QueryString("id"))
 LRs.open sql,connc,1,1
Server1=LRs("Server")
ClassID=LRs("ClassID")
'Area=LRs("Area")
 LRs.close 
call Collecting(ListUrl,Colledt_MovieNum)
response.write"<meta http-equiv=""refresh"" content=""0;url=collect.asp?id="&id&"&ListNum="&Colledt_ListNum&"&MovieNum="&Colledt_MovieNum&"&sb="&sb&"&cg="&cg&""">"
end Select

sub Collecting(Url,MovieNumID)
'On Error Resume Next
dim ListCode,NewsArrayCode,NewsArray,UrlTest,NewsCode,Title,Arr_Filters,namex,Timea,tupian,area,typeId,region,content,weburl,Name,CollectZT,movieid,webArray,i,WebTestx,webCode,typeidname,Urlscope

ListCode=GetPage(Url,selEncoding)

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

Select Case ListPaingType
Case 3
	Colledt_ListNum=Colledt_ListNum+1
	NewsCode=ListCode
	UrlTest=Url
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
			exit sub
		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),Url)
	NewsCode=GetHttpPage(UrlTest,selEncoding)
End Select

	If NewsCode=False then
	txt=txt&"<font color=red><b>在获取内容页时出错。</b></font>"
	sb=sb+1
	exit sub
	Else
		Title=FilterScript(GetBody(NewsCode,Htitle,Ftitle))
		Dim Filteri,FilterStr
		Dim Sql,RSF
        Sql ="Select * from Filters Where Flag=True order by FilterID ASC"
        Set RSF=connc.Execute(Sql)
        If RsF.Eof And RsF.Bof Then
        Else
           Arr_Filters=RsF.GetRows()
        End If
        RsF.Close
        Set RsF=Nothing
        If Arr_Filters(3,Filteri)=1 Then
          For Filteri=0 to Ubound(Arr_Filters,2)
              If Arr_Filters(4,Filteri)=1 and Arr_Filters(3,Filteri)=1 Then
                  Title=Replace(Title,Arr_Filters(5,Filteri),Arr_Filters(8,Filteri))
              End if
              If Arr_Filters(4,Filteri)=2 and Arr_Filters(3,Filteri)=1 Then
                   FilterStr=FilterScript(GetBody(Title,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri)))
                   Title=Replace(Title,Arr_Filters(6,Filteri),"")
                   Title=Replace(Title,Arr_Filters(7,Filteri),"")
                   Title=Replace(Title,FilterStr,Arr_Filters(8,Filteri))
                   FilterStr=FilterScript(GetBody(Title,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri)))
              End If
          Next
        End if

		Title=Replace(Title," ","")
		Title=Replace(Title,"&nbsp;","")
		Title=replace(replace(Title,chr(10),""),"chr(13)","")
		namex=FilterScript(GetBody(NewsCode,Hname,Fname))
		Timea=FilterScript(GetBody(NewsCode,Timea1,Timea2))
		Timea=Replace(Timea," ","")
		Timea=Replace(Timea,"&nbsp;","")
		tupian=FilterScript(GetBody(NewsCode,Htupian,Ftupian))
		area=FilterScript(GetBody(NewsCode,Harea,Farea))
		if ListPaingStr3<>"" then
		tupian=Replace(ListPaingStr3,"[变量]",tupian)
		end if
		if ClassType=1 then
			typeid=FilterScript(GetBody(NewsCode,HClass,FClass))
			typeidname=typeid
		else
			'response.Write CollectClass:response.End()
			typeid=CollectClass
			'typeidname=CollectClassName(typeid)
		end if
		if RegionType=1 then
			region=FilterScript(GetBody(NewsCode,HRegion,FRegion))
			regionname=region
		else
			region=CollectRegion
			'regionname=CollectRegionName(region)
		end if
		content=FilterScript(GetBody(NewsCode,Hcontent,Fcontent))
		Filteri= 0
		If Arr_Filters(3,Filteri)=2 Then
                   For Filteri=0 to Ubound(Arr_Filters,2)
                       If Arr_Filters(4,Filteri)=1 and Arr_Filters(3,Filteri)=2 Then
                          content=Replace(content,Arr_Filters(5,Filteri),Arr_Filters(8,Filteri))
                       End if
                   If Arr_Filters(4,Filteri)=2 and Arr_Filters(3,Filteri)=2 Then
                      FilterStr=FilterScript(GetBody(content,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri)))
                      content=Replace(content,Arr_Filters(6,Filteri),"")
                      content=Replace(content,Arr_Filters(7,Filteri),"")
                      content=Replace(content,FilterStr,Arr_Filters(8,Filteri))
                      FilterStr=FilterScript(GetBody(Title,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri)))
                   End If
                Next
                End if
		if ScopeOn=1 then
		Urlscope=FilterScript(GetBody(NewsCode,Hscope,Fscope))

		weburl=GetArray(Urlscope,Hweburl,Fweburl)
		else
		weburl=GetArray(NewsCode,Hweburl,Fweburl)
		end if
		

		If ClassType=1 then
			name = typeidname
			ClassID=ClassTypeId(name)'自动转化分类入库函数/返回classid数字型
		    
		Else
		    name=GetClassName(CollectClass)
			ClassID=CollectClass'自选择分类ID(数字型)
		End If
		
		CollectZT=0
		txt="来源地址："&UrlTest&"<br>电影名称："&Title&"<br>演员："&namex&"<br>时间："&Timea&"<br>栏目："&name&"<br>地区："&area&"<br>图片："&tupian&"<br>介绍："&content&"<br>"
		Timea=Replace(Timea,"False","0")
		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,Server,ClassID,Area,UrlTest,title,name,Timea,tupian,typeid,region,content,ClassName,TimeDate,ClassType,RegionType,CollectZT from movie where UrlTest='"&UrlTest&"' order by ID desc"
				rs.open sql,connc,3,3
				
				
				if not rs.eof then
					cg=cg+1 
               		rs("Server")=Server1
					rs("ClassID")=ClassID
					rs("Area")=transferArea(Area)					
					rs("UrlTest")=UrlTest
					rs("title")=Title
					rs("name")=namex
					rs("Timea")=Timea
					rs("tupian")=getHTTPimg(tupian,UrlTest)
					rs("typeid")=typeid
					rs("region")=region
					rs("content")=content
					rs("ClassName")=CollectName
					rs("TimeDate")=now()
					rs("ClassType")=ClassType
					rs("RegionType")=RegionType
					rs("CollectZT")=CollectZT
                    rs.update
					movieid=rs("id")
				else
					cg=cg+1
					rs.addnew
                    rs("Server")=Server1
					rs("ClassID")=ClassID
					rs("Area")=transferArea(Area)
					rs("UrlTest")=UrlTest
					rs("title")=Title
					rs("name")=namex
					rs("Timea")=Timea
					rs("tupian")=getHTTPimg(tupian,UrlTest)
					rs("typeid")=typeid
					rs("region")=region
					rs("content")=content
					rs("ClassName")=CollectName
					rs("TimeDate")=now()
					rs("ClassType")=ClassType
					rs("RegionType")=RegionType
					rs("CollectZT")=CollectZT
					rs.update
					movieid=rs("id")
				end if
				rs.close
				set rs=nothing
		
			   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)
			   txt=""&txt&"播放列表:"&WebTestx&"<br>影片地址："&url&"<br>"
			   
			   connc.Execute("insert into url(url,movieid,weburl) values('"&url&"','"&movieid&"','"&WebTestx&"')")
			   Next
			'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=100% align=center class='table'>" & vbcrlf
	strErr=strErr & "  <tr class='xingmu'><td height='22'  align=""center""><strong>错误信息</strong></td></tr>" & vbcrlf
	strErr=strErr & "  <tr class='hback'><td height='100' valign='top'><br><br>&nbsp;<b>产生错误的可能原因：</b>" & ErrMsg &"</td></tr>" & vbcrlf
	strErr=strErr & "</table>" & vbcrlf
	response.write strErr
	response.end
end sub

sub DelCache()
	set myCache=new SYC_CachE
	myCache.name="MovieCollect"
	Call myCache.clean()
	Set myCache=Nothing
	Session(ID&Colledt_ListNum)=""
end sub

call conncclose()
%>
<div class="container" id="cpcontainer">
<table class="tb">
    <tr class="thead">
      <th>采 集 资 料 信 息</th>
    </tr>
    <tr>
      <td  ><font color="#FF0000">采集统计(遇到同名影片将覆盖)：成功采集--<b><%=cg%></b>  条记录，失败--<b><%=sb%></b>  条</font></td>
    </tr>
</table>
<table width="100%" border="0" align="center" cellpadding="2" cellspacing="1" class=table>
  <tr>
    <td ><%=txt%></td>
  </tr>
</table>
</div>
</body>
</html>