admin_softgather.asp

这些都是我以前学习是用到的源码

<!--#include file="setup.asp"-->
<!--#include file="check.asp"-->
<!--#include file="include/collection.asp"-->
<%
Server.ScriptTimeOut = 99999
Admin_header
'=====================================================================
' 软件名称：新云网站管理系统
' 当前版本：NewCloud Site Management System Version 2.1
' 文件名称：admin_SoftGather.asp
' 更新日期：2005-9-16
' 官方网站：新云网络(www.newasp.net www.newasp.cn) QQ：94022511
'=====================================================================
' Copyright 2002-2005 newasp.net - All Rights Reserved.
' newasp is a trademark of newasp.net
'=====================================================================
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>软件采集管理</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 ChkAdmin("SoftCollect") Then
	Server.Transfer ("showerr.asp")
	Response.End
End If

Dim MyNewCloud

On Error Resume Next

Set MyNewCloud = New Cls_SoftCollection
MyNewCloud.ChannelPath = Newasp.InstallDir & Newasp.ChannelDir
MyNewCloud.ModuleName = sModuleName
MyNewCloud.ReadSoftConfig
MyNewCloud.ShowCollection

If LCase(Request("Action")) <> "savenew" Then Admin_footer
Set MyNewCloud = Nothing
Set Mynewasp = Nothing
CloseConn

Class Cls_SoftCollection

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

	'--软件采集基本设置变量
	Private UseDownload, RepeatDeal, isProgress, TrueAddress, setInterval
	Private MaxDownSize, AllowDownExt, FilePrefix, FileSuffix

	'--采集项目变量
	Private ClassID, SpecialID, StopItem, Encoding, IsDown, downid, MaxAddress
	Private AutoClass, PathForm, SaveFilePath, AutoRename, IsNowTime, AllHits
	Private star, RemoveCode, RemoteListUrl, PaginalList, IsPagination
	Private startid, lastid, FindListCode, FindInfoCode, downpage
	Private RetuneClass, RemoveFile, strLeachName, strReplace

	Private AdminName, ItemID, HTTPHtmlCode, TableMarquee, ReferUrl
	Private blnFileToLocal, SoftSize, ShowDownAddress, strDownName, LoadFilePath

	'-- 每页显示数
	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
	'-- 下载名称
	Public Property Let DownName(ByVal NewValue)
		strDownName = NewValue
	End Property
	
	Private Sub Class_Initialize()
		On Error Resume Next
		
		ChannelID = 2
		maxperpage = 30
		ScriptName = "Admin_SoftGather.Asp"
		sModuleName = "软件"
		ChannelDir = "/soft/"
		strDownName = "点击此处下载"
	End Sub

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

	Public Sub ReloadSoftItem(ItemID)
		Dim rsItem
		SQL = "SELECT * FROM [NC_SoftItem] WHERE ItemID=" & ItemID
		Set rsItem = MyConn.Execute(SQL)
		Mynewasp.Value = rsItem.GetRows(1)
		Set rsItem = Nothing
	End Sub
	Public Sub ReloadSoftConfig()
		If Not IsConnection Then DatabaseConnection
		SQL = "SELECT * FROM [NC_SoftConfig] "
		Set Rs = MyConn.Execute(SQL)
		Mynewasp.Value = Rs.GetRows(1)
		Set Rs = Nothing
	End Sub
	Public Sub ReadSoftConfig()
		On Error Resume Next
		
		Mynewasp.Name = "SoftConfig"
		If Mynewasp.ObjIsEmpty() Then ReloadSoftConfig
		CacheData = Mynewasp.Value
		'第一次起用系统或者重启IIS的时候加载缓存
		Mynewasp.Name = "Date"
		If Mynewasp.ObjIsEmpty() Then
			Mynewasp.Value = date
		Else
			If CStr(Mynewasp.Value) <> CStr(date) Then
				Mynewasp.Name = "SoftConfig"
				Call ReloadSoftConfig
				CacheData = Mynewasp.Value
			End If
		End If
		
		UseDownload = CacheData(1, 0): RepeatDeal = CacheData(2, 0): isProgress = CacheData(3, 0)
		TrueAddress = CacheData(4, 0): setInterval = CacheData(5, 0): MaxDownSize = CacheData(6, 0)
		AllowDownExt = CacheData(7, 0): FilePrefix = CacheData(8, 0): FileSuffix = CacheData(9, 0)
		
	End Sub
	'--读取项目设置
	Public Sub ReadSoftItem(ItemID)
		On Error Resume Next
		
		Mynewasp.Name = "SoftItem" & ItemID
		If Mynewasp.ObjIsEmpty() Then ReloadSoftItem (ItemID)
		CacheItemData = Mynewasp.Value
		
		ClassID = CacheItemData(4, 0): SpecialID = CacheItemData(5, 0): StopItem = CacheItemData(6, 0)
		Encoding = CacheItemData(7, 0): IsDown = CacheItemData(8, 0): downid = CacheItemData(9, 0)
		MaxAddress = CacheItemData(10, 0): AutoClass = CacheItemData(11, 0): PathForm = CacheItemData(12, 0)
		SaveFilePath = CacheItemData(13, 0): AutoRename = CacheItemData(14, 0): IsNowTime = CacheItemData(15, 0)
		AllHits = CacheItemData(16, 0): star = CacheItemData(17, 0): RemoveCode = CacheItemData(18, 0)
		RemoteListUrl = CacheItemData(20, 0): PaginalList = CacheItemData(21, 0)
		IsPagination = CacheItemData(22, 0): startid = CacheItemData(23, 0): lastid = CacheItemData(24, 0)
		FindListCode = CacheItemData(25, 0): FindInfoCode = CacheItemData(26, 0): downpage = CacheItemData(27, 0)
		
		If Not IsNull(CacheItemData(28, 0)) Then
			RetuneClass = CacheItemData(28, 0)
		End If
		If Not IsNull(CacheItemData(29, 0)) Then
			RemoveFile = CacheItemData(29, 0)
		End If
		If Not IsNull(CacheItemData(30, 0)) Then
			strLeachName = CacheItemData(30, 0)
		End If

		If Not IsNull(CacheItemData(32, 0)) Then
			strReplace = CacheItemData(32, 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 = 2
		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_SoftItem WHERE ChannelID=" & ChannelID)(0)
		
		CurrentPage = Mynewasp.ChkNumeric(Request("page"))
		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_SoftItem] 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