cj_cls.asp

SK信息采集2.0功能介绍: 1.可针对任何静态网页,动态网页进行采集。包括htm,html,shtml,ASP,ASPX,JSP,PHP等。 2.增加自定文件采集.用户可采集网页中的所有文件.

<%
'=====================================================================
' 软件名称：SK采集管理系统
' 当前版本：2.0
' 更新日期：2006-9-7
' 官方网站：SK娱乐网(www.skxiu.com) QQ：85103270
'=====================================================================
Dim sk
Set sk = New SK_cj
'-----------整合版调用----------------
Private SKThumb : Set SKThumb =New Thumb
Private KSCMS : Set KSCMS=New CommonCls
'--------------------------------------
Class SK_cj
Private PicUrls_i,NewsUrlPaing_s,NewsUrlPaing_o,NewsPaingNext_Code,TypeArray_Url,TypeNews_Url  
Public sub item_sql(sqllx)
dim sqltiem
if sqllx <> "" and sqllx="edit" or sqllx="add" then
if sqllx="add" then 
SqlItem="Select top 1 * from Item"
else
SqlItem="select top 1 * from Item where ItemID="& ItemID
end if
   Set RsItem=server.CreateObject("adodb.recordset")
   RsItem.Open SqlItem,ConnItem,1,3
   if sqllx="add" then RsItem.AddNew
       	RsItem("ItemName")=ItemName
		RsItem("ClassID")=ClassID
	   	'RsItem("SpecialID")=SpecialID
		RsItem("selEncoding")=selEncoding
	   	RsItem("WebUrl")=WebUrl
	   	RsItem("ListStr")= ListStr
		RsItem("ListPaingType")=ListPaingType
		RsItem("LPsString")=LPsString
		RsItem("LPoString")=LPoString
		RsItem("ListPaingStr2")=ListPaingStr2
	    Select Case ListPaingType
		   Case 0 
				  ListUrl=ListStr
		   Case 1
			  RsItem("ListPaingStr2")=ListPaingStr2
			  RsItem("ListPaingID1")=ListPaingID1
			  RsItem("ListPaingID2")=ListPaingID2
			  ListUrl=Replace(ListPaingStr2,"{$ID}",CStr(ListPaingID1))
		   Case 2
			  RsItem("ListPaingStr3")=ListPaingStr3
			  If  Instr(ListPaingStr3,"|")>0  Then
					ListUrl=Left(ListPaingStr3,Instr(ListPaingStr3,"|")-1)
			  Else
					ListUrl=ListPaingStr3
			  End  If
		End Select
	   	RsItem("Colleclx")=3
		If Passed="yes" Then
			 RsItem("Passed")=1
		Else
			 RsItem("Passed")=0
		End If
		If SaveFiles="yes" Then
			 RsItem("SaveFileUrl")=SaveFileUrl
			 RsItem("SaveFiles")=1
		Else
			 RsItem("SaveFiles")=0
		End If
		if Thumb_WaterMark="yes" then  RsItem("Thumb_WaterMark")=1 else  RsItem("Thumb_WaterMark")=0 end if	
		If CollecOrder="yes" Then
			 RsItem("CollecOrder")=1
		Else
			 RsItem("CollecOrder")=0
		End If
		      If Script_Iframe="yes" Then
         RsItem("Script_Iframe")=1
      Else
         RsItem("Script_Iframe")=0
      End If
      If Script_Object="yes" Then
         RsItem("Script_Object")=1
      Else
         RsItem("Script_Object")=0
      End If
      If Script_Script="yes" Then
         RsItem("Script_Script")=1
      Else
         RsItem("Script_Script")=0
      End If
      If Script_Div="yes" Then
         RsItem("Script_Div")=1
      Else
         RsItem("Script_Div")=0
      End If
      If Script_Class="yes" Then
         RsItem("Script_Class")=1
      Else
         RsItem("Script_Class")=0
      End If
      If Script_Span="yes" Then
         RsItem("Script_Span")=1
      Else
         RsItem("Script_Span")=0
      End If
      If Script_Img="yes" Then
         RsItem("Script_Img")=1
      Else
         RsItem("Script_Img")=0
      End If
      If Script_Font="yes" Then
         RsItem("Script_Font")=1
      Else
         RsItem("Script_Font")=0
      End If
      If Script_A="yes" Then
         RsItem("Script_A")=1
      Else
         RsItem("Script_A")=0
      End If
      If Script_Html="yes" Then
         RsItem("Script_Html")=1
      Else
         RsItem("Script_Html")=0
      End If
	  If Script_Table="yes" Then
         RsItem("Script_Table")=1
      Else
         RsItem("Script_Table")=0
      End If
	  If Script_Tr="yes" Then
         RsItem("Script_Tr")=1
      Else
         RsItem("Script_Tr")=0
      End If
	  If Script_Td="yes" Then
         RsItem("Script_Td")=1
      Else
         RsItem("Script_Td")=0
      End If	  	  
	  RsItem("Stars")=Stars
      RsItem("ReadPoint")=ReadPoint
      RsItem("Hits")=Hits
	  RsItem("CollecNewsNum")=CollecNewsNum
	  RsItem("Colleclx")=cint(Colleclx)
	  if sqllx="add" then ItemID=RsItem("ItemID")
   RsItem.UpDate
   RsItem.Close
   Set RsItem=Nothing
end if
end sub
Public sub Article_Err_msg(erron)
select case erron
case 1
ItemName=Trim(Request.Form("ItemName"))
ChannelID=Trim(Request.Form("ChannelID"))
ClassID=Trim(Request.Form("ClassID"))
SpecialID=Trim(Request.Form("SpecialID"))
selEncoding=Trim(Request.Form("selEncoding"))
WebUrl=Trim(Request.Form("WebUrl"))
Colleclx=Trim(Request.Form("Colleclx"))
ListStr=Trim(Request.Form("ListStr"))
ListPaingType=Trim(Request.Form("ListPaingType"))
ListPaingStr2=Trim(Request.Form("ListPaingStr2"))
ListPaingID1=Trim(Request.Form("ListPaingID1"))
ListPaingID2=Trim(Request.Form("ListPaingID2"))
ListPaingStr3=Trim(Request.Form("ListPaingStr3"))
Passed=Trim(Request.Form("Passed"))
SaveFiles=Trim(Request.Form("SaveFiles"))
Thumb_WaterMark=Request.Form("Thumb_WaterMark")
SaveFileUrl=Trim(Request.Form("SaveFileUrl"))
Script_Iframe=Trim(Request.Form("Script_Iframe"))
Script_Object=Trim(Request.Form("Script_Object"))
Script_Script=Trim(Request.Form("Script_Script"))
Script_Div=Trim(Request.Form("Script_Div"))
Script_Class=Trim(Request.Form("Script_Class"))
Script_Span=Trim(Request.Form("Script_Span"))
Script_Img=Trim(Request.Form("Script_Img"))
Script_Font=Trim(Request.Form("Script_Font"))
Script_A=Trim(Request.Form("Script_A"))
Script_Html=Trim(Request.Form("Script_Html"))
Script_Table=Trim(Request.Form("Script_Table"))
Script_Tr=Trim(Request.Form("Script_Tr"))
Script_Td=Trim(Request.Form("Script_Td"))
Stars=Trim(Request.Form("Stars"))
ReadPoint=Trim(Request.Form("ReadPoint"))
Hits=Trim(Request.Form("Hits"))
Colleclx=Request.Form("Colleclx")
CollecNewsNum=Request.Form("CollecNewsNum")
If ItemName="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>项目名称不能为空</li>"
End If
If WebUrl="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>网站网址不能为空</li>" 
End If
If ClassID=0 Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>未指定栏目分类</li>"
End if
If ListStr="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>远程列表URL不能为空</li>" 
End If
If ListPaingType="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>请选择列表索引分页类型</li>" 
Else
   ListPaingType=Clng(ListPaingType)
   Select Case ListPaingType
   Case 0
   Case 1
      If ListPaingStr2="" Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>批量生成字符不能为空</li>"
      End If
      If isNumeric(ListPaingID1)=False or isNumeric(ListPaingID2)=False Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>批量生成的范围只能是数字</li>"
      Else
         ListPaingID1=Clng(ListPaingID1)
         ListPaingID2=Clng(ListPaingID2)
         If ListPaingID1=0 And ListPaingID2=0 Then
            FoundErr=True
            ErrMsg=ErrMsg & "<br><li>批量生成范围设置不正确</li>"
         End If
      End If
   Case 2
      If ListPaingStr3="" Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>列表索引分页不能为空，请手动添加</li>"
      Else
         ListPaingStr3=Replace(ListPaingStr3,CHR(13),"|") 
      End If
   Case Else
      FoundErr=True
      ErrMsg=ErrMsg & "<br><li>请选择列表索引分页类型</li>" 
   End Select
End if
If Stars="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>请选择文章评分等级！</li>"
Else
   Stars=Clng(Stars)
End If
If ReadPoint="" Then
   ReadPoint=0
Else
   ReadPoint=Clng(ReadPoint)
End if
If Hits="" Then
   Hits=0
Else
   Hits=Clng(Hits)
End if
case 2 
if Action1="" and Action="s2" then
Set RsItem=ConnItem.execute("select * from Item where ItemID=" & ItemID)
	  LsString=RsItem("LsString")
   	  LoString=RsItem("LoString")
	  HsString=RsItem("HsString")
  	  HoString=RsItem("HoString")
  	  ListUrl=RsItem("ListStr")
	  imhstr=RsItem("imhstr")
      imostr=RsItem("imostr")
	  x_tp=RsItem("x_tp")
	  RsItem.close
	  set RsItem=nothing
	  action1="edit"
else
LsString=Request.Form("LsString")
LoString=Request.Form("LoString")
HsString=Request.Form("HsString")
HoString=Request.Form("HoString")
imhstr=Request.Form("imhstr")
imostr=Request.Form("imostr")
x_tp=Request.Form("x_tp")	
Colleclx=Request.Form("Colleclx")  
end if
If ItemID="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>参数错误，请从有效链接进入</li>"
Else
   ItemID=Clng(ItemID)
End If
If LsString="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>列表开始代码不能为空</li>"
End If
If LoString="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>列表结束代码不能为空</li>" 
End If
If HsString="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>链接开始代码不能为空</li>"
End If
If HoString="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>链接结束代码不能为空</li>" 
End If
if FoundErr<>True Then
   SqlItem="Select * from Item Where ItemID=" & ItemID 
   Set RsItem=server.CreateObject("adodb.recordset")
   RsItem.Open SqlItem,ConnItem,1,3
  	  RsItem("LsString")=LsString
   	  RsItem("LoString")=LoString
	  RsItem("HsString")=HsString
  	  RsItem("HoString")=HoString
  	  ListUrl=RsItem("ListStr")
	  RsItem("x_tp")=x_tp
	  if x_tp=1 then
	  RsItem("imhstr")=imhstr
      RsItem("imostr")=imostr
	  
	  end if
   RsItem.UpDate
   RsItem.Close
   Set RsItem=Nothing
end if   
case 3
if Action1="add" or Action1="edit"  then
call SaveEdit
end if
If FoundErr<>True And Request.Form("ShowCode")="checkbox" Then
call GetTest()
End if
end select
End Sub 
Public sub Err_msg(erron)
select case erron
case 1
ItemName=Trim(Request.Form("ItemName"))
ChannelID=Trim(Request.Form("ChannelID"))
ClassID=Trim(Request.Form("ClassID"))
SpecialID=Trim(Request.Form("SpecialID"))
selEncoding=Trim(Request.Form("selEncoding"))
WebUrl=Trim(Request.Form("WebUrl"))
Colleclx=Trim(Request.Form("Colleclx"))
ListStr=Trim(Request.Form("ListStr"))
ListPaingType=Trim(Request.Form("ListPaingType"))
ListPaingStr2=Trim(Request.Form("ListPaingStr2"))
ListPaingID1=Trim(Request.Form("ListPaingID1"))
ListPaingID2=Trim(Request.Form("ListPaingID2"))
ListPaingStr3=Trim(Request.Form("ListPaingStr3"))
Passed=Trim(Request.Form("Passed"))
SaveFiles=Trim(Request.Form("SaveFiles"))
Thumb_WaterMark=Request.Form("Thumb_WaterMark")
SaveFileUrl=Trim(Request.Form("SaveFileUrl"))
Script_Iframe=Trim(Request.Form("Script_Iframe"))
Script_Object=Trim(Request.Form("Script_Object"))
Script_Script=Trim(Request.Form("Script_Script"))
Script_Div=Trim(Request.Form("Script_Div"))
Script_Class=Trim(Request.Form("Script_Class"))
Script_Span=Trim(Request.Form("Script_Span"))
Script_Img=Trim(Request.Form("Script_Img"))
Script_Font=Trim(Request.Form("Script_Font"))
Script_A=Trim(Request.Form("Script_A"))
Script_Html=Trim(Request.Form("Script_Html"))
Script_Table=Trim(Request.Form("Script_Table"))
Script_Tr=Trim(Request.Form("Script_Tr"))
Script_Td=Trim(Request.Form("Script_Td"))
Stars=Trim(Request.Form("Stars"))
ReadPoint=Trim(Request.Form("ReadPoint"))
Hits=Trim(Request.Form("Hits"))
Colleclx=Request.Form("Colleclx")
CollecNewsNum=Request.Form("CollecNewsNum")
If ItemName="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>项目名称不能为空</li>"
End If
If WebUrl="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>网站网址不能为空</li>" 
End If
If ClassID=0 Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>未指定栏目分类</li>"
End if
If ListStr="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>远程列表URL不能为空</li>" 
End If
If ListPaingType="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>请选择列表索引分页类型</li>" 
Else
   ListPaingType=Clng(ListPaingType)
   Select Case ListPaingType
   Case 0
   Case 1
      If ListPaingStr2="" Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>批量生成字符不能为空</li>"
      End If
      If isNumeric(ListPaingID1)=False or isNumeric(ListPaingID2)=False Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>批量生成的范围只能是数字</li>"
      Else
         ListPaingID1=Clng(ListPaingID1)
         ListPaingID2=Clng(ListPaingID2)
         If ListPaingID1=0 And ListPaingID2=0 Then
            FoundErr=True