⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 admin_mov_collecting.asp

📁 重庆宽频P2P电影小偷程序,可以做一个大型的电影站了
💻 ASP
📖 第 1 页 / 共 4 页
字号:
🔍
1234 
<%@language=vbscript codepage=936 %>
<%
option explicit
response.buffer=true	
Const PurviewLevel=1
Server.ScriptTimeOut=999999999
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1 
Response.Expires = 0 
Response.CacheControl = "no-cache"
%>
<!--#include file="../conn.asp"-->
<!--#include file="../inc/Function.asp"-->
<!--#include file="Admin_ChkPurview.asp"-->
<!--#include file="Admin_mov_Conn.asp"-->
<!--#include file="Admin_mov_Function.asp"-->
<html>
<head>
<title>电影采集系统</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">

<link rel="stylesheet" type="text/css" href="Admin_Style.css">
</head>
<body leftmargin="0" topmargin="0" marginwidth="0" marginheight="0">
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border">
  <tr class='topbg'> 
    <td height="22" colspan="2" align="center" ><strong>采 集 系 统 项 目 管 理</strong></td>
  </tr>
</table>

<%
'基本参数
Dim SqlItem,RsItem,ItemNum,ItemStr,ItemStr1,ListNum,SuccNum,FailNum,ItemID,ItemEnd,ListUrl,ListCode,LinksArray,ListArray,OrderTemp,Arr_j,CollecTest,ListEnd,LinksCode,LinksUrl,Larri,Larrj,Larrz,tDownloadUrls,sDownLoadUrls,XsStringbtxt,tXsStringbtxt,dd
Dim Url_i,Urlstr1,Urlstr2,Urlstr3,stChannelDir
Dim sUploadDir
Dim SaveDir
Dim FileExt,FileName,InputType,ListPaingNext,StartTime,tKeyword
Dim SoftPicName,SoftPicExt,SoftPictemp,ttKeyword,Yearnow,Monthnow,Daynow

Dim Arr_Filters

'采集入库变量
Dim SoftIntro,SoftID
Dim SoftName,DownloadUrls,SoftVersion,Author,CopyFrom,DemoUrl,RegUrl,UpdateTime,Keyword,OperatingSystem,SoftType,SoftLanguage
Dim CopyrightType,SoftSize,SoftPicUrl,DecompressPassword

'错误参数
Dim stFoundErr,stErrMsg,isRepeat

'项目信息
Dim ItemName,stChannelID,stClassID,stSpecialID,WebName,WebUrl,ItemDemo,LoginType,LoginUrl,LoginPostUrl,LoginUser,LoginPass,LoginFalse
Dim ListStr,LsString,LoString,ListPaingType,LPsString,LPoString,ListPaingStr1,ListPaingStr2,ListPaingID1,ListPaingID2,ListPaingStr3
Dim HsString,HoString,HttpUrlType,HttpUrlStr,TsString,ToString,CsString,CoString,AuthorType,AsString,AoString,AuthorStr
Dim UpdateTimeType,UsString,UoString,UpdateTimeStr,CopyFromType,FsString,FoString,CopyFromStr,KeyType,KsString,KoString,KeyStr
Dim NewsPaingType,NPsString,NPoString,NewsPaingStr1,NewsPaingStr2,Flag,DsStringbType,DsStringb,DoStringb,DsStringbb,DoStringbb,HttpDownUrlType,HttpDownUrlStr
Dim XsStringbType,XsStringb,XoStringb,XsStringbb,XoStringbb,BsStringbType,BsStringb,BoStringb,BoStringbstr,YsStringbType,YsStringb,YoStringb,YoStringbstr
Dim PsStringbType,PsStringb,PoStringb,PoStringbstr,HsStringbType,HsStringb,HoStringb,HoStringbstr,JsStringbType,JsStringb,JoStringb,JoStringbstr
Dim SsStringbType,SsStringb,SoStringb,SoStringbstr,ZsStringbType,ZsStringb,ZoStringb,ZoStringbstr,LsStringbType,LsStringb,LoStringb,LoStringbstr
Dim MsStringbType,MsStringb,MoStringb,MoStringbstr,QsStringbType,QsStringb,QoStringb,QoStringbstr
Dim Script_IFRAME,Script_OBJECT,Script_SCRIPT,Script_Div,Script_CLASS,Script_Span,Script_IMG,Script_FONT,Script_A,Script_HTML
Dim CollectionNum,CollectionType,SkinID,TemplateID,OnTop,Hot,Elite,Hits,Stars,ShowCommentLink,Script_Table,Script_Tr,Script_Td
Dim CollecOrder,Passed,CreateImmediate,SaveFiles,lasttimestr,FileSavebType,FileSavebNum,FileSavebstr,SaveNameTypeb,SoftPoint
Dim Pp023id

ItemNum=Clng(Trim(Request("ItemNum")))		'第N个项目
ItemStr=Trim(Request("ItemStr"))			'项目数组
ListNum=Clng(Trim(Request("ListNum")))		'第N个列表
SuccNum=Clng(Trim(Request("SuccNum")))		'成功数
FailNum=Clng(Trim(Request("FailNum")))		'失败数
ListPaingNext=Trim(Request("ListPaingNext"))'下一页地址
CollecTest=Clng(Trim(Request("CollecTest")))'是否仅为测试采集
InputType=Trim(Request("InputType"))'下一页地址

if InputType="" then
	InputType=1'默认是否为更新模式,1为是,0为否
End if
'判断并获取项目ID和项目信息,当前列表地址
If ItemStr="" Then
	stFoundErr=True
	stErrMsg="<br><li>参数错误，请选择项目！</li>"
Else
	ItemStr1=Split(ItemStr,",")
	If (ItemNum-1)>Ubound(ItemStr1) then
		ItemEnd=True
		stFoundErr=True
		stErrMsg="<br><li>全部项目采集任务完成</li>"&"<br><li>成功采集： "&SuccNum&"  条,失败： "&FailNum&"  条</li>"
		%>		
<meta http-equiv="refresh" content="3;url=Admin_mov_Collectino.asp">
		<%
	Else
		ItemID=Clng(ItemStr1(ItemNum-1))
		Call GetItemDate(ItemID)			'获取项目信息
		if stFoundErr<>True then
			Call GetNowUrl()				'获取当前列表页地址
			If CollectionNum="" or CollectionNum=0 then
			Elseif CollectionType=0 and Clng(CollectionNum)=SuccNum and CollectionNum<>""   then
				ListEnd=True
			Elseif CollectionType=1 and Clng(CollectionNum)<ListNum and Clng(CollectionNum)>0 and CollectionNum<>"" then
				ListEnd=True
			End if
			if ListEnd=True then
				stFoundErr=True
				ItemNum=ItemNum+1
				ListNum=1
				stErrMsg="<br><li>该项目采集任务完成</li>"
				stErrMsg=stErrMsg&"<br><li>此项目共采集 "&SuccNum+FailNum&" 个电影，成功 "&SuccNum&" 个，失败 "&FailNum&" 个。</li>"
%>
<meta http-equiv="refresh" content="3;url=Admin_mov_Collecting.asp?ItemNum=<%=ItemNum%>&ListNum=<%=ListNum%>&SuccNum=<%=SuccNum%>&FailNum=<%=FailNum%>&ListPaingNext=<%=ListPaingNext%>&ItemStr=<%=ItemStr%>&InputType=<%=InputType%>&CollecTest=<%=CollecTest%>">
<%
			End if
		End if
	End If
End If
If stFoundErr=True then
	Call WriteSuccMsg1(stErrMsg)
	Response.end
End if

'采集登录
If stFoundErr<>True And LoginType=1 then
	'登录网站
	LoginData=UrlEncoding(LoginUser & "&" & LoginPass)
	LoginResult=PostHttpPage(LoginUrl,LoginPostUrl,LoginData)
	If Instr(LoginResult,LoginFalse)>0 Then
		stFoundErr=True
		stErrMsg=stErrMsg & "<br><li>在登录网站时发生错误，请确保登录信息的正确性！</li>"
	End If
End If

'截取列表
If stFoundErr<>True then
	'编码转换
	ListCode=GetHttpPage(ListUrl)
	if weburl=0 then
	elseif weburl=1 then
		ListCode=UTF2GB(ListCode)
	elseif weburl=2 then
	
	End if
	Call GetNextUrl()
	If ListCode="$False$" Then
		stFoundErr=True
		stErrMsg=stErrMsg & "<br><li>在获取：" & ListUrl & "网页源码时发生错误！</li>"
	Else
		ListCode=GetBody(ListCode,LsString,LoString,False,False)
		If ListCode="$False$" Or ListCode="" Then
			stFoundErr=True
			stErrMsg=stErrMsg & "<br><li>在截取：" & ListUrl & "列表时发生错误！</li>"
		End If
	End If
End If


'获取链接列表
If stFoundErr<>True Then
	LinksArray=GetArray(ListCode,HsString,HoString,False,False)
	If LinksArray="$False$" Then
		stFoundErr=True
		stErrMsg=stErrMsg & "<br><li>在分析：" & ListUrl & "电影列表时发生错误！</li>"
	Else
		LinksArray=Split(LinksArray,"$Array$")
		For Arr_j=0 to Ubound(LinksArray)
			If HttpUrlType=1 Then
				LinksArray(Arr_j)=Trim(Replace(HttpUrlStr,"{$ID}",LinksArray(Arr_j)))
			Else
				LinksArray(Arr_j)=Trim(DefiniteUrl(LinksArray(Arr_j),ListUrl))
			End If
		Next
		If CollecOrder=True Then
			For Arr_j=0 to Fix(Ubound(LinksArray)/2)
				OrderTemp=LinksArray(Arr_j)
				LinksArray(Arr_j)=LinksArray(Ubound(LinksArray)-Arr_j)
				LinksArray(Ubound(LinksArray)-Arr_j)=OrderTemp
			Next
		End If
	End If
End If

If stFoundErr=True then
	Call WriteErrMsg1(stErrMsg)
	Response.End
ELse%>

	<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border" >
	    <tr><td height="22" colspan="2" class="tdbg" align="left">&nbsp;&nbsp;采集需要一定的时间，请耐心等待，如果网站出现暂时无法访问的情况这是正常的，采集过程正常结束后即可恢复。&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type="button"  name="Stop"  value="停止采集"  onCLICK="location.href='Admin_mov_Collectino.asp'"></td></tr>
	    <tr><td height="22" colspan="2" class="tdbg" align="left">&nbsp;&nbsp;本次运行：1 个项目,正在采集第 <font color=red><%=ItemNum%></font> 个项目  <font color=red><%=ItemName%></font>  的第   <font color=red><%=ListNum%></font> 页列表,该列表待采集电影  <font color=red><%=Ubound(LinksArray)+1%></font> 条。</tr>
	    <tr><td height="22" colspan="2" class="tdbg" align="left">&nbsp;&nbsp;采集统计：成功采集--<%=SuccNum%>  个电影，失败--<%=FailNum%>  个</td></tr>
	</table><br>
<%	Response.Flush()'刷新
StartTime=Timer()
End if

'开始采集
If stFoundErr<>True Then
	Call GetFilters()
	For Arr_j=0 to Ubound(LinksArray)
	'For Arr_j=0 to 0
		stFoundErr=False
		stErrMsg=""
		DownLoadUrls=""
		Larrz=0
		If CollecTest=1 And Arr_j=10 Then
			Exit For
		End If
		if CollectionNum="" or CollectionNum=0 then
		Elseif clng(CollectionNum)<=SuccNum and CollectionType=0 Then
			Exit For
		End If

		LinksUrl=LinksArray(Arr_j)		
      '……………………………………………… 
      If Response.IsClientConnected Then 
         Response.Flush 
      Else 
         Response.End 
      End If
      '………………………………………………

      If CollecTest<>1 Then
	     'SqlItem ="select top 1 HistrolyNewsID,SoftID,Title,NewsCollecDate,NewsUrl,Result from HistrolyNews where NewsUrl='" & LinksUrl & "'"原来的
         SqlItem ="select top 1 HistrolyNewsID,SoftID,Title,NewsCollecDate,NewsUrl,Result from HistrolyNews where NewsUrl='" & LinksUrl & "' order by HistrolyNewsID desc"
         Set RsItem=ConnItem.Execute(SqlItem)
         If Not RsItem.Eof And Not RsItem.Bof Then
          if InputType=1 then
		  Pp023id=RsItem("SoftID")
          Else
            'His_Repeat=True
            stFoundErr=True
            stErrMsg=stErrMsg & "<br><li>目标电影：<font color=red>"
            If RsItem("Title")="" then
               stErrMsg=stErrMsg & LinksUrl
            Else
               stErrMsg=stErrMsg & RsItem("Title")
            End If
            stErrMsg=stErrMsg & "</font>  已存在，不予采集。"
            stErrMsg=stErrMsg & "<br><li>采集时间：" & RsItem("NewsCollecDate") & "</li>"
            stErrMsg=stErrMsg & "<br><li>电影来源：<a href='" & LinksUrl & "' target=_blank>"&LinksUrl&"</a>"
            stErrMsg=stErrMsg & "<br><li>提示信息：如想再次采集，请先将该电影的历史记录<font color=red>"&RsItem("HistrolyNewsID")&"删除</font></li>"
            If RsItem("Result")=True  Then
                  stErrMsg=stErrMsg &  "<br><li>以及主数据库中的电影删除</li>"
            End  If
           End if
         End If
         RsItem.Close
         Set RsItem=Nothing
      End If
		
		
		'获取内容页面源代码
		If stFoundErr<>True Then
			LinksCode=GetHttpPage(LinksUrl)			
			If LinksCode="$False$" Then
				stFoundErr=True
				stErrMsg=stErrMsg & "<li>在获取：" & LinksUrl & "新闻源码时发生错误！</li><br>"
			End If
		End If
		
		'LinksCode=dvhtmlencode1(LinksCode)
		
		'获取电影标题
		If stFoundErr<>True Then
			SoftName=GetBody(LinksCode,TsString,ToString,False,False)
			If SoftName="$False$" or SoftName="" then
				stFoundErr=True
				stErrMsg=stErrMsg & "<li>在采集：" & LinksUrl & "电影标题时发生错误</li><br>"
				'写入历史记录
				If CollecTest<>1 Then
					SqlItem="INSERT INTO HistrolyNews(HistrolyID,ItemID,ChannelID,ClassID,NewsCollecDate,NewsUrl,Result) VALUES ('1','"&ItemID&"','"&stChannelID&"','"&stClassID&"','"&now()&"','"&LinksUrl&"',False)"
					ConnItem.Execute(SqlItem)
				End if
			Else
				SoftName=FpHtmlEnCode(SoftName)
				SoftName=dvhtmlencode(SoftName)
			End if
		End If
		
		'获取下载地址
		If stFoundErr<>True Then
			if DsStringbType=0 then
				DownLoadUrls="第1集|"&LinksUrl
			Else		
				sDownLoadUrls=GetArray(GetBody(LinksCode,DsStringb,DoStringb,False,False),DsStringbb,DoStringbb,False,False)
				sDownLoadUrls=Split(sDownLoadUrls,"$Array$")
				For Larri=0 to Ubound(sDownloadUrls)
					if Larrz=Clng(FileSavebNum) and Clng(FileSavebNum)>0 then'最多采集多少个下载地址
						Exit for
					End if
					tDownloadUrls=Trim(DefiniteUrl(sDownloadUrls(Larri),LinksUrl))
					if XsStringbType=1 then		'判断是否新页面取下载地址 1=true 0=false
					 if	HttpDownUrlType=1 Then
					    tDownloadUrls=Trim(Replace(HttpDownUrlStr,"{$ID}",sDownloadUrls(Larri)))
					    XsStringbtxt=GetBody(GetHttpPage(tDownloadUrls),XsStringb,XoStringb,False,False)
         				XsStringbtxt=GetArray(XsStringbtxt,XsStringbb,XoStringbb,False,False)
         				XsStringbtxt=Split(XsStringbtxt,"$Array$")
         				For Larrj=0 to Ubound(XsStringbtxt)
         					If Larrz=Clng(FileSavebNum) and Clng(FileSavebNum)>0 then'新页面最多采集多少个下载地址
         						Exit For
         					End if
         					tXsStringbtxt= Trim(XsStringbtxt(Larrj))
							if instr(tXsStringbtxt,"http://")=0 then                 '判断截取的p2p地址是否有http://
						    tXsStringbtxt="http://"&tXsStringbtxt
						    end if         					
         					if tXsStringbtxt<>"$False$" and tXsStringbtxt<>"" then
         						if Larri>0 or Larrj>0 then DownloadUrls=DownloadUrls&"$$$"
         						Larrz=Larrz+1
								DownloadUrls=DownloadUrls&"第"&Larrz&"集|"&tXsStringbtxt
							End if
						Next
					 else		
         				XsStringbtxt=GetBody(GetHttpPage(tDownloadUrls),XsStringb,XoStringb,False,False)
         				XsStringbtxt=GetArray(XsStringbtxt,XsStringbb,XoStringbb,False,False)
         				XsStringbtxt=Split(XsStringbtxt,"$Array$")
         				For Larrj=0 to Ubound(XsStringbtxt)
         					If Larrz=Clng(FileSavebNum) and Clng(FileSavebNum)>0 then'新页面最多采集多少个下载地址
         						Exit For
         					End if
         					tXsStringbtxt= Trim(DefiniteUrl(XsStringbtxt(Larrj),tDownloadUrls))
1234

⌨️ 快捷键说明

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