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

📄 admin_itemmanage.asp

📁 功能介绍： 一、会员功能模块 1、站内短信发布(设计中) 2、书架收藏夹 3、发表评论(功能不完善) 4、申请作家(与添书员整合) 5、申请添书员(与作家整合) 6、申请更新员
💻 ASP
📖 第 1 页 / 共 3 页
字号:
🔍
123 
      <td width="25%" class="tcat">网站名称</td>
      <td width="5%" class="tcat">完成?</td>
      <td width="42%" class="tcat">采集</td>
      <td width="23%" class="tcat">操作</td>
    </tr>
    <form name="formd" method="get" action="Admin_ItemManage.asp?Action=Derived">
<%if Rs.Eof then
response.write "<tr height=22><td colspan=8 align=center class=alt2>暂无采集项目！</td></tr>"
Else
   Rs.PageSize=MaxPerPage
   Allpage=Rs.PageCount
   If Currentpage>Allpage Then Currentpage=1
   Num=Rs.RecordCount
   Rs.MoveFirst
   Rs.AbsolutePage=CurrentPage
   i=0
   Do While Not Rs.Eof
      ItemID=Rs("ItemID")
      WebUrl=Rs("WebUrl")
      WebName=Rs("WebName")
      Itemfalst=Rs("Itemfalst")
%>
    <tr align="center" height="22">
      <td class=alt1><input type="checkbox" name="checked" value="<%=ItemID%>" class="form"></td>
      <td class=alt2><a href="<%=WebUrl%>" title="点击连接:<%=WebUrl%>" target="_bank"><%=WebName%></a></td>
      <td class=alt1><%If Itemfalst=0 Then%>
		<font color="red">×</font> <%else%> <font color="0076AE">√</font> <%end if%> </td>
      <td class=alt2>
      <%if rs("Islisted")=0 then%>
      <a href=Admin_ItemDownbook.asp?ItemID=<%=ItemID%> title="采集过程中可以停止采集进行其他工作<br>采集站资料页是纯数字ID形式">按ID范围</a>(<font color="#800000">可</font>停止)　<a href=Admin_ItemDownnovel.asp?ItemID=<%=ItemID%> title="　　采集过程中不可以停止，即便关闭浏览器，程序依然会在后台采集！<br>　　采集站资料页是纯数字ID形式">按ID范围</a>(<font color="#800000">不可</font>停止)　<a href=Admin_ItemDownbooks.asp?ItemID=<%=ItemID%> title="　　采集过程中不可以停止，即便关闭浏览器，程序依然会在后台采集！<br>　　采集站资料页是纯数字ID形式">按ID列表</a>
      <%ElseIf rs("Islisted")=1 then%>
      <a href=Admin_ItemDownbook.asp?ItemID=<%=ItemID%> title="采集过程中可以停止采集进行其他工作<br>采集站资料页是纯数字ID形式">按ID范围</a>(<font color="#800000">可</font>停止)　<a href=Admin_ItemDownnovel.asp?ItemID=<%=ItemID%> title="　　采集过程中不可以停止，即便关闭浏览器，程序依然会在后台采集！">按ID范围</a>(<font color="#800000">不可</font>停止)
      <%ElseIf rs("Islisted")=2 then%>
      <a href=Admin_ItemDownbooks.asp?ItemID=<%=ItemID%> title="　　采集过程中不可以停止，即便关闭浏览器，程序依然会在后台采集！<br>　　采集站资料页是非数字ID形式<br>　　无规律数字ID形式<br>　　数字、英文、拼音混合等<br>　　多级目录形式（递加型或递减型等等）！">按URL列表</a>(非ID、<font color="#800000">无规律</font>ID或<font color="#800000">多级目录</font>形式)
      <%End If%>
      </td>
      <td class=alt2><a href=Admin_ItemModify.asp?ItemID=<%=ItemID%> title="　　编辑此站点的采集项目设置，修正因该站点页面更新后造成的采集错误">编辑</a> 
      <a title="复制此站点新建一个相同的采集站？" href=Admin_ItemManage.asp?Action=copy&ItemID=<%=ItemID%>&Page=<%=CurrentPage%> onClick='return confirm("确定要复制此站点新建一个相同的采集站吗？");'>复制</a> 
      <a title="删除此站点采集项目？<br>请慎重，删除后数据将无法恢复！" href=Admin_ItemManage.asp?Action=Del&ItemID=<%=ItemID%>&Page=<%=CurrentPage%> onClick='return confirm("确定要删除此站点吗？请您慎重选择！");'>删除</a> 
      <a title="将此站点采集规则导出？" href=Admin_ItemManage.asp?Action=Derived&info=导出&checked=<%=ItemID%>&Page=<%=CurrentPage%> onClick='return confirm("确定要将此站点采集规则导出吗？");'>导出</a> 
      <a title="　　测试此站点与本服务器通信状态,确定是否可以采集." onclick="javascript:window.open('admin_checkWebUrl.asp?info=Itemadd&WebName=<%=WebName%>&WebUrl=<%=WebUrl%>','_blank','toolbar=no,location=no,directories=no,status=no,menubar=no,scrollbars=no,resizable=no,width=550,height=500')" style="cursor:hand">测试</a>
      </td>
    </tr>
    <%
      i=i+1
      If i>=MaxPerPage Then  Exit  Do
      Rs.MoveNext
   Loop
%>
    <tr>
      <td colspan='8' align="center" class="alt3"><input type="hidden" name="Page" value="<%=CurrentPage%>"><input type="hidden" name="Action" value="Derived">
			<input class="button" type="button" onclick="CheckAll(this.form)" value="全选" name="chkall" style="width: 45; height: 20">
			<input class="button" type="button" onclick="CheckOthers(this.form)" value="反选" name="chkOthers" style="width: 45; height: 20">
			<input class="button" type="submit" value="删除" name="info" style="width: 45; height: 20">
			<input class="button" type="submit" value="导出" name="info" style="width: 45; height: 20">
      </td>
    </tr>
    </form>
    <%End If
Rs.Close
Set  Rs=Nothing
%>
    <tr> 
      <td height="25" colspan="6" class=alt2><%Response.Write ShowPage("Admin_ItemManage.asp?Action=list",CurrentPage,Num,MaxPerPage,True,True," 个项目")%>
      </td>
    </tr>
</table>
<%end sub
Sub Del
Page=request.querystring("Page")
id=CheckSql(request("ItemID"))
CheckSqlnum(id)
id=int(id)
   If ID="" Then
      FoundErr=True
      ErrCodes=ErrCodes & "<br><li>请选择要删除的项目！</li>"
   Else
      ConnItem.Execute("Delete From [Item] Where ItemID In(" & ID & ")")
   End If
if FoundErr=True then
	Call ShowAdminErrMsg(ErrCodes,"javascript:history.go(-1)")
else
	call connclose() 
	Call ShowAdminSuccessMsg("<li>删除成功！</li><br>","admin_ItemManage.asp?Action=list&page="&page&"")
end if
End Sub

sub copy()
Page=request.querystring("Page")
id=CheckSql(request("ItemID"))
CheckSqlnum(id)
id=int(id)
If ID="" Then
    FoundErr=True
    ErrCodes=ErrCodes & "<li>请选择要复制的项目！</li><br>"
Else
	set rsitem=server.createobject("adodb.recordset")
	sql="select * from [Item] where Itemid="&id
	rsitem.Open sql,Connitem,1,1
	if not rsitem.eof then
		set rsitem1=server.createobject("adodb.recordset")
		sql="select * from Item"
		rsitem1.open sql,connitem,1,3
			rsitem1.addnew
			for j=1 to rsitem.Fields.Count-1
	            rsitem1(rsitem.fields(j).name)=rsitem.fields(j).value
			next
			rsitem1.update
		rsitem1.close
		set rsitem1=nothing
	else
		ErrCodes = ErrCodes & "<li>原项目不存在或为空!</li><br>"
		FoundErr=True
	end if
	rsitem.close
	set rsitem=nothing
end if
if FoundErr=True then
	Call ShowAdminErrMsg(ErrCodes,"javascript:history.go(-1)")
else
	call connclose() 
	Call ShowAdminSuccessMsg("<li>复制成功！已经新建一个相同的采集站,请及时修改！</li><br>","admin_ItemManage.asp?Action=list&page="&page&"")
end if
end sub

sub Derived()
Page=request.querystring("Page")
info=request.querystring("info")
if info="导出" then
	Itemdata=SiteSystemPath&"DerivedItem.Mdb"
	ItemSource=SiteSystemPath&"Template/DerivedItem.Mdb"
	FSOCopyFiles ItemSource,Itemdata
	if FoundErr=True then
		Call ShowAdminErrMsg(ErrCodes,"javascript:history.go(-1)")
	else
		Itemdata=SiteSystemPath&"DerivedItem.Mdb"
		connstrItems="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & server.mappath(""&Itemdata&"")
		On Error Resume Next
		Set connItems = Server.CreateObject("ADODB.Connection")
		connItems.Open connstrItems
		If Err Then
			err.Clear
			Set ConnItems = Nothing
		    FoundErr=True
		    ErrCodes=ErrCodes & "<li>目标采集数据库连接出错，请检查根目录中的采集数据库是否存在或已经更名为“DerivedItem.Mdb”。</li><br>"
		End If
		if FoundErr=True then
			Call ShowAdminErrMsg(ErrCodes,"javascript:history.go(-1)")
		else
			id=request("checked")
			If ID="" Then
			    FoundErr=True
			    ErrCodes=ErrCodes & "<li>请选择要导出的项目！</li><br>"
			Else
				viewArray=Split(ID,",")
				Num = UBound(viewArray)
				For i=0 To Num
					set rsitem=server.createobject("adodb.recordset")
					sql="select * from [Item] where Itemid="&viewArray(i)
					rsitem.Open sql,Connitem,1,1
					if not rsitem.eof then
						set rsitem1=server.createobject("adodb.recordset")
						sql="select * from Item"
						rsitem1.open sql,connitems,1,3
							rsitem1.addnew
							for j=1 to rsitem.Fields.Count-1
					            rsitem1(rsitem.fields(j).name)=rsitem.fields(j).value
							next
							rsitem1.update
						rsitem1.close
						set rsitem1=nothing
					else
						ErrCodes = ErrCodes & "<li>原项目"&viewArray(i)&"不存在或为空!</li><br>"
						FoundErr=True
					end if
					rsitem.close
					set rsitem=nothing
				Next
			end if
			if FoundErr=True then
				Call ShowAdminErrMsg(ErrCodes,"javascript:history.go(-1)")
			else
				call connclose() 
				Call ShowAdminSuccessMsg("<li>采集项目导出成功！数据导出到"&Itemdata&"请下载后删除！</li><br>","admin_ItemManage.asp?Action=list&page="&page&"")
			end if
		end if
	end if
elseif info="删除" then
	id=request("checked")
	If ID="" Then
		FoundErr=True
		ErrCodes=ErrCodes & "<br><li>请选择要删除的项目！</li>"
	Else
		viewArray=Split(ID, ",")
		Num = UBound(viewArray)
		For i=0 To Num
			ConnItem.Execute("Delete From [Item] Where ItemID In(" & viewArray(i) & ")")
		Next
	End If
	if FoundErr=True then
		Call ShowAdminErrMsg(ErrCodes,"javascript:history.go(-1)")
	else
		call connclose() 
		Call ShowAdminSuccessMsg("<li>删除成功！</li><br>","admin_ItemManage.asp?Action=list&page="&page&"")
	end if
else
	Call ShowAdminErrMsg("<li>参数传递错误!</li><br>","javascript:history.go(-1)")
end if
end sub

sub Introduct()
Itemdata=SiteSystemPath&"DerivedItem.Mdb"
connstrItems="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & server.mappath(""&Itemdata&"")
On Error Resume Next
Set connItems = Server.CreateObject("ADODB.Connection")
connItems.Open connstrItems
If Err Then
   err.Clear
   Set ConnItems = Nothing
    FoundErr=True
    ErrCodes=ErrCodes & "<li>目标采集数据库连接出错，请检查根目录中的采集数据库是否存在或已经更名为“DerivedItem.Mdb”。</li><br>"
End If
if FoundErr=True then
	Call ShowAdminErrMsg(ErrCodes,"javascript:history.go(-1)")
else
id=request("checked")
If ID="" Then
    FoundErr=True
    ErrCodes=ErrCodes & "<li>请选择要导入的项目！</li><br>"
Else
viewArray=Split(ID, ",")
Num = UBound(viewArray)
For i=0 To Num
	set rsitem=server.createobject("adodb.recordset")
	sql="select * from [Item] where Itemid="&viewArray(i)
	rsitem.Open sql,Connitems,1,1
	if not rsitem.eof then
		if request("Introducted")=1 then
			set rsitem1=server.createobject("adodb.recordset")
			sql="select * from Item where WebName='"&rsitem("WebName")&"'"
			rsitem1.open sql,connitem,1,3
				if not rsitem1.eof then
				else
					rsitem1.addnew
				end if
				for j1=1 to rsitem.Fields.Count-1
		            rsitem1(rsitem.fields(j1).name)=rsitem.fields(j1).value
				next
				rsitem1.update
			rsitem1.close
			set rsitem1=nothing
		else
			set rsitem1=server.createobject("adodb.recordset")
			sql="select * from Item"
			rsitem1.open sql,connitem,1,3
				rsitem1.addnew
				for j=1 to rsitem.Fields.Count-1
		            rsitem1(rsitem.fields(j).name)=rsitem.fields(j).value
				next
				rsitem1.update
			rsitem1.close
			set rsitem1=nothing
		end if
	else
		ErrCodes = ErrCodes & "<li>原项目"&viewArray(i)&"不存在或为空!</li><br>"
		FoundErr=True
	end if
	rsitem.close
	set rsitem=nothing
Next
end if
if FoundErr=True then
	Call ShowAdminErrMsg(ErrCodes,"javascript:history.go(-1)")
else
	call connclose() 
	Call ShowAdminSuccessMsg("<li>采集项目导入成功！</li><br>","admin_ItemManage.asp?Action=list")
end if
end if
end sub

sub oldIntroduct()
Itemdata=SiteSystemPath&"OldItem.Mdb"
connstrItems="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & server.mappath(""&Itemdata&"")
On Error Resume Next
Set connItems = Server.CreateObject("ADODB.Connection")
connItems.Open connstrItems
If Err Then
   err.Clear
   Set ConnItems = Nothing
123

⌨️ 快捷键说明

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