📄 cl_function_collect.asp

📁 正版创力4.1SQL商业版!!!ASP版。
💻 ASP
📖 第 1 页 / 共 5 页
字号:
上一页 1 2 3 45
				Else
					Founderr=True
					Errmsg=Errmsg & "<br><li>在获取链接列表时出错。</li>"
				End If	
			Else
				Founderr=True
				Errmsg=Errmsg & "<br><li>在截取列表时发生错误。</li>"
			End If
		Else
				Founderr=True
			Errmsg=Errmsg & "<br><li>在获取:" & Listurl & "网页源码时发生错误。</li>"
		End If
	End If
'------------列表缩略图
If X_tp=1 Then
	If Founderr<>True Then
		Dim Newsimagecode
		Newsimagecode=CGet.Getarray(listcode,imhstr,imostr,False,False)
		If Newsimagecode="$False$" Then
		Founderr=True
		Errmsg=Errmsg & "<br><li>在分析：" & Listurl & "缩略图列表时发生错误！</li>"
		Else
		Newsimage=split(newsimagecode,"$Array$")
		Dim Arr_i
		For Arr_i=0 To Ubound(newsimage)
			If Httpurltype=1 Then
				Newsimage(arr_i)=Trim(replace(httpurlstr,"{$ID}",newsimage(arr_i)))
			Else
				Newsimage(arr_i)=Trim(CGet.formatremoteurl(newsimage(arr_i),listurl))			
			End If
			'if X_tpurl<>"" Then Newsimage(arr_i)= X_tpurl & Newsimage(arr_i) 
			Newsimage(arr_i)=checkurl(newsimage(arr_i))
			Picpath=newsimage(arr_i)
			PicpathTemp=Picpath
			If Savefiles=1 Then Picpath=CGet.savefile(ModuleID,picpath,SaveFileUrl)
			If Picpath=False Then Picpath=PicpathTemp
		Next
		End If
	End If
End If			
If Founderr<>True Then
	Newscode=CGet.replaceTrim(CGet.GetHttpPage(newsurl,Encoding))
	If Newscode<>"$False$" Then
	Title=CGet.Getbody(newscode,tsstring,tostring,False,False)
	If Csstring<>"" Or Costring<>"" Then
		If Csstring<>"0" Or  Costring<>"0" Then
			Content=CGet.Getbody(newscode,csstring,costring,False,False)
		Else
			Content=""
		End If
	End If
		If Title="$False$"  Then
			Founderr=True
			Errmsg=Errmsg & "<br><li>在截取"& ModuleName &"标题/正文的时候发生错误：" & Newsurl & "</li>"
		Else
			Title=fphtmlencode(title)
			Title=dvhtmlencode(title)
			Call FilterScript()
			Content=ubbcode(content)

	If ModuleID=2 Then '下载
	If Downlist_s="" Or  Downlist_o="" Or Downurl_s="" Or Downurl_o="" Then'下载地址设置
		Founderr=True
		Errmsg=Errmsg & "<br><li>下载地址设置不能为空</li>" 
	Else	
		Downurls=CGet.Getbody(newscode,downlist_s,downlist_o,False,False)
		If Downurls<>"$False$" Then
			Downurls=CGet.Getbody(downurls,downurl_s,downurl_o,False,False)
			If Downurls<>"$False$" Then
					Downurls=Trim(CGet.formatremoteurl(downurls,newsurl))
			Else
				Founderr=True
				Errmsg=Errmsg & "<br><li>在获取:" & Newsurl & "下载地址链接源码时发生错误。</li>"
			End If
		Else
			Founderr=True
			Errmsg=Errmsg & "<br><li>在获取:" & Newsurl & "下载地址列表源码时发生错误。</li>"
		End If
	End If

	If Downnewtype=1 Then'新窗口打开下载连接
		If Downnewlist_s<>"" Or  Downnewlist_o<>"" Or Downnewurl_s<>"" Or Downnewurl_o<>"" Then
			Downurls=CGet.replaceTrim(CGet.GetHttpPage(downurls,Encoding))
			Downurls=CGet.Getbody(downurls,downnewlist_s,downnewlist_o,False,False)
			If Downurls<>"$False$" Then 
				Downurls=CGet.Getbody(downurls,downnewurl_s,downnewurl_o,False,False)
				If Downurls<>"$False$" Then
					Downurls=Trim(CGet.formatremoteurl(downurls,newsurl)) 
				Else
					Founderr=True
					Errmsg=Errmsg & "<br><li>在获取:" & Newsurl & "(新窗口)下载地址列表源码时发生错误</li>" 
				End If
			Else
				Founderr=True
				Errmsg=Errmsg & "<br><li>在获取:" & Newsurl & "(新窗口)下载地址列表源码时发生错误</li>" 
			End If
		Else
			Founderr=True
			Errmsg=Errmsg & "<br><li>下载地址设置不能为空</li>" 
		End If
	End If 

	If Zdtype_001=0 Then'软件大小设置
			Downsize=0
	Else
		If  Zds_001="0" And Zdo_001<>"" Then
			Downsize=Cl.GetClng(zdo_001)
		Else
			Downsize=Cl.GetClng(CGet.Getbody(newscode,zds_001,zdo_001,False,False))
		End If
	End If
	
	If Zdtype_002=0 Then'软件语言设置
			SoftLanguage=""
	Else
		If  Zds_002="0" And Zdo_002<>"" Then
			SoftLanguage=zdo_002
		Else
			SoftLanguage=CGet.Getbody(newscode,zds_002,zdo_002,False,False)
		End If
	End If
	If Zdtype_003=0 Then'授权方式设置
			CopyrightType=""
	Else
		If  Zds_003="0" And Zdo_003<>"" Then
			CopyrightType=zdo_003
		Else
			CopyrightType=CGet.Getbody(newscode,zds_003,zdo_003,False,False)
		End If
	End If
	If Zdtype_004=0 Then'运行环境设置
			OperatingSystem=""
	Else
		If  Zds_004="0" And Zdo_004<>"" Then
			OperatingSystem=zdo_004
		Else
			OperatingSystem=CGet.Getbody(newscode,zds_004,zdo_004,False,False)
		End If
	End If
	If Zdtype_005=0 Then'演示地址设置
			DemoUrl=""
	Else
		If  Zds_005="0" And Zdo_005<>"" Then
			DemoUrl=zdo_005
		Else
			DemoUrl=CGet.Getbody(newscode,zds_005,zdo_005,False,False)
		End If
	End If
	If Zdtype_006=0 Then'注册地址设置
			AuthorHomepage=""
	Else
		If  Zds_006="0" And Zdo_006<>"" Then
			AuthorHomepage=zdo_006
		Else
			AuthorHomepage=CGet.Getbody(newscode,zds_006,zdo_006,False,False)
		End If
	End If	
	If Zdtype_007=0 Then'软件图片设置
			Photourl=""
	Else
		If  Zds_007="0" And Zdo_007<>"" Then
			Photourl=zdo_007
		Else
			Photourl=CGet.Getbody(newscode,zds_007,zdo_007,False,False)
			Photourl=Trim(CGet.formatremoteurl(Photourl,newsurl))
		End If
	End If  
End If

	If ModuleID=3 Then '图片		
		If Newspaingtype=2 Then '2级分类链接源码时发生错误
			Listtypecode=CGet.Getbody(newscode,Phototype_s,Phototype_o,False,False)
			If Listtypecode<>"$False$" Then 
				Listtypeurlcode=CGet.Getarray(listtypecode,Photolurl_s,Photolurl_o,False,False)
				If Listtypeurlcode<>"$False$" And Instr(newsarraycode,"$Array$")>0  Then 
					Typeurlarray=split(listtypeurlcode,"$Array$")
					Typenewsurl=Trim(CGet.formatremoteurl(typeurlarray(0),newsurl))
					If Typenewsurl<>"$False$" Then
						If Phototypeurl_s<>"0" Or Phototypeurl_o<>"0" Then
							NewsTypecode=CGet.replaceTrim(CGet.GetHttpPage(typenewsurl,Encoding))
							Picurls=CGet.Getbody(newsTypecode,Phototypeurl_s,Phototypeurl_o,False,False)
							If Httpurlstr<>"" Then
								Picurls=Trim(CGet.formatremoteurl(picurls,httpurlstr))
							Else
								Picurls=Trim(CGet.formatremoteurl(picurls,typenewsurl))
							End If
						Else
							Picurls=typenewsurl
						End If
					End If
				Else
					Founderr=True
					Errmsg=Errmsg & "<br><li>在获取:" & Newsurl & "2级分类链接源码时发生错误。</li>"	
				End If
			Else
				Founderr=True
				Errmsg=Errmsg & "<br><li>在获取:" & Newsurl & "2级分类列表源码时发生错误。</li>"
			End If
		Else
			If Downlist_s<>"0" And  Downlist_o<>"0" And Downurl_s<>"0" And Downurl_o<>"0" Then
				If Downlist_s="" Or  Downlist_o="" Or Downurl_s="" Or Downurl_o="" Then'图片下载
					Founderr=True
					Errmsg=Errmsg & "<br><li>图片地址设置不能为空</li>" 
				Else	
					Downurls=CGet.Getbody(newscode,downlist_s,downlist_o,False,False)
					If Downurls<>"$False$" Then
						Downurls=CGet.Getbody(downurls,downurl_s,downurl_o,False,False)
						If Downurls<>"$False$" Then	
							Downurls=Trim(CGet.formatremoteurl(downurls,newsurl))
							Picurls=downurls
						Else
							Founderr=True
							Errmsg=Errmsg & "<br><li>在获取:" & Newsurl & "图片链接源码时发生错误。</li>"
						End If
					Else
						Founderr=True
						Errmsg=Errmsg & "<br><li>在获取:" & Newsurl & "图片列表源码时发生错误。</li>"
					End If
				End If
			End If
		End If
	End If

If ModuleID=4 Then '影视
	If Downlist_s="" Or  Downlist_o="" Or Downurl_s="" Or Downurl_o="" Then'下载地址设置
		Founderr=True
		Errmsg=Errmsg & "<br><li>影视下载地址设置不能为空</li>" 
	Else	
		Downurls=CGet.Getbody(newscode,downlist_s,downlist_o,False,False)
		If Downurls<>"$False$" Then
			Downurls=CGet.Getbody(downurls,downurl_s,downurl_o,False,False)
			If Downurls<>"$False$" Then
				Downurls=Trim(CGet.formatremoteurl(downurls,newsurl))
			Else
				Founderr=True
				Errmsg=Errmsg & "<br><li>在获取:" & Newsurl & "影视下载地址链接源码时发生错误。</li>"
			End If
		Else
			Founderr=True
			Errmsg=Errmsg & "<br><li>在获取:" & Newsurl & "影视下载地址列表源码时发生错误。</li>"
		End If
	End If
	
	If Downnewtype=1 Then'新窗口打开下载连接
		If Downnewlist_s<>"" Or  Downnewlist_o<>"" Or Downnewurl_s<>"" Or Downnewurl_o<>"" Then
			Downurls=CGet.replaceTrim(CGet.GetHttpPage(downurls,Encoding))
			Downurls=CGet.Getbody(downurls,downnewlist_s,downnewlist_o,False,False)
			If Downurls<>"$False$" Then 
				Downurls=CGet.Getbody(downurls,downnewurl_s,downnewurl_o,False,False)
				If Downurls<>"$False$" Then
					Downurls=Trim(CGet.formatremoteurl(downurls,newsurl)) 
				Else
					Founderr=True
					Errmsg=Errmsg & "<br><li>在获取:" & Newsurl & "(新窗口)影视地址列表源码时发生错误</li>" 
				End If
			Else
				Founderr=True
				Errmsg=Errmsg & "<br><li>在获取:" & Newsurl & "(新窗口)影视地址列表源码时发生错误</li>" 
			End If
		Else
			Founderr=True
			Errmsg=Errmsg & "<br><li>影视地址设置不能为空</li>" 
		End If
	End If 
End If

			If Datetype=0 Then
				Updatetime=now()
			Else
			If Datetype=1 Then
					Updatetime=CGet.Getbody(newscode,dsstring,dostring,False,False)
					Updatetime=fphtmlencode(updatetime)
					If Isdate(updatetime)=True Then
						Updatetime=cdate(updatetime)
					Else
						Updatetime=now()
					End If
				End If
			End If
			If Authortype=1 Then
				Author=CGet.Getbody(newscode,asstring,aostring,False,False)
			Elseif Authortype=2 Then
				Author=authorstr
			End If
			If Author="$False$" Or Trim(author)="" Then
				Author="佚名"
			Else
				Author=fphtmlencode(author)
			End If
			If Copyfromtype=1 Then
				Copyfrom=CGet.Getbody(newscode,fsstring,fostring,False,False)
			Elseif Copyfromtype=2 Then
				Copyfrom=copyfromstr
			End If
			If Copyfrom="$False$" Or Trim(copyfrom)="" Then
				Copyfrom="不详"
			Else
				Copyfrom=fphtmlencode(copyfrom)
			End If

			If Keytype=0 Then
				Key=title
				Key=createkeyword(key,2)
			Elseif Keytype=1 Then
				Key=CGet.Getbody(newscode,ksstring,kostring,False,False)
				Key=replace(key,",","|")
			Key=replace(key," ","|")
			Key=fphtmlencode(key)
				'key=createkeyword(key,2)
			Elseif Keytype=2 Then
				Key=fphtmlencode(key)
			End If
			If Key="$False$" Or Trim(key)="" Then
				Key=keystr
			End If	
	End  If	
	Else
	Founderr=True
	Errmsg=Errmsg & "<br><li>在获取源码时发生错误："& Newsurl &"</li>"
	End If 
End If
If Picurls="$False$" Then 
	Picurls=""
End If

If Founderr<>True Then
	Call Getfilters'过滤
	Call Filters'过滤
	Content=CGet.itemreplacestr(content,strreplace)'内容替换
	If ModuleID =1 Then 
		set rs = Conn_C.execute("select top 1 Dir from ModuleInfo where ID="& ModuleID)
		Cl.Get_ChannelSetting(ChannelID)
		SavefilePath=replace(rs("dir"),"{$DefaultDir}",Cl.WebDir&Cl.Upload_Setting(0)&Cl.ChannelUpLoadSetting(1))
		SavefilePath=Cl.ReplaceDir(SavefilePath)
		Content=CGet.replacesaveremotefile(content,"/",SavefilePath,False,newsurl,ModuleID)'远程图片
		Content=CGet.resaveremotefile(content,newsurl,SavefilePath,False,ModuleID)'远程文件
		rs.close:set rs=nothing
	End If
End If
If Founderr<>True Then
	Set Rsitem=Conn_C.execute("update Item Set Flag=True Where ItemID="& ItemID)
End If
End Sub

Sub Setitems()
	Dim Itemnumtemp
	Itemnumtemp=itemnum-1
	ItemID=arr_item(0,itemnumtemp)
	ItemName=arr_item(1,itemnumtemp)
	ChannelID=arr_item(2,itemnumtemp)'频道ID
	Channeldir=arr_item(3,itemnumtemp)'频道目录
	ClassID=arr_item(4,itemnumtemp)				'栏目
	SpecialID=arr_item(5,itemnumtemp)		'专题
	Logintype=arr_item(9,itemnumtemp)
	Loginurl=arr_item(10,itemnumtemp)			'登录
	Loginposturl=arr_item(11,itemnumtemp)
	Loginuser=arr_item(12,itemnumtemp)
	Loginpass=arr_item(13,itemnumtemp)
	LoginFalse=arr_item(14,itemnumtemp)
	Liststr=arr_item(15,itemnumtemp)				'列表地址
	Lsstring=arr_item(16,itemnumtemp)			'列表
	Lostring=arr_item(17,itemnumtemp)
	Listpaingtype=arr_item(18,itemnumtemp)
	Lpsstring=arr_item(19,itemnumtemp)			
	Lpostring=arr_item(20,itemnumtemp)
	Listpaingstr1=arr_item(21,itemnumtemp)
	Listpaingstr2=arr_item(22,itemnumtemp)
	ListpaingID1=arr_item(23,itemnumtemp)
	ListpaingID2=arr_item(24,itemnumtemp)
	Listpaingstr3=arr_item(25,itemnumtemp)
	Hsstring=arr_item(26,itemnumtemp)  
	Hostring=arr_item(27,itemnumtemp)
	Httpurltype=arr_item(28,itemnumtemp)
	Httpurlstr=arr_item(29,itemnumtemp)
	Tsstring=arr_item(30,itemnumtemp)			'标题
	Tostring=arr_item(31,itemnumtemp)
	Csstring=arr_item(32,itemnumtemp)			'正文
	Costring=arr_item(33,itemnumtemp)
	Datetype=arr_item(34,itemnumtemp)		'作者
	Dsstring=arr_item(35,itemnumtemp)			
	Dostring=arr_item(36,itemnumtemp)
	Authortype=arr_item(37,itemnumtemp)		'作者
	Asstring=arr_item(38,itemnumtemp)			
	Aostring=arr_item(39,itemnumtemp)
	Authorstr=arr_item(40,itemnumtemp)
	Copyfromtype=arr_item(41,itemnumtemp)  '来源
	Fsstring=arr_item(42,itemnumte
上一页 1 2 3 45
⌨️ 快捷键说明

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