📄 cj_cls.asp

📁 清风信息自动采集生成系统很好用的大家试试看
💻 ASP
📖 第 1 页 / 共 5 页
字号:
                        NewsUrl=Trim(Replace(HttpUrlStr,"{$ID}",NewsArray(0)))
                     Else
                        NewsUrl=Trim(Skcj.FormatRemoteUrl(NewsArray(0),ListUrl))
                     End If
                  Else
                     FoundErr=True
                     ErrMsg=ErrMsg & "<br><li>只发现一个有效链接？：" & NewsArrayCode & "</li>"
                 End If
              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=Skcj.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(Skcj.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)
			 iF SaveFiles=1 then picpath=Skcj.Sk_SaveFile(Colleclx,picpath)
		  Next
	   End If
	End If
End if	      
If FoundErr<>True Then
   NewsCode=Skcj.ReplaceTrim(Skcj.GetHttpPage(NewsUrl,selEncoding))
   If NewsCode<>"$False$" Then
	  Title=Skcj.GetBody(NewsCode,TsString,ToString,False,False)
	  if CsString<>"" or CoString<>"" then
		  if CsString<>"0" or  CoString<>"0" then
			  Content=SKcj.GetBody(NewsCode,CsString,CoString,False,False)
		  Else
			  Content=""
		  end if
	  end if
      If Title="$False$"  Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>在截取"& ErrMsg_lx &"标题/正文的时候发生错误：" & NewsUrl & "</li>"
      Else
         Title=FpHtmlEnCode(Title)
         Title=dvhtmlencode(Title)
		 Call FilterScript()
         Content=Ubbcode(Content)
If Colleclx=2 then '图片		 
		If NewsPaingType=2 Then '2级分类链接源码时发生错误
			ListTypeCode=Skcj.GetBody(NewsCode,PhotoType_s,PhotoType_o,False,False)
			If ListTypeCode<>"$False$" Then 
				ListTypeUrlCode=Skcj.GetArray(ListTypeCode,PhotoLurl_s,PhotoLurl_o,False,False)
				If ListTypeUrlCode<>"$False$" and Instr(NewsArrayCode,"$Array$")>0  Then 
					TypeUrlArray=Split(ListTypeUrlCode,"$Array$")
					TypeNewsUrl=Trim(Skcj.FormatRemoteUrl(TypeUrlArray(0),NewsUrl))
					if TypeNewsUrl<>"$False$" then
						if Phototypeurl_s<>"0" or Phototypeurl_o<>"0" then
							NewsTypeCode=Skcj.ReplaceTrim(Skcj.GetHttpPage(TypeNewsUrl,selEncoding))
							PicUrls=Skcj.GetBody(NewsTypeCode,Phototypeurl_s,Phototypeurl_o,False,False)
							if HttpUrlStr<>"" then
								PicUrls=Trim(Skcj.FormatRemoteUrl(PicUrls,HttpUrlStr))
							else
								PicUrls=Trim(Skcj.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=Skcj.GetBody(NewsCode,Downlist_s,Downlist_o,False,False)
					If DownUrls<>"$False$" then
						DownUrls=Skcj.GetBody(DownUrls,DownUrl_s,DownUrl_o,False,False)
						IF DownUrls<>"$False$" then	
							DownUrls=Trim(Skcj.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 Colleclx=3 then '下载
  	If Downlist_s="" or  Downlist_o="" or DownUrl_s="" or DownUrl_o="" then'下载地址设置
    	FoundErr=True
    	ErrMsg=ErrMsg & "<br><li>下载地址设置不能为空</li>" 
	Else	
		DownUrls=Skcj.GetBody(NewsCode,Downlist_s,Downlist_o,False,False)
		If DownUrls<>"$False$" then
			DownUrls=Skcj.GetBody(DownUrls,DownUrl_s,DownUrl_o,False,False)
			IF DownUrls<>"$False$" then
				 	DownUrls=Trim(Skcj.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=Skcj.ReplaceTrim(Skcj.GetHttpPage(DownUrls,selEncoding))
			DownUrls=Skcj.GetBody(DownUrls,DownNewlist_s,DownNewlist_o,False,False)
			If DownUrls<>"$False$" then 
				DownUrls=Skcj.GetBody(DownUrls,DownNewUrl_s,DownNewUrl_o,False,False)
				IF DownUrls<>"$False$" then
					DownUrls=Trim(Skcj.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=""
	Else
		If  Zds_001="0" and Zdo_001<>"" then
			DownSize=Zdo_001
		Else
			DownSize=Skcj.GetBody(NewsCode,Zds_001,Zdo_001,False,False)
		End If
	End If
	
	If ZdType_002=0 then'软件语言设置
   		DownYY=""
	Else
		If  Zds_002="0" and Zdo_002<>"" then
			DownYY=Zdo_002
		Else
			DownYY=Skcj.GetBody(NewsCode,Zds_002,Zdo_002,False,False)
		End If
	End If
 	If ZdType_003=0 then'授权方式设置
   		DownSQ=""
	Else
		If  Zds_003="0" and Zdo_003<>"" then
			DownSQ=Zdo_003
		Else
			DownSQ=Skcj.GetBody(NewsCode,Zds_003,Zdo_003,False,False)
		End If
	End If
 	If ZdType_004=0 then'运行环境设置
   		DownPT=""
	Else
		If  Zds_004="0" and Zdo_004<>"" then
			DownPT=Zdo_004
		Else
			DownPT=Skcj.GetBody(NewsCode,Zds_004,Zdo_004,False,False)
		End If
	End If
 	If ZdType_005=0 then'演示地址设置
   		YSDZ=""
	Else
		If  Zds_005="0" and Zdo_005<>"" then
			YSDZ=Zdo_005
		Else
			YSDZ=Skcj.GetBody(NewsCode,Zds_005,Zdo_005,False,False)
		End If
	End If
 	If ZdType_006=0 then'注册地址设置
   		ZCDZ=""
	Else
		If  Zds_006="0" and Zdo_006<>"" then
			ZCDZ=Zdo_006
		Else
			ZCDZ=Skcj.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=Skcj.GetBody(NewsCode,Zds_007,Zdo_007,False,False)
			PhotoUrl=Trim(Skcj.FormatRemoteUrl(PhotoUrl,NewsUrl))
		End If
	End If  
End if

IF Colleclx=4 then '动漫
	If Downlist_s="" or  Downlist_o="" or DownUrl_s="" or DownUrl_o="" then'下载地址设置
    	FoundErr=True
    	ErrMsg=ErrMsg & "<br><li>动漫下载地址设置不能为空</li>" 
	Else	
		DownUrls=Skcj.GetBody(NewsCode,Downlist_s,Downlist_o,False,False)
		If DownUrls<>"$False$" then
			DownUrls=Skcj.GetBody(DownUrls,DownUrl_s,DownUrl_o,False,False)
			IF DownUrls<>"$False$" then
				DownUrls=Trim(Skcj.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=Skcj.ReplaceTrim(Skcj.GetHttpPage(DownUrls,selEncoding))
			DownUrls=Skcj.GetBody(DownUrls,DownNewlist_s,DownNewlist_o,False,False)
			If DownUrls<>"$False$" then 
				DownUrls=Skcj.GetBody(DownUrls,DownNewUrl_s,DownNewUrl_o,False,False)
				IF DownUrls<>"$False$" then
				 	DownUrls=Trim(Skcj.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=Skcj.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=Skcj.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=Skcj.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=Skcj.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=Skcj.ItemReplaceStr(Content,strReplace)'内容替换
   if  Colleclx =1 then 
  	set Rs = ConnItem.execute("select top 1 Dir from SK_cj where ID=1")
			Content=Skcj.ReplaceSaveRemoteFile(Content,"/",rs("Dir"),False,NewsUrl)'远程图片
			Content=Skcj.ReSaveRemoteFile(Content,NewsUrl,rs("Dir"),False)'远程文件
	Rs.close : set Rs=nothing
   End if
   'Content=SKcj.ReplaceSaveRemoteFile(Content,strInstallDir,strChannelDir,False,NewsUrl)'远程图片
   'Content=Skcj.ReSaveRemoteFile(Content,NewsUrl,strChannelDir,False)'远程文件
End If
if FoundErr<>True then
	set RsItem=ConnItem.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
      strChannelDir=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)
💿 文件大小 936 K
👤 上传用户 zzxt
📂 所属分类其他
🏷️ 相关标签

#自动 #家 #采集
⌨️ 快捷键说明

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