collect_itemmodify2.asp

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

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%option explicit%>
<!--#include file="../../Conn.asp"-->
<!--#include file="../../SysCls/KS_CommonCls.asp"-->
<!--#include file="../../SysCls/KS_CollectCommonCls.asp"-->
<!--#include file="../Inc/Session.asp"-->
<%
'===================================================================================================================
'软件名称：科汛网站管理系统
'当前版本：科汛网站管理系统 V2.2 0628个人Access版
'Copyright (C) 2006-2008 Kesion.Com  All rights reserved.
'产品咨询QQ：9537636,41904294
'技术支持QQ：111394,54004407 
'程序版权：科汛网络
'程序开发：科汛网络开发组（总策划：林文仲）
'E-Mail  :[e-mail] [e-mail]
'官方网站：http://www.kesion.com  
'演示站点：http://test.kesion.com 
'郑重声明:
'    ①、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
'    ②、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
'    ③、科汛网络保留此软件的法律追究权利
'===================================================================================================================
Dim KSCls
Set KSCls = New Collect_ItemModify2
KSCls.Execute()
Set KSCls = Nothing

Class Collect_ItemModify2
        Private KSCMS
		Private KMCObj
		Private ConnItem
		Private Rs, Sql, FoundErr, ErrMsg, Action
		Private SqlItem, RsItem
		Private ItemID, ItemName, WebName, WebUrl, ChannelID, strChannelDir, ClassID, SpecialID, ItemDemo, LoginType, LoginUrl, LoginPostUrl, LoginUser, LoginPass, LoginFalse
		Private ListUrl, LsString, LoString, ListPageType, LPsString, LPoString, ListStr, ListPageStr1, ListPageStr2, ListPageID1, ListPageID2, ListPageStr3
		Private tClass, tSpecial
		Private Sub Class_Initialize()
		  Set KSCMS=New CommonCls
		  Set KMCObj=New CollectCommonCls
		  Set ConnItem = KSCMS.ConnItem()
		End Sub
        Private Sub Class_Terminate()
		 Call KSCMS.CloseConnItem()
		 Call KSCMS.Closeconn
		 Set KSCMS=Nothing
		 Set KMCObj=Nothing
		End Sub
		Sub Execute()
		FoundErr = False
		
		Action = Trim(Request("Action"))
		ItemID = Trim(Request("ItemID"))
		
		If ItemID = "" Then
				ItemName = Trim(KSCMS.G("ItemName"))
				WebName = Trim(KSCMS.G("WebName"))
				WebUrl = Trim(KSCMS.G("WebUrl"))
				ChannelID = Trim(KSCMS.G("ChannelID"))
				ClassID = Trim(KSCMS.G("ClassID"))
				SpecialID = Trim(KSCMS.G("SpecialID"))
				ItemDemo = Trim(KSCMS.G("ItemDemo"))
				LoginType = KSCMS.G("LoginType")
				LoginUrl = Trim(KSCMS.G("LoginUrl"))
				LoginPostUrl = Trim(KSCMS.G("LoginPostUrl"))
				LoginUser = Trim(KSCMS.G("LoginUser"))
				LoginPass = Trim(KSCMS.G("LoginPass"))
				LoginFalse = Trim(KSCMS.G("LoginFalse"))
				
				If ItemName = "" Then
				   FoundErr = True
				   ErrMsg = ErrMsg & "<br><li>项目名称不能为空</li>"
				End If
				If WebName = "" Then
				   FoundErr = True
				   ErrMsg = ErrMsg & "<br><li>网站名称不能为空</li>"
				End If
		
				If ChannelID = "" Or ChannelID = 0 Then
				   FoundErr = True
				   ErrMsg = ErrMsg & "<br><li>未指定频道</li>"
				Else
				   ChannelID = CLng(ChannelID)
				End If
				If ClassID = "" Then
				   FoundErr = True
				   ErrMsg = ErrMsg & "<br><li>未指定栏目</li>"
				Else
				   Set Rs = conn.Execute("select * From KS_Class Where ID='" & ClassID & "'")
				   If Rs.BOF And Rs.EOF Then
						 FoundErr = True
						 ErrMsg = ErrMsg & "<br><li>找不到指定的栏目</li>"
					End If
					strChannelDir = Rs("Folder")
					Set Rs = Nothing
				End If
				
				If SpecialID = "" Then   SpecialID = 0
		
				
				If LoginType = "" Then
				   FoundErr = True
				   ErrMsg = ErrMsg & "<br><li>请选择登录类型</li>"
				Else
				   LoginType = CLng(LoginType)
				   If LoginType = 1 Then
						 If LoginUrl = "" Or LoginPostUrl = "" Or LoginUser = "" Or LoginPass = "" Or LoginFalse = "" Then
						 FoundErr = True
						 ErrMsg = ErrMsg & "<br><li>请将登录参数填写完整</li>"
					  End If
				   End If
				End If
				
				If FoundErr <> True Then
				   SqlItem = "Select top 1 ItemID,ItemName,WebName,WebUrl,ChannelID,ChannelDir,ClassID,SpecialID,ItemDemo,LoginType,LoginUrl,LoginPostUrl,LoginUser,LoginPass,LoginFalse From KS_CollectItem Where ItemName='" & ItemName & "'"
				   Set RsItem = Server.CreateObject("adodb.recordset")
				   RsItem.Open SqlItem, ConnItem, 1, 3
				   If RsItem.EOF And RsItem.BOF Then
				   RsItem.AddNew
				   RsItem("ItemName") = ItemName
				   RsItem("WebName") = WebName
				   RsItem("WebUrl") = WebUrl
				   RsItem("ChannelID") = ChannelID
				   RsItem("ChannelDir") = strChannelDir
				   RsItem("ClassID") = ClassID
				   RsItem("SpecialID") = SpecialID
				   If ItemDemo <> "" Then
					  RsItem("ItemDemo") = ItemDemo
				   End If
				   RsItem("LoginType") = LoginType
				   If LoginType = 1 Then
					  RsItem("LoginUrl") = LoginUrl
					  RsItem("LoginPostUrl") = LoginPostUrl
					  RsItem("LoginUser") = LoginUser
					  RsItem("LoginPass") = LoginPass
					  RsItem("LoginFalse") = LoginFalse
				   End If
				   ItemID = RsItem("ItemID")
				   RsItem.Update
				   Else
					 FoundErr = True
					 ErrMsg = "<br><li>存在相同的项目名称</li>"
				   End If
				   RsItem.Close
				   Set RsItem = Nothing
				End If

		Else
		   ItemID = CLng(ItemID)
		   		   SqlItem = "Select * From KS_CollectItem Where ItemID=" & ItemID
		   Set RsItem = Server.CreateObject("adodb.recordset")
		   RsItem.Open SqlItem, ConnItem, 1, 1
		   If RsItem.EOF And RsItem.BOF Then
			  FoundErr = True
			  ErrMsg = ErrMsg & "<br><li>没有找到该项目!</li>"
		   Else
			  LoginType = RsItem("LoginType")
			  LoginUrl = RsItem("LoginUrl")
			  LoginPostUrl = RsItem("LoginPostUrl")
			  LoginUser = RsItem("LoginUser")
			  LoginPass = RsItem("LoginPass")
			  LoginFalse = RsItem("LoginFalse")
			  ListStr = RsItem("ListStr")
			  LsString = RsItem("LsString")
			  LoString = RsItem("LoString")
			  ListPageType = RsItem("ListPageType")
			  LPsString = RsItem("LPsString")
			  LPoString = RsItem("LPoString")
			  ListPageStr1 = RsItem("ListPageStr1")
			  ListPageStr2 = RsItem("ListPageStr2")
			  ListPageID1 = RsItem("ListPageID1")
			  ListPageID2 = RsItem("ListPageID2")
			  ListPageStr3 = RsItem("ListPageStr3")
			  If ListPageStr3 <> "" Then
				 ListPageStr3 = Replace(ListPageStr3, "|", Chr(13))
			  End If
		   End If
		   RsItem.Close
		   Set RsItem = Nothing
		End If
		
		If Action = "SaveEdit" And FoundErr <> True Then
		   Call SaveEdit
		End If
		
		If FoundErr = True Then
		   Call KMCObj.WriteErrMsg(ErrMsg)
		Else
		   Call Main
		End If
		End Sub
		
		Sub Main()
		
		   If FoundErr = True Then
			  Call KMCObj.WriteErrMsg(ErrMsg)