admin_softgather.asp

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

				.Write "</td>"
				.Write " <td " & stylestr & ">"
				
				If DateDiff("D", Rs("lastime"), Now()) = 0 Then
					.Write "<font color=red>"
					.Write Rs("lastime")
					.Write "</font>"
				Else
					.Write Rs("lastime")
				End If
				.Write "</td>"
				.Write " <td " & stylestr & "><a href='?action=edit&ItemID=" & Rs("ItemID") & "&ChannelID=" & ChannelID & "'>编辑</a> | "
				.Write "<a href='?action=begin&ItemID=" & Rs("ItemID") & "&ChannelID=" & ChannelID & "'>采集</a> | "
				.Write "<a href='?action=demo&ItemID=" & Rs("ItemID") & "&ChannelID=" & ChannelID & "'>演示</a> | "
				.Write "<a href='?action=copy&ItemID=" & Rs("ItemID") & "&ChannelID=" & ChannelID & "'>克隆</a> | "
				.Write "<a href='?action=del&ItemID=" & Rs("ItemID") & "&ChannelID=" & ChannelID & "' onclick=""{if(confirm('您确定要删除此项目吗?')){return true;}return false;}"">删除</a>"
				.Write "</td>"
				.Write "</tr>"
				Rs.MoveNext
				i = i + 1
				If i >= maxperpage Then Exit Do
			Loop
		End If
		Rs.Close
		Set Rs = Nothing
		.Write "<tr>"
		.Write " <td colspan=""9"" class=""tablerow2"" align=""right"">"
		ShowListPage CurrentPage, Pcount, totalnumber, maxperpage, "&ChannelID=" & ChannelID & "", sModuleName & "采集"
		.Write "</td>"
		.Write "</tr>"
		If LCase(Request("action")) = "yes" Then
			.Write "<tr>"
			.Write " <td colspan=9 class=tablerow2>"
			.Write "<b class=style2>恭喜您！采集" & sModuleName & "全部完成..."
			.Write "成功采集" & sModuleName & " <font color=""#FF0000"">" & Session("SucceedCount") & "</font> 个，总费时 <font color=""#FF0000"">" & FormatNumber((Timer() - Request("D")), 2, -1) & "</font> 秒,完成时间" & Now() & "</b>"
			.Write "</td>"
			.Write "</tr>"
			Session("SucceedCount") = 0
		End If
		.Write "</table>"
		End With
	End Sub
	'=================================================
	'函数名：Read_Class_Name
	'作  用：读取分类名称
	'=================================================
	Private Function Read_Class_Name(ByVal ClassID)
		Dim rsClass

		On Error Resume Next
		Set rsClass = Newasp.Execute("select ClassName from NC_Classify where ClassID=" & ClassID)
		If rsClass.BOF And rsClass.EOF Then
			Read_Class_Name = "没有分类"
			Set rsClass = Nothing
			Exit Function
		End If
		Read_Class_Name = rsClass(0)
		Set rsClass = Nothing
	End Function
	'=================================================
	'函数名：Read_Special_Name
	'作  用：读取专题名称
	'=================================================
	Private Function Read_Special_Name(ByVal SpecialID)
		Dim rsSpecial
		On Error Resume Next
		Set rsSpecial = Newasp.Execute("select SpecialName from NC_Special where SpecialID=" & SpecialID)
		If rsSpecial.BOF And rsSpecial.EOF Then
			Read_Special_Name = "没有指定专题"
			Set rsSpecial = Nothing
			Exit Function
		End If
		Read_Special_Name = rsSpecial(0)
		Set rsSpecial = Nothing
	End Function
	'=================================================
	'函数名：GetClassID
	'作  用：读取分类ID
	'=================================================
	Public Function GetClassID(ByVal chanid, ByVal superior, ByVal inferior)
		superior = Replace(Trim(superior), "'", "")
		inferior = Replace(Trim(inferior), "'", "")
		chanid = Mynewasp.ChkNumeric(chanid)
		If Len(superior) = 0 Or chanid = 0 Then
			GetClassID = 0
			Exit Function
		End If
		On Error Resume Next
		Dim oRs, SQL, clsid, iRs
		clsid = 0
		SQL = "SELECT ClassID,ClassName,child FROM [NC_Classify] WHERE ChannelID=" & chanid & " And TurnLink=0 And ClassName='" & superior & "'"
		Set oRs = Newasp.Execute(SQL)
		If Not (oRs.BOF And oRs.EOF) Then
			If oRs("child") = 0 Then
				clsid = oRs("ClassID")
			Else
				If inferior <> "" Then
					Set iRs = Newasp.Execute("SELECT ClassID,ClassName,child FROM [NC_Classify] WHERE ChannelID=" & chanid & " And parentid=" & oRs("classid") & " And child=0 And TurnLink=0 And ClassName='" & inferior & "'")
					If Not (iRs.BOF And iRs.EOF) Then
						clsid = iRs("ClassID")
					End If
					Set iRs = Nothing
				End If
			End If
		End If
		Set oRs = Nothing
		GetClassID = clsid
	End Function
	Public Function ClassUpdateCount(ByVal ChannelID, ByVal sortid)
		Dim rscount, Parentstr
		On Error Resume Next
		Set rscount = Newasp.Execute("SELECT ClassID,Parentstr FROM [NC_Classify] WHERE ChannelID = " & CLng(ChannelID) & " And ClassID=" & CLng(sortid))
		If Not (rscount.BOF And rscount.EOF) Then
			Parentstr = rscount("Parentstr") & "," & rscount("ClassID")
			Newasp.Execute ("UPDATE [NC_Classify] SET ShowCount=ShowCount+1,isUpdate=1 WHERE ChannelID = " & CLng(ChannelID) & " And ClassID in (" & Parentstr & ")")
		End If
		Set rscount = Nothing
	End Function
	'=================================================
	'函数名：SelDownServer
	'作  用：下载服务器设置
	'=================================================
	Public Function SelDownServer(ByVal intdownid)
		Dim RsObj, SQL
		If Not IsNumeric(intdownid) Then intdownid = 0
		With Response
			.Write " <select name=""downid"" size=""1"">"
			.Write "<option value=""0"""
			If intdownid = 0 Then .Write " selected"
			.Write ">↓请选择下载服务器↓</option>"
			SQL = "SELECT downid,DownloadName,depth,rootid FROM NC_DownServer WHERE depth=0 And ChannelID=" & ChannelID
			Set RsObj = Newasp.Execute(SQL)
			Do While Not RsObj.EOF
				.Write "<option value=""" & RsObj("rootid") & """"
				If intdownid = RsObj("rootid") Then .Write " selected"
				.Write ">" & RsObj(1) & "</option>"
				RsObj.MoveNext
			Loop
			RsObj.Close
			Set RsObj = Nothing
			.Write "<option value=""0"">不使用下载服务器</option>"
			.Write "</select>"
		End With
	End Function
	'--软件采集基本设置
	Private Sub BasalConfig()
		With Response
			.Write "<form name=myform method=post action='?action=save'>" & vbCrLf
			.Write "<input type=hidden name='ChannelID' value='" & ChannelID & "'>" & vbCrLf
			.Write "<table  border=""0"" align=""center"" cellpadding=""3"" cellspacing=""1"" class=""TableBorder""> " & vbCrLf
			.Write "  <tr> " & vbCrLf
			.Write "    <th colspan=""2"">" & sModuleName & "采集基本设置</th> " & vbCrLf
			.Write "  </tr> " & vbCrLf
			.Write "  <tr> " & vbCrLf
			.Write "    <td width=""23%"" align=""right"" nowrap class=""TableRow1""><strong>下载功能开关：</strong></td> " & vbCrLf
			.Write "    <td width=""77%"" class=""TableRow1""><input name=""UseDownload"" type=""radio"" value=""0"""
			If CInt(UseDownload) = 0 Then .Write " checked"
			.Write ">" & vbCrLf
			.Write "      关闭　　" & vbCrLf
			.Write "      <input type=""radio"" name=""UseDownload"" value=""1"""
			If CInt(UseDownload) = 1 Then .Write " checked"
			.Write ">" & vbCrLf
			.Write "      打开　　" & vbCrLf
			 .Write "      <input type=""radio"" name=""UseDownload"" value=""9"""
			If CInt(UseDownload) = 9 Then .Write " checked"
			.Write ">" & vbCrLf
			.Write "      下载测试<font color='red'>(供测试程序用，不写数据库)</font></td> " & vbCrLf
			.Write "  </tr> " & vbCrLf
			.Write "  <tr> " & vbCrLf
			.Write "    <td align=""right"" class=""TableRow2""><strong>重复" & sModuleName & "处理：</strong></td> " & vbCrLf
			.Write "    <td class=""TableRow2""><input name=""RepeatDeal"" type=""radio"" value=""0"""
			If CInt(RepeatDeal) = 0 Then .Write " checked"
			.Write ">" & vbCrLf
			.Write "      跳过　　" & vbCrLf
			.Write "      <input type=""radio"" name=""RepeatDeal"" value=""1"""
			If CInt(RepeatDeal) > 0 Then .Write " checked"
			.Write ">" & vbCrLf
			.Write "      更新 </td> " & vbCrLf
			.Write "  </tr> " & vbCrLf
			.Write "  <tr> " & vbCrLf
			.Write "    <td align=""right"" class=""TableRow1""><strong>采集过程间隔时间：</strong></td> " & vbCrLf
			.Write "    <td class=""TableRow1""> <input name=""setInterval"" type=""text"" id=""setInterval"" size=""12"" value=""" & setInterval & """ maxlength=""10""> " & vbCrLf
			.Write "      <font color=""blue"">毫秒 </font></td> " & vbCrLf
			.Write "  </tr> " & vbCrLf
			.Write "  <tr> " & vbCrLf
			.Write "    <td align=""right"" class=""TableRow2""><strong>允许下载的文件大小：</strong></td> " & vbCrLf
			.Write "    <td class=""TableRow2""><input name=""MaxDownSize"" type=""text"" id=""MaxDownSize"" size=""12"" value=""" & MaxDownSize & """ maxlength=""10""> " & vbCrLf
			.Write "      <strong><font color=""blue"">KB </font></strong>&nbsp;&nbsp;<font color=""red"">* 不限制请输入“0”</font></td> " & vbCrLf
			.Write "  </tr> " & vbCrLf
			.Write "  <tr> " & vbCrLf
			.Write "    <td align=""right"" class=""TableRow1""><strong>允许下载的文件类型：</strong></td> " & vbCrLf
			.Write "    <td class=""TableRow1""><input name=""AllowDownExt"" type=""text"" id=""AllowDownExt"" size=""50"" value=""" & AllowDownExt & """ maxlength=""255""> " & vbCrLf
			.Write "      <font color=""blue"">* 每个文件类型请用“|”分开</font></td> " & vbCrLf
			.Write "  </tr> " & vbCrLf
			.Write "  <tr> " & vbCrLf
			.Write "    <td align=""right"" class=""TableRow2"">&nbsp;</td> " & vbCrLf
			.Write "    <td class=""TableRow2""><div align=""center""> " & vbCrLf
			.Write "        <input name=""B12"" type=""button"" class=""Button"" onclick=""javascript:history.go(-1)"" value=""返回上一页""> " & vbCrLf
			.Write "&nbsp;&nbsp; " & vbCrLf
			.Write "<input name=""B22"" type=""submit"" class=""Button"" value=""保存设置"">" & vbCrLf
			.Write "</div></td> " & vbCrLf
			.Write "  </tr> " & vbCrLf
			.Write "</table></form> " & vbCrLf
		End With
	End Sub
	'--保存基本设置
	Private Sub SaveConfig()
	
		If Len(Request.Form("AllowDownExt")) = 0 Then
			OutErrors ("请输入允许下载的文件类型!")
			Exit Sub
		End If
		Mynewasp.DelCahe ("SoftConfig")
		Set Rs = CreateObject("ADODB.Recordset")
		SQL = "SELECT * FROM NC_SoftConfig WHERE id=1"
		Rs.Open SQL, MyConn, 1, 3
			Rs("UseDownload") = Mynewasp.ChkNumeric(Request.Form("UseDownload"))
			Rs("RepeatDeal") = Mynewasp.ChkNumeric(Request.Form("RepeatDeal"))
			Rs("isProgress") = 0
			Rs("TrueAddress") = 0
			Rs("setInterval") = Mynewasp.ChkNumeric(Request.Form("setInterval"))
			Rs("MaxDownSize") = Mynewasp.ChkNumeric(Request.Form("MaxDownSize"))
			Rs("AllowDownExt") = Trim(Request.Form("AllowDownExt"))
			Rs("FilePrefix") = ""
			Rs("FileSuffix") = ""
		Rs.Update
		Rs.Close: Set Rs = Nothing
		OutScript ("保存采集基本设置成功!")
	End Sub
	'--项目设置步骤
	Private Sub SettingStep(ItemID)
		With Response
			.Write "<tr>" & vbNewLine
			.Write " <td colspan=2 align=center class=tablerow2>"
			.Write "<a href='?ChannelID=" & ChannelID & "' style=""color: green;"">管理首页</a> | "
			.Write "<a href='?action=edit&ChannelID=" & ChannelID & "&ItemID=" & ItemID & "' class=showmenu>设置第一步</a> | "
			.Write "<a href='?action=step2&ChannelID=" & ChannelID & "&ItemID=" & ItemID & "' class=showmenu>设置第二步</a> | "
			.Write "<a href='?action=step3&ChannelID=" & ChannelID & "&ItemID=" & ItemID & "' class=showmenu>设置第三步</a> | "
			.Write "<a href='?action=demo&ChannelID=" & ChannelID & "&ItemID=" & ItemID & "' class=showmenu>项目演示</a> | "
			.Write "<a href='?action=begin&ChannelID=" & ChannelID & "&ItemID=" & ItemID & "' style=""color: red;"">开始采集</a>"
			.Write "</td>" & vbNewLine
			.Write "</tr>" & vbNewLine
		End With
	End Sub
	'--编辑采集项目设置
	Private Sub CollectionItem(isEdit)
		Dim sClassSelect, RsObj, ItemTitle
		Dim i, ArrayRetuneClass
		Dim ArrayRemoveCode
		
		If isEdit Then
			Set Rs = MyConn.Execute("SELECT * FROM NC_SoftItem WHERE ChannelID=" & ChannelID & " And ItemID=" & ItemID)
			If Rs.BOF And Rs.EOF Then
				Set Rs = Nothing
				OutErrors ("错误的系统参数!")
				Exit Sub
			End If
			ItemTitle = "编辑采集项目 第一步"
			downid = Rs("downid")
		Else
			ItemID = 0
			downid = 0
			ItemTitle = "添加新的采集项目"
		End If
		With Response
			.Write "<script language=""javascript"" src=""include/Gatherer.js""></script>" & vbCrLf
			.Write "<form name=myform method=post action=""" & ScriptName & """ onSubmit='return CheckForm();'>" & vbCrLf
			.Write "<input type=""hidden"" name=""action"" value=""step2"">" & vbCrLf
			.Write "<input type=""hidden"" name=""ChannelID"" value=""" & ChannelID & """>" & vbCrLf
			.Write "<input type=""hidden"" name=""ItemID"" value=""" & ItemID & """>" & vbCrLf
			.Write "<input type=hidden name='change' value='yes'>" & vbNewLine
			.Write "<table  border=""0"" align=""center"" cellpadding=""3"" cellspacing=""1"" class=""TableBorder""> " & vbCrLf
			.Write "  <tr> " & vbCrLf
			.Write "    <th colspan=""2"">" & ItemTitle & "</th> " & vbCrLf
			.Write "  </tr> " & vbCrLf
			If ItemID > 0 Then
				SettingStep (ItemID)
			End If
			.Write "  <tr> " & vbCrLf