admin_articlegather.asp

采用的是新云内核

<!--#include file="setup.asp"-->
<!--#include file="check.asp"-->
<!--#include file="include/collection.asp"-->
<%
Server.ScriptTimeOut = 18000
Admin_header
'=====================================================================
' 网站名称：黑客世界
' 当前版本：NewCloud Site Management System Version 2.1
' 文件名称：admin_account.asp
' 更新日期：2008-05-01
' 官方网站：黑客世界【www.skycap.cn】QQ：19901451
'=====================================================================
' Copyright 2008-2010 skycap.cn- All Rights Reserved.
' skycap.cn is a trademark of skycap.cn
'=====================================================================
If LCase(Request("Action")) <> "savenew" Then
	Response.Write "<table border=0 align=center cellpadding=3 cellspacing=1 class=TableBorder>"
	Response.Write " <tr>"
	Response.Write "   <th>" & sModuleName & "HTTP采集管理</th>"
	Response.Write " </tr>"
	Response.Write " <tr>"
	Response.Write "   <td class=TableRow1><b>说明：</b><br>"
	Response.Write "&nbsp;&nbsp;①、第一次使用本功能，请修改<a href='?action=config&ChannelID=" & ChannelID & "' class='showlink'>采集基本设置</a>；<br>"
	Response.Write "&nbsp;&nbsp;②、采集前请<font color=blue>编辑</font>采集项目，选择正确的分类，然后<font color=blue>演示</font>项目确定无误后再进行采集。<br>"
	Response.Write "	</td> </tr>"
	Response.Write " <tr>"
	Response.Write "   <td class=TableRow2><strong>操作选项：</strong> <a href='?ChannelID=" & ChannelID & "'>管理首页</a> | "
	Response.Write "   <a href='?action=add&ChannelID=" & ChannelID & "'>添加采集项目</a> | "
	Response.Write "   <a href='?action=config&ChannelID=" & ChannelID & "' class='showmenu'>采集基本设置</a> | "
	Response.Write "   <a href='?action=remove&ChannelID=" & ChannelID & "'>系统缓存清理</a></td> "
	Response.Write " </tr>"
	Response.Write "</table>"
	Response.Write "<br>"
End If

If Not Newasp.CheckAdmin("ArticleCollect") Then
	Server.Transfer ("showerr.asp")
	Response.End
End If

Dim MyNewCloud

On Error Resume Next
Set MyNewCloud = New Cls_NewsCollection
MyNewCloud.ChannelPath = Newasp.InstallDir & Newasp.ChannelDir
MyNewCloud.ModuleName = sModuleName
MyNewCloud.ReadNewsConfig
MyNewCloud.ShowCollection
If LCase(Request("Action")) <> "savenew" Then Admin_footer
Set MyNewCloud = Nothing
Set Mynewasp = Nothing
CloseConn

Class Cls_NewsCollection

	Private ScriptName, ChannelID, ChannelDir, sModuleName
	Private maxperpage, Action, isEdit, Rs, SQL, CacheData, CacheItemData

	Private AdminName, ItemID, HTTPHtmlCode, TableMarquee

	'--项目基本设置变量
	Private stopGather, RepeatDeal, MaxPicSize, AllowPicExt, setInterval
	'--采集项目变量
	Private ClassID, SpecialID, StopItem, Encoding, IsDown, AutoClass, PathForm
	Private IsNowTime, AllHits, star, RemoveCode, RemoteListUrl
	Private PaginalList, IsPagination, startid, lastid, FindListCode
	Private FindInfoCode, RetuneClass, IsNextPage, strReplace


	'-- 频道目录
	Public Property Let PageListNum(ByVal NewValue)
		maxperpage = NewValue
	End Property
	'-- 频道模块名称
	Public Property Let ModuleName(ByVal NewValue)
		sModuleName = NewValue
	End Property
	'-- 频道目录
	Public Property Let ChannelPath(ByVal NewValue)
		ChannelDir = NewValue
	End Property

	Private Sub Class_Initialize()
		On Error Resume Next
		
		ChannelID = 1
		maxperpage = 30
		ScriptName = "Admin_ArticleGather.Asp"
		sModuleName = "文章"
		ChannelDir = "/article/"
	End Sub

	Private Sub Class_Terminate()
		If IsObject(MyConn) Then
			MyConn.Close
			Set MyConn = Nothing
		End If
	End Sub

	Public Sub ReloadNewsItem(ItemID)
		If Not IsConnection Then DatabaseConnection
		Dim rsItem
		SQL = "SELECT * FROM [NC_NewsItem] WHERE ItemID=" & ItemID
		Set rsItem = MyConn.Execute(SQL)
		Mynewasp.Value = rsItem.GetRows(1)
		Set rsItem = Nothing
	End Sub
	Public Sub ReloadNewsConfig()
		If Not IsConnection Then DatabaseConnection
		SQL = "SELECT * FROM [NC_NewsConfig] "
		Set Rs = MyConn.Execute(SQL)
		Mynewasp.Value = Rs.GetRows(1)
		Set Rs = Nothing
	End Sub
	Public Sub ReadNewsConfig()
		On Error Resume Next
		
		Mynewasp.Name = "NewsConfig"
		If Mynewasp.ObjIsEmpty() Then ReloadNewsConfig
		CacheData = Mynewasp.Value
		'第一次起用系统或者重启IIS的时候加载缓存
		Mynewasp.Name = "Date"
		If Mynewasp.ObjIsEmpty() Then
			Mynewasp.Value = date
		Else
			If CStr(Mynewasp.Value) <> CStr(date) Then
				Mynewasp.Name = "NewsConfig"
				Call ReloadNewsConfig
				CacheData = Mynewasp.Value
			End If
		End If
		
		stopGather = CacheData(1, 0): RepeatDeal = CacheData(2, 0): MaxPicSize = CacheData(3, 0)
		AllowPicExt = CacheData(4, 0): setInterval = CacheData(5, 0)
	End Sub
	'--读取项目设置
	Public Sub ReadNewsItem(ItemID)
		On Error Resume Next
		
		Mynewasp.Name = "NewsItem" & ItemID
		If Mynewasp.ObjIsEmpty() Then ReloadNewsItem (ItemID)
		CacheItemData = Mynewasp.Value
		
		ClassID = CacheItemData(4, 0): SpecialID = CacheItemData(5, 0): StopItem = CacheItemData(6, 0)
		Encoding = CacheItemData(7, 0): IsDown = CacheItemData(8, 0)
		AutoClass = CacheItemData(9, 0): PathForm = CacheItemData(10, 0): IsNowTime = CacheItemData(11, 0)
		AllHits = CacheItemData(12, 0): star = CacheItemData(13, 0): RemoveCode = CacheItemData(14, 0)
		RemoteListUrl = CacheItemData(16, 0): PaginalList = CacheItemData(17, 0)
		IsPagination = CacheItemData(18, 0): startid = CacheItemData(19, 0): lastid = CacheItemData(20, 0)
		FindListCode = CacheItemData(21, 0): FindInfoCode = CacheItemData(22, 0)
		
		If Not IsNull(CacheItemData(23, 0)) Then
			RetuneClass = CacheItemData(23, 0)
		End If
		
		IsNextPage = CacheItemData(24, 0)
		
		If Not IsNull(CacheItemData(26, 0)) Then
			strReplace = CacheItemData(26, 0)
		End If
	End Sub
	Public Sub ShowCollection()
		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>"

		On Error Resume Next
		If Not IsConnection Then DatabaseConnection
		ChannelID = Mynewasp.ChkNumeric(Request("ChannelID"))
		If ChannelID = 0 Then ChannelID = 1
		ChannelID = CLng(ChannelID)
		AdminName = Newasp.CheckStr(Session("AdminName"))
		Action = LCase(Request("action"))
		Select Case Trim(Action)
		Case "copy"
			Call CopyNewItem
		Case "del"
			Call DeleteItem
		Case "config"
			Call BasalConfig
		Case "save"
			Call SaveConfig
		Case "edit"
			ItemID = Mynewasp.ChkNumeric(Request("ItemID"))
			If ItemID = 0 Then
				OutErrors ("请选择正确的项目ID!")
				Exit Sub
			End If
			isEdit = True
			Call CollectionItem(isEdit)
		Case "add"
			isEdit = False
			Call CollectionItem(isEdit)
		Case "step2"
			Call ItemStep2
		Case "step3"
			Call ItemStep3
		Case "step4"
			Call ItemStep4
		Case "demo"
			Call ItemStep4
		Case "begin"
			BeginCollection
		Case "savenew"
			DataCollection
		Case "remove"
			RemoveAllCache
		Case Else
			Call showmain
		End Select
	End Sub
	Private Sub showmain()
		Dim totalnumber, Pcount, CurrentPage
		Dim i, stylestr
		
		With Response
		.Write "<script language=""JavaScript"" src=""include/showpage.js""></script>" & vbNewLine
		.Write "<table border=""0"" align=""center"" cellpadding=""3"" cellspacing=""1"" class=""tableborder"">"
		.Write "<tr>"
		.Write " <th>项目名称</th>"
		.Write " <th>所属分类</th>"
		.Write " <th>所属专题</th>"
		.Write " <th>状态</th>"
		.Write " <th>上次采集时间</th>"
		.Write " <th>管理操作</th>"
		.Write "</tr>"
		
		totalnumber = MyConn.Execute("SELECT COUNT(ItemID) FROM NC_NewsItem WHERE ChannelID=" & ChannelID)(0)
		
		CurrentPage = Mynewasp.ChkNumeric(Request("page"))
		CurrentPage = CLng(CurrentPage)
		If CurrentPage = 0 Then CurrentPage = 1
		Pcount = CLng(totalnumber / maxperpage) '得到总页数
		If Pcount < totalnumber / maxperpage Then Pcount = Pcount + 1
		If CurrentPage < 1 Then CurrentPage = 1
		If CurrentPage > Pcount Then CurrentPage = Pcount
		
		Set Rs = CreateObject("ADODB.Recordset")
		SQL = "SELECT ItemID,ItemName,SiteUrl,ChannelID,ClassID,SpecialID,StopItem,lastime,RemoteListUrl FROM [NC_NewsItem] WHERE ChannelID=" & ChannelID & " ORDER BY lastime DESC,ItemID DESC"
		Rs.Open SQL, MyConn, 1, 1
		
		If Rs.BOF And Rs.EOF Then
			.Write "<tr><td align=center colspan=9 class=TableRow2>还没有添加任何采集项目！</td></tr>"
		Else
			If Pcount > 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
				.Write "<tr align=center>"
				.Write " <td " & stylestr & " title='点击打开目标网站'><a href='" & Rs("SiteUrl") & "' target=_blank>" & Rs("ItemName") & "</a></td>"
				.Write " <td " & stylestr & " title='点击查看目标网站列表'><a href='" & Rs("RemoteListUrl") & "' target=_blank>" & Read_Class_Name(Rs("ClassID")) & "</a></td>"
				.Write " <td " & stylestr & ">" & Read_Special_Name(Rs("SpecialID")) & "</td>"
				.Write " <td " & stylestr & ">"
				If Rs("StopItem") = 0 Then
					.Write "<font color=blue>√</font>"
				Else
					.Write "<font color=red>×</font>"
				End If
				.Write "</td>"
				.Write " <td " & stylestr & ">"
				
				If DateDiff("D", Rs("lastime"), Now()) = 0 Then
					.Write "<font color=red>"
					.Write Rs("lastime")
					.Write "</font>"
				Else