admin_itemmanage.asp

小说站源代码文件

		<td colspan="8" class="alt1">所有采集操作必须单线进行，否则不保证采集完整性和安全性。采集操作大量占用CPU与内存资源，谨慎使用。</td>
    </tr>
    <tr style="padding: 0px 2px;" height="25" align="center">
      <td width="5%" class="tcat">选择?</td>
      <td width="25%" class="tcat">网站名称</td>
      <td width="5%" class="tcat">完成?</td>
      <td width="55%" 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=MaxItemPerPage
   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><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>
		<a title="　　映射目标站分类名称为本站分类名称，解决因分类名称不同所造成的作品归类问题." href="Admin_Itemclassdo.asp?info=list&ItemID=<%=ItemID%>" target="_blank"><font color="red">分类映射</font></a>
		</td>
	</tr>
    <%
      i=i+1
      If i>=MaxItemPerPage 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,MaxItemPerPage,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
    FoundErr=True
    ErrCodes=ErrCodes & "<li>目标采集数据库连接出错，请检查根目录中的采集数据库是否存在或已经更名为“OldItem.Mdb”。</li><br>"
End If