collection.asp

这是一套基于WEB的网站管理系统

<%
'=====================================================================
' 软件名称：新云网站管理系统
' 当前版本：NewCloud Site Manager System Version 2.0.0
' 文件名称：collection.asp
' 更新日期：2004-12-20
' 官方网站：新云网络(www.newasp.net) QQ：94022511
'=====================================================================
' Copyright 2002-2005 newasp.net - All Rights Reserved.
' newasp is a trademark of newasp.net
'=====================================================================
Class Collection_Cls
	Private Action,MyConn,i,stylestr,RsObj
	Private maxperpage,CurrentPage,TotalNumber,TotalPageNum
	Private ArticleTop,ArticleBest,ForbidEssay
	Private ClassID,ItemID,strWebSiteUrl
	Private NewsContent,NewsTitle,NewsRelated,NewsAuthor,NewsComeFrom
	Private NewsBriefTopic,NewsImageUrl,NewsUploadFileList
	Private sUploadDir,uploadpath,strUploadDir,PathFileName
	Private TableMarquee,DBPath,sTimeout,sChannelPath,startime
	Private ChannelID,FoundErr,ErrMsg,AdminName
	Private valSoftSize,sAllowExtName,nMaxFileSize

	Private DownAddress
	Private AutoFoundDir, SoftTop, SoftBest, DownType

	Private ClearNewLine, Orderid
	Private strDownName            
	Private SourceFileUrl          

	Public Property Let DataPath(ByVal NewValue)
		DBPath = NewValue
	End Property
	Public Property Let MaxListPage(ByVal NewValue)
		maxperpage = NewValue
	End Property
	Public Property Let DownFileTpye(ByVal NewValue)
		DownType = NewValue
	End Property
	Public Property Let ChannelPath(ByVal NewValue)
		sChannelPath = NewValue
	End Property
	Public Property Let Timeout(ByVal NewValue)
		sTimeout = CLng(NewValue)
	End Property
	Public Property Let chanid(ByVal NewValue)
		ChannelID = CInt(NewValue)
	End Property
	Public Property Let noNewline(ByVal NewValue)
		ClearNewLine = CInt(NewValue)
	End Property
	Public Property Let CollectOrder(ByVal NewValue)
		Orderid = CInt(NewValue)
	End Property
	Public Property Let DownName(ByVal NewValue)
		strDownName = NewValue
	End Property

	Private Sub Class_Initialize()
		On Error Resume Next
		DBPath = Server.MapPath("../DataBase/Collect.mdb")
		sTimeout = 1000
		blnProess = False
		sChannelPath = "../article/"
		sAllowExtName = "gif|jpg|jpge|bmp|png|swf"
		strDownName = "点击这里下载-&gt; 高速下载*"
		nMaxFileSize = 2000 * 1024
		maxperpage = 20
		DownType = 0
		Orderid = 1
		ClearNewLine = 0
		FoundErr = False
		AdminName = Newasp.CheckStr(Session("AdminName"))
	End Sub

	Private Sub Class_Terminate()
		'
	End Sub
	Public Sub ArticleCollect()
		On Error Resume Next
		Server.ScriptTimeout = 1800
		Admin_header
		startime = Timer
		Action = LCase(Request("action"))
		If Not Newasp.CheckAdmin("ArticleCollect") Then
			Server.Transfer ("showerr.asp")
			Response.End
		End If
		If Request("ChannelID") <> "" And Request("ChannelID") <> 0 Then
			ChannelID = CInt(Request("ChannelID"))
		Else
			ChannelID = 1
		End If
		
		Call ConnectionDB
		TableMarquee = "<p align=center><div style=""width:200px;height:30px;position:absolute;"">"
		TableMarquee = TableMarquee & "<table align=center border=0 cellpadding=0 cellspacing=1 bgcolor=#000000 width='200' height='30'><tr><td bgcolor=#0650D2><marquee align=middle behavior=alternate scrollamount=5 style=""font-size:9pt""><font color=#FFFFFF>...正在收集数据...请等待...</font></marquee></td></tr></table>"
		TableMarquee = TableMarquee & "</div></p>"
		Select Case Trim(Action)
		Case "edit"
			Call PageTop
			Call EditItem
		Case "config"
			Call PageTop
			Call ConfigItem
		Case "save"
			Call SaveConfig
		Case "del"
			Call Delitem
		Case "itemstep1"
			Call PageTop
			Call ItemStep1
		Case "itemstep2"
			Call PageTop
			Call ItemStep2
		Case "itemstep3"
			Call PageTop
			Call ItemStep3
		Case "itemstep4"
			Call PageTop
			Call ItemStep4
		Case "itemstep5"
			Call PageTop
			Call ItemStep5
		Case "demo"
			Call PageTop
			Call ItemStep5
		Case "collect"
			Call CollectArticle
		Case "copy"
			Call ItemCopy
		Case Else
			Call PageTop
			Call MainPage
		End Select
		If FoundErr = True Then
			ReturnError (ErrMsg)
		End If
		If Action <> "collect" And Action <> "save" Then
			Admin_footer
		End If
		If IsObject(MyConn) Then
			MyConn.Close
			Set MyConn = Nothing
		End If
	End Sub
	'=================================================
	'过程名：ConnectionDB
	'作  用：连接数据库
	'=================================================
	Private Sub ConnectionDB()
		On Error Resume Next
		Set MyConn = CreateObject("ADODB.Connection")
		MyConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBPath
		If Err Then
			Err.Clear
			Set MyConn = Nothing
			Response.Write "数据库连接出错，请检查连接字串。"
			Response.End
		End If
	End Sub

	Private Sub PageTop()
		Response.Write "<table border=0 align=center cellpadding=3 cellspacing=1 class=TableBorder>"
		Response.Write " <tr>"
		Response.Write "   <th>文章采集管理</th>"
		Response.Write " </tr>"
		Response.Write " <tr>"
		Response.Write "   <td class=TableRow2><strong>操作选项：</strong> <a href='admin_collect.asp?ChannelID=" & ChannelID & "'>管理首页</a> | "
		Response.Write "   <a href='?action=ItemStep1&ChannelID=" & ChannelID & "'>添加采集项目</a> | "
		Response.Write "   <a href='?action=config&ChannelID=" & ChannelID & "'>采集基本设置</a></td>"
		Response.Write " </tr>"
		Response.Write "</table>"
		Response.Write "<br>"
	End Sub
	'=================================================
	'过程名：MainPage
	'作  用：采集管理主页面
	'=================================================
	Private Sub MainPage()
		Dim Rs,SQL
		
		If Not IsNumeric(Request("page")) And Len(Request("page")) <> 0 Then
			Response.Write ("错误的系统参数!请输入整数")
			Response.End
		End If
		If Not IsEmpty(Request("page")) And Len(Request("page")) <> 0 Then
			CurrentPage = CInt(Request("page"))
		Else
			CurrentPage = 1
		End If
		If CInt(CurrentPage) = 0 Then CurrentPage = 1
		Response.Write "<table border=0 align=center cellpadding=3 cellspacing=1 class=tableborder>"
		Response.Write "<tr>"
		Response.Write " <th>项目名称</th>"
		Response.Write " <th>采集站点</th>"
		Response.Write " <th>所属频道</th>"
		Response.Write " <th>所属分类</th>"
		Response.Write " <th>所属专题</th>"
		Response.Write " <th>状态</th>"
		Response.Write " <th>上次采集时间</th>"
		Response.Write " <th>管理操作</th>"
		Response.Write "</tr>"
		TotalNumber = MyConn.Execute("Select Count(id) from NC_CollectArticle")(0)
		TotalPageNum = CInt(TotalNumber / maxperpage) '得到总页数
		If TotalPageNum < TotalNumber / maxperpage Then TotalPageNum = TotalPageNum + 1
		If CurrentPage < 1 Then CurrentPage = 1
		If CurrentPage > TotalPageNum Then CurrentPage = TotalPageNum
		Set Rs = CreateObject("ADODB.Recordset")
		SQL = "select * from [NC_CollectArticle] order by LastTime desc,id desc"
		Rs.Open SQL, MyConn, 1, 1
		If Rs.BOF And Rs.EOF Then
			Response.Write "<tr><td align=center colspan=9 class=TableRow2>还没有找到任何采集项目！</td></tr>"
		Else
			If TotalPageNum > 1 Then Rs.Move (CurrentPage - 1) * maxperpage
			i = 0
			Do While Not Rs.EOF And i < CInt(maxperpage)
				If Not Response.IsClientConnected Then Response.End
				If (i Mod 2) = 0 Then
					stylestr = "class=TableRow1"
				Else
					stylestr = "class=TableRow2"
				End If
				Response.Write "<tr align=center>"
				Response.Write " <td " & stylestr & "><a href='?action=collect&ItemID=" & Rs("id") & "&ChannelID=" & ChannelID & "' title='开始采集'>" & Rs("ItemName") & "</a></td>"
				Response.Write " <td " & stylestr & "><a href='" & Rs("WebSiteUrl") & "' target=_blank>" & Rs("WebSiteName") & "</a></td>"
				Response.Write " <td " & stylestr & ">" & Read_Channel_Name(Rs("ChannelID")) & "</td>"
				Response.Write " <td " & stylestr & ">" & Read_Class_Name(Rs("ClassID")) & "</td>"
				Response.Write " <td " & stylestr & ">" & Read_Special_Name(Rs("SpecialID")) & "</td>"
				Response.Write " <td " & stylestr & ">"
				If Rs("Estate") <> 0 Then
					Response.Write "<font color=blue>√</font>"
				Else
					Response.Write "<font color=red>×</font>"
				End If
				Response.Write "</td>"
				Response.Write " <td " & stylestr & ">"
				If Rs("LastTime") >= Date Then
					Response.Write "<font color=red>"
					Response.Write Rs("LastTime")
					Response.Write "</font>"
				Else
					Response.Write Rs("LastTime")
				End If
				Response.Write "</td>"
				Response.Write " <td " & stylestr & "><a href='?action=edit&id=" & Rs("id") & "&ChannelID=" & ChannelID & "'>编辑</a> | "
				Response.Write "<a href='?action=collect&ItemID=" & Rs("id") & "&ChannelID=" & ChannelID & "'>采集</a> | "
				Response.Write "<a href='?action=demo&ItemID=" & Rs("id") & "&ChannelID=" & ChannelID & "'>演示</a> | "
				Response.Write "<a href='?action=copy&ItemID=" & Rs("id") & "&ChannelID=" & ChannelID & "'>克隆</a> | "
				Response.Write "<a href='?action=del&ItemID=" & Rs("id") & "&ChannelID=" & ChannelID & "' onclick=""{if(confirm('您确定要删除此项目吗?')){return true;}return false;}"">删除</a>"
				Response.Write "</td>"
				Response.Write "</tr>"
				Rs.MoveNext
				i = i + 1
				If i >= maxperpage Then Exit Do
			Loop
		End If
		Rs.Close
		 Set Rs = Nothing
		Response.Write "<tr>"
		Response.Write " <td colspan=9 class=tablerow2>"
		Call showitempage
		Response.Write "</td>"
		Response.Write "</tr>"
		If LCase(Request("action")) = "yes" Then
			Response.Write "<tr>"
			Response.Write " <td colspan=9 class=tablerow2>"