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

📄 collect_itemmodify5.asp

📁 SK信息采集2.0功能介绍: 1.可针对任何静态网页,动态网页进行采集。包括htm,html,shtml,ASP,ASPX,JSP,PHP等。 2.增加自定文件采集.用户可采集网页中的所有文件.
💻 ASP
📖 第 1 页 / 共 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  :kesioncms@hotmail.com webmaster@kesion.com
'官方网站:http://www.kesion.com  
'演示站点:http://test.kesion.com 
'郑重声明:
'    ①、免费版本请在程序首页保留版权信息,并做上本站LOGO友情连接,商业版本无此要求;
'    ②、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息;
'    ③、科汛网络保留此软件的法律追究权利
'===================================================================================================================
Dim KSCls
Set KSCls = New Collect_ItemModify5
KSCls.Execute()
Set KSCls = Nothing

Class Collect_ItemModify5
        Private KSCMS
		Private KMCObj
		Private ConnItem
		Private ItemID, Action
		Private RsItem, SqlItem, SqlF, RsF, FoundErr, ErrMsg
		Private LoginType, LoginUrl, LoginPostUrl, LoginUser, LoginPass, LoginFalse, LoginResult, LoginData
		Private ListStr, LsString, LoString, ListPageType, LPsString, LPoString, ListPageStr1, ListPageStr2, ListPageID1, ListPageID2, ListPageStr3, HsString, HoString, HttpUrlType, HttpUrlStr
		Private TsString, ToString, CsString, CoString, DateType, DsString, DoString, UpDateTime, AuthorType, AsString, AoString, AuthorStr, CopyFromType, FsString, FoString, CopyFromStr, KeyType, KsString, KoString, KeyStr, NewsPageType, NPsString, NPoString, NewsPageStr, NewsPageEnd
		Private NewsPageNext, NewsPageNextCode, ContentTemp
		Private UrlTest, ListUrl, ListCode
		Private NewsUrl, NewsCode, NewsArrayCode, NewsArray
		Private Title, Content, Author, CopyFrom, Key
		Private Arr_Filters, Filteri, FilterStr
		Private UpDateType
		
		Private InfoPageStr
		Private InfoPageArrayCode,InfoPageArray,Testi

		
		Private UploadFiles, strInstallDir, strChannelDir
		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()
			strInstallDir = Trim(Request.ServerVariables("SCRIPT_NAME"))
			strInstallDir = Left(strInstallDir, InStrRev(LCase(strInstallDir), "/") - 1)
			strInstallDir = Left(strInstallDir, InStrRev(LCase(strInstallDir), "/"))
			strChannelDir = "Test"
			FoundErr = False
			
			ItemID = Trim(Request("ItemID"))
			Action = Trim(Request("Action"))
			
			If ItemID = "" Then
			   FoundErr = True
			   ErrMsg = ErrMsg & "<br><li>参数错误,项目ID不能为空</li>"
			Else
			   ItemID = CLng(ItemID)
			End If
			
			If Action = "SaveEdit" And FoundErr <> True Then
			   Call SaveEdit
			End If
			
			If FoundErr <> True Then
			   Call GetTest
			End If
			If FoundErr <> True Then
			   Call Main
			Else
			   Call KMCObj.WriteErrMsg(ErrMsg)
			End If
			End Sub
			Sub Main()
			Response.Write "<html>"
			Response.Write "<head>"
			Response.Write "<title>采集系统</title>"
			Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">"
			Response.Write "<link rel=""stylesheet"" type=""text/css"" href=""../inc/Admin_Style.css"">"
			Response.Write "<style type=""text/css"">"
			Response.Write "<!--" & vbCrLf
			Response.Write ".STYLE1 {color: #FF0000}" & vbCrLf
			Response.Write "-->" & vbCrLf
			Response.Write "</style>" & vbCrLf
			Response.Write "</head>" & vbCrLf
			Response.Write "<body oncontextmenu=""return false"" leftmargin=""0"" topmargin=""0"" marginwidth=""0"" marginheight=""0"">"
			Response.Write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""sortbutton"">"
			Response.Write "  <tr>"
			Response.Write "    <td  height=""22"" align=""center"" nowrap><table width=""100%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""border"">"
			Response.Write "      <tr>"
			Response.Write "        <td align=""center""><strong>操作步骤:</strong>编辑项目>> 基本设置 >> 列表设置 >> 链接设置 >> 正文设置 >> <span class=""STYLE1"">采样测试</span> >> 属性设置 >> 完成</td>"
			Response.Write "      </tr>"
			Response.Write "    </table></td>"
			Response.Write "  </tr>"
			Response.Write "</table>"
		
			Response.Write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""border"">"
			Response.Write "<tr align=""center"">"
			Response.Write "    <td colspan=""2"" valign=""bottom"">"
			Response.Write "    <font size=""3"">" & Title & "</font></td>"
			Response.Write "</tr>"
			Response.Write "  <tr align=""center"">"
			Response.Write "    <td colspan=""2"">"
			Response.Write "        作者:" & Author & "&nbsp;&nbsp;来源:" & CopyFrom & "&nbsp;&nbsp;更新时间:" & UpDateTime
			Response.Write "    </td>"
			Response.Write "  </tr>"
			Response.Write "  <tr>"
			Response.Write "    <td colspan=""2"" align=""center"" valign=""top"">"
			Response.Write "      <div style=""border: double #E7E7E7;height:345; overflow: auto; width:95%"" align=""center"">"
			Response.Write "      <table width=""95%"" height=""100%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""5"">"
			 Response.Write "       <tr>"
			 Response.Write "         <td height=""200"" valign=""top""><p>" & Content & "</p>"
			 Response.Write "         </td>"
			 Response.Write "       </tr>"
			 Response.Write "     </table>"
			 Response.Write "     </div>"
			 Response.Write "     <div align=""center"" style=""height:25""><b>关键字:" & Key & "</b></div>"
			 Response.Write "   </td>"
			 Response.Write " </tr>"
			Response.Write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""border"" >"
			Response.Write "<form method=""post"" action=""Collect_ItemAttribute.asp"" name=""form1"">"
			Response.Write "    <tr>"
			Response.Write "      <td colspan=""2"" align=""center"">"
			Response.Write "        <input name=""Action"" type=""hidden"" id=""Action"" value=""SaveEdit"">"
			Response.Write "        <input name=""ItemID"" type=""hidden"" id=""ItemID"" value=""" & ItemID & """>"
			Response.Write "        <input name=""Cancel"" type=""button"" id=""Cancel"" value="" 上&nbsp;一&nbsp;步 "" onClick=""window.location.href='javascript:history.go(-1)'"">"
			Response.Write "        &nbsp;"
			Response.Write "        <input  type=""submit"" name=""Submit"" value=""  下&nbsp;一&nbsp;步 ""></td>"
			Response.Write "    </tr>"
		  	Response.Write "</form>"
			Response.Write "</table>"
			
			if NewsPageType=1 And isarray(InfoPageArray) Then
					Response.Write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""border"" >"
				   Response.Write "  <tr>"
					Response.Write "   <td height=""22"" align=""center""><font color=red>分析得到的正文分页URL,请检查是否正确:</font>"
					Response.Write "<select name=pagelist style=""width:360"">"	
					For Testi = 0 To UBound(InfoPageArray)
					   Response.Write "<option>" & InfoPageArray(Testi) & "</option>"
					Next
				
				  Response.Write " </select></td>"
				  Response.Write "</tr>"
				  Response.Write "</table>"
		  End IF
		  
		  	Response.Write "</body>"
			Response.Write "</html>"
			End Sub
			'==================================================
			'过程名:SaveEdit
			'作  用:保存设置
			'参  数:无
			'==================================================
			Sub SaveEdit()
			
			TsString = Request.Form("TsString")
			ToString = Request.Form("ToString")
			CsString = Request.Form("CsString")
			CoString = Request.Form("CoString")
			
			DateType = Trim(Request.Form("DateType"))
			DsString = Request.Form("DsString")
			DoString = Request.Form("DoString")
			
			AuthorType = Trim(Request.Form("AuthorType"))
			AsString = Request.Form("AsString")
			AoString = Request.Form("AoString")
			AuthorStr = Request.Form("AuthorStr")
			
			CopyFromType = Trim(Request.Form("CopyFromType"))
			FsString = Request.Form("FsString")
			FoString = Request.Form("FoString")
			CopyFromStr = Request.Form("CopyFromStr")
			
			KeyType = Trim(Request.Form("KeyType"))
			KsString = Request.Form("KsString")
			KoString = Request.Form("KoString")
			KeyStr = Request.Form("KeyStr")
			
			
			NewsPageType = Trim(Request.Form("NewsPageType"))
			NPsString = Request.Form("NpsString")
			NPoString = Request.Form("NpoString")
			NewsPageStr = Request.Form("NewsPageStr")
			NewsPageEnd = Request.Form("NewsPageEnd")
		
			UrlTest = Trim(Request.Form("UrlTest"))
			
			If ItemID = "" Then
			   FoundErr = True
			   ErrMsg = ErrMsg & "<br><li>参数错误,项目ID不能为空</li>"
			Else
			   ItemID = CLng(ItemID)
			End If
			If UrlTest = "" Then
			   FoundErr = True
			   ErrMsg = ErrMsg & "<br><li>参数错误,数据传递时发生错误</li>"
			Else
				  NewsUrl = UrlTest
			End If
			If TsString = "" Then
			   FoundErr = True
			   ErrMsg = ErrMsg & "<br><li>标题开始标记不能为空</li>"
			End If
			If ToString = "" Then
			   FoundErr = True
			   ErrMsg = ErrMsg & "<br><li>标题结束标记不能为空</li>"
			End If
			If CsString = "" Then
			   FoundErr = True
			   ErrMsg = ErrMsg & "<br><li>正文开始标记不能为空</li>"
			End If
			If CoString = "" Then
			   FoundErr = True
			   ErrMsg = ErrMsg & "<br><li>正文结束标记不能为空</li>"
			End If
			
			If DateType = "" Then
			   FoundErr = True
			   ErrMsg = ErrMsg & "<br><li>请设置时间类型</li>"
			Else
			   DateType = CLng(DateType)
			   If DateType = 0 Then
			   ElseIf DateType = 1 Then
				  If DsString = "" Or DoString = "" Then
					 FoundErr = True
					 ErrMsg = ErrMsg & "<br><li>请将时间的开始/结束标记填写完整</li>"
				  End If
			   Else
				  FoundErr = True
				  ErrMsg = ErrMsg & "<br><li>参数错误,请从有效链接进入</li>"
			   End If
			End If
			
			If AuthorType = "" Then
			   FoundErr = True
			   ErrMsg = ErrMsg & "<br><li>请设置作者类型</li>"
			Else
			   AuthorType = CLng(AuthorType)
			   If AuthorType = 0 Then
			   ElseIf AuthorType = 1 Then
				  If AsString = "" Or AoString = "" Then
					 FoundErr = True
					 ErrMsg = ErrMsg & "<br><li>请将作者开始/结束标记填写完整!</li>"
				  End If
			   ElseIf AuthorType = 2 Then
				  If AuthorStr = "" Then
					 FoundErr = True
					 ErrMsg = ErrMsg & "<br><li>请指定作者</li>"
				  End If
			   Else
				  FoundErr = True
				  ErrMsg = ErrMsg & "<br><li>参数错误,请从有效链接进入</li>"
			   End If
			End If
			
			If CopyFromType = "" Then
			   FoundErr = True
			   ErrMsg = ErrMsg & "<br><li>请设置来源类型</li>"
			Else
			   CopyFromType = CLng(CopyFromType)
			   If CopyFromType = 0 Then
			   ElseIf CopyFromType = 1 Then
				  If FsString = "" Or FoString = "" Then
					 FoundErr = True
					 ErrMsg = ErrMsg & "<br><li>请将来源开始/结束标记填写完整!</li>"
				  End If
			   ElseIf CopyFromType = 2 Then
				  If CopyFromStr = "" Then
					 FoundErr = True
					 ErrMsg = ErrMsg & "<br><li>请指定来源</li>"
				  End If
			   Else
				  FoundErr = True
				  ErrMsg = ErrMsg & "<br><li>参数错误,请从有效链接进入</li>"
			   End If
			End If
			
			If KeyType = "" Then
			   FoundErr = True
			   ErrMsg = ErrMsg & "<br><li>请设置关键字类型</li>"
			Else
			   KeyType = CLng(KeyType)
			   If KeyType = 0 Then
			   ElseIf KeyType = 1 Then
				  If KsString = "" Or KoString = "" Then
					 FoundErr = True
					 ErrMsg = ErrMsg & "<br><li>关键字开始/结束标记不能为空</li>"
				  End If
			   ElseIf KeyType = 2 Then
				  If KeyStr = "" Then
					 FoundErr = True
					 ErrMsg = ErrMsg & "<br><li>请指定关键字</li>"
				  End If
			   Else
				  FoundErr = True
				  ErrMsg = ErrMsg & "<br><li>参数错误,请从有效链接进入</li>"
			   End If
			End If
			
			If NewsPageType = "" Then
			   FoundErr = True
			   ErrMsg = ErrMsg & "<br><li>请设置新闻分页类型</li>"
			Else
			   NewsPageType = CLng(NewsPageType)
			   If NewsPageType = 0 Then
			   ElseIf NewsPageType = 1 Then
				  If NPsString = "" Or NPoString = "" Then
					 FoundErr = True
					 ErrMsg = ErrMsg & "<br><li>分页代码开始/分页代码结束标记不能为空</li>"
				  End If
				  If NewsPageStr = "" or NewsPageEnd="" Then
					 FoundErr = True
					 ErrMsg = ErrMsg & "<br><li>分页URL开始代码/分页URL结束代码不能为空</li>"
				  End If
			   ElseIf NewsPageType = 2 Then
				  FoundErr = True
				  ErrMsg = ErrMsg & "<br><li>暂不支持手动设置分页类型</li>"
			   Else
				  FoundErr = True
				  ErrMsg = ErrMsg & "<br><li>参数错误,请从有效链接进入</li>"
			   End If
			End If
			
			If FoundErr <> True Then
			   SqlItem = "Select * From KS_CollectItem Where ItemID=" & ItemID
			   Set RsItem = Server.CreateObject("adodb.recordset")
			   RsItem.Open SqlItem, ConnItem, 2, 3
			   RsItem("TsString") = TsString
			   RsItem("ToString") = ToString
			   RsItem("CsString") = CsString
			   RsItem("CoString") = CoString
			
			   RsItem("DateType") = DateType
			   If DateType = 1 Then
				  RsItem("DsString") = DsString
				  RsItem("DoString") = DoString
			   End If
			
			   RsItem("AuthorType") = AuthorType
			   If AuthorType = 1 Then
				  RsItem("AsString") = AsString
				  RsItem("AoString") = AoString
			   ElseIf AuthorType = 2 Then
				  RsItem("AuthorStr") = AuthorStr
			   End If
			
			   RsItem("CopyFromType") = CopyFromType
			   If CopyFromType = 1 Then
				  RsItem("FsString") = FsString
				  RsItem("FoString") = FoString
			   ElseIf CopyFromType = 2 Then
				  RsItem("CopyFromStr") = CopyFromStr
			   End If
			
			   RsItem("KeyType") = KeyType
			   If KeyType = 1 Then
				  RsItem("KsString") = KsString
				  RsItem("KoString") = KoString
			   ElseIf KeyType = 2 Then
				  RsItem("KeyStr") = KeyStr
			   End If
			
			   RsItem("NewsPageType") = NewsPageType
			   If NewsPageType = 1 Then
				  RsItem("NPsString") = NPsString
				  RsItem("NPoString") = NPoString
				  RsItem("NewsPageStr") = NewsPageStr

⌨️ 快捷键说明

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