admin_itemdatabase.asp

淘客网上商店网站程序 淘客网上商店网站程序 淘客网上商店网站程序

	Randomize timer
	DbTemp = CStr(Clng(8999999*Rnd+1000000))
	if instr(DBPath,"/") then 
		strDBPath = left(DBPath,instrrev(DBPath,"/"))
	else
		strDBPath = left(DBPath,instrrev(DBPath,"\"))
	end if
	Set fso = Server.CreateObject(Trim(Cl.Web_Info(13)))
	If fso.FileExists(DBPath) Then
		Set Engine = CreateObject("JRO.JetEngine")
		Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBPath," Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & DbTemp & ".asa"
		fso.CopyFile strDBPath & DbTemp & ".asa",DBPath
		fso.DeleteFile(strDBPath & DbTemp & ".asa")
		ErrMsg="<br>数据库压缩成功!"
	Else
		FoundErr=True
		ErrMsg="<br><li>数据库没有找到!</li>"
	End If
	Set fso = Nothing
	Set Engine = Nothing
	If FoundErr=True Then
		Call Cl.ShowErr(ErrMsg)
	else
		Response.write Cl.ShowSuc(ErrMsg)
	End If
	openconn_c
end sub

sub BackUpData()
	Dim fso,BackPath,BackMdb
	BackPath=Trim(Request("BackPath"))
	BackMdb=Trim(Request("BackMdb"))
	If BackPath="" Then
		FoundErr=True
		ErrMsg="<br><li>请指定备份目录！</li>"
	else
		BackPath=Replace(BackPath," ","")
	End If
	If BackMdb="" Then
		FoundErr=True
		ErrMsg=ErrMsg & "<br><li>请指定备份文件名</li>"
	Else
		BackMdb=Replace(BackMdb," ","")
	End If
	If FoundErr<>True Then
		Set fso = Server.CreateObject(Trim(Cl.Web_Info(13)))
		If fso.FolderExists(server.mappath(BackPath))=False Then
				fso.CreateFolder(server.mappath(BackPath))
		End If
		If fso.FileExists(server.mappath(BackPath & "/" & BackMdb & ".asa"))=True then
				fso.DeleteFile(server.mappath(BackPath & "/" & BackMdb & ".asa"))
		End If
			fso.copyfile server.mappath(DbPath_C),server.mappath(BackPath & "/" & BackMdb & ".asa")
		If fso.FileExists(server.mappath(BackPath & "/" & BackMdb & ".asa"))=True Then
			ErrMsg="<br>数据库备份成功!"
			ErrMsg=ErrMsg & "<br>数据库备份为：" & BackPath & "/" & BackMdb & ".asa"
		Else
			FoundErr=True
			ErrMsg="<br><li>数据库备份失败!</li>"
		End If
		Set fso = Nothing
	End If
	If FoundErr=True Then
		Call Cl.ShowErr(ErrMsg)
	Else
		Response.write Cl.ShowSuc(ErrMsg)
	End If
end sub

sub RestoreData()
	dim backpath,fso
	backpath=Trim(request.form("backpath"))
	if backpath="" then
		response.write "<br><li>请指定原备份的数据库文件名！<li>"
		exit sub	
	end if
	backpath=server.mappath(backpath)
	On Error Resume Next
	Set Fso=server.createobject(Trim(Cl.Web_Info(13)))
	if fso.fileexists(backpath) then  					
		fso.copyfile Backpath,Server.mappath(DbPath_C)
		response.write "成功恢复数据！"
	else
		response.write "找不到指定的备份文件！"	
	end if
	Set Fso=Nothing
	Cl.SaveAdminLog
end sub

Sub DelBackup()
	dim Document,fso
	Document=request.form("Document")
	if Document="" then
		response.write "<br><li>请指定备份的数据库文件名！<li>"
		exit sub	
	end if
	Set Fso=server.createobject(Trim(Cl.Web_Info(13)))
	fso.DeleteFile(server.mappath(Document))
	response.write "成功删除数据库！"
	Set Fso=Nothing
	Cl.SaveAdminLog
End sub

Sub LeadOutData
	Dim fso,ItemMdb,ItemMdbPath,LeadOutMdb,RsF,SqlF,RsLead,SqlLead,ItemIDTemp
	LeadOutMdb=Trim(request.form("LeadOutMdb"))
	ItemID=Trim(request.form("ItemID"))
	ItemMdb=DbPath_C
	ItemMdbPath=Left(DbPath_C,Instrrev(DbPath_C,"/")-1)
	If Instr(ItemMdb,"/")>0 Then
		ItemMdbPath=Left(ItemMdb,InstrRev(ItemMdb,"/"))
	End If
	If LeadOutMdb="" then
		FoundErr=True
		ErrMsg="<br><li>数据库地址不能为空！</li>"
	End If
	If ItemID="" Then
		FoundErr=True
		ErrMsg=ErrMsg & "<br><li>请选择要导出的项目</li>"
	Else
		ItemID=Replace(ItemID," ","")
	End If
	If FoundErr<>True And ObjInstalled<>False Then
		Set fso = Server.CreateObject(Trim(Cl.Web_Info(13)))
		If Not fso.FileExists(Server.MapPath(LeadOutMdb)) Then
			'不存在则创建
			If fso.FileExists(Server.MapPath(ItemMdbPath & "ItemTemp.mdb")) Then
				fso.CopyFile Server.MapPath(ItemMdbPath & "ItemTemp.mdb"),Server.MapPath(LeadOutMdb)
			Else
				FoundErr=True
				ErrMsg=ErrMsg& "<br>用于导出项目的数据库：ItemTemp.mdb不存在！"
			End If
		End If
		set fso=Nothing
	End If

	If FoundErr<>True Then
		dim connstrLead,connLead
		Set connLead = Server.CreateObject("ADODB.Connection")
		connstrLead="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(LeadOutMdb)
		connLead.Open connstrLead
		If Err Then
			err.Clear
			FoundErr=True
			ErrMsg=ErrMsg & "<br>数据库链接出错，请确认数据库是否存在。"
		End If

		If FoundErr<>True Then
			ConnLead.execute("delete * from Item")
			ConnLead.execute("delete * from Filters")
			Set RsItem=server.createobject("adodb.recordset")			
			SqlItem="select * from Item where ItemID in(" & ItemID & ") order by ItemID DESC"			
			RsItem.open SqlItem,Conn_C,1,1
			If Not RsItem.Eof then
				Do while Not RsItem.Eof
					'打开数据库
					Set RsLead=server.createobject("adodb.recordset")			
					SqlLead="select * from Item"			
					RsLead.open SqlLead,ConnLead,1,3
					RsLead.AddNew
					for i=1 to Ubound(copyitem)
						RsLead(i)=RsItem(i)
					next
					RsLead.Update
					RsLead.Close
					Set RsLead=Nothing

					'过滤信息
					Set RsF=server.createobject("adodb.recordset")			
					SqlF="select * from Filters Where ItemID=" & RsItem("ItemID") & " order by ItemID DESC"			
					RsF.open SqlF,Conn_C,1,1				  
					If Not RsF.Eof then
						Do While Not RsF.Eof
							Set RsLead=server.createobject("adodb.recordset")			
							SqlLead="select * from Filters"			
							RsLead.open SqlLead,ConnLead,1,3
							RsLead.AddNew
							RsLead("ItemID")=ItemIDTemp
							RsLead("FilterName")=RsF("FilterName")
							RsLead("FilterObject")=RsF("FilterObject")
							RsLead("FilterType")=RsF("FilterType")
							RsLead("FilterContent")=RsF("FilterContent")
							RsLead("FisString")=RsF("FisString")
							RsLead("FioString")=RsF("FioString")
							RsLead("FilterRep")=RsF("FilterRep")
							RsLead("Flag")=RsF("Flag")
							RsLead("PublicTf")=RsF("PublicTf")
							RsLead("ModuleID")=RsF("ModuleID")
							RsLead.Update
							RsLead.Close
							Set RsLead=Nothing
						RsF.MoveNext
						Loop
					End If
					RsF.Close
					Set RsF=Nothing
				RsItem.MoveNext
				Loop
			End If
			RsItem.Close
			Set RsItem=Nothing
		End If
		ConnLead.close
		set connlead=Nothing
	End If
	If FoundErr<>True Then
		ErrMsg="<br>数据导出成功"
		ErrMsg=ErrMsg & "<br>数据导出为：" & LeadOutMdb
		Response.write Cl.ShowSuc(ErrMsg)
	Else
		Call Cl.ShowErr(ErrMsg)
	End If
End Sub

Sub ShowLeadInData
	Dim LeadInMdb,connstrLead,connLead,RsLead,SqlLead
	LeadInMdb=Trim(Request("LeadInMdb"))
	If LeadInMdb="" Then
		FoundErr=True 
		ErrMsg="<br><li>数据库地址不能为空！</li>"
	End If
	If FoundErr<>True Then
		On Error Resume Next
		Set connLead = Server.CreateObject("ADODB.Connection")
		connstrLead="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(LeadInMdb)
		connLead.Open connstrLead
		If Err Then
			err.Clear
			FoundErr=True
			ErrMsg=ErrMsg & "<br><li>数据库链接出错，请确认数据库是否存在。</li>"
		End If
		If FoundErr<>True Then
			Set RsLead=server.createobject("adodb.recordset")			
			SqlLead="select ItemID,ItemName,ChannelID,ClassID,SpecialID,Flag from Item order by ItemID DESC"			
			RsLead.open SqlLead,ConnLead,1,1
			If Not RsLead.Eof then
%>
<br>
<form method="post" action="Admin_ItemDatabase.asp?Action=LeadInData">
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border">
  <tr>
	<td colspan="2" align="center" class="title" height=22><b>项目导入</b></td>
	</tr>
</table>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border">
	<tr class="tdbg">			
		<td width="5%" height="22" align="center" class=ButtonList>选择</td>					  
		<td width="10%" align="center" class=ButtonList>项目名称</td>
		<td width="10%" height="22" align="center" class=ButtonList>所属频道</td> 
		<td width="10%" height="22" align="center" class=ButtonList>所属栏目</td> 
		<td width="10%" align="center" class=ButtonList>所属专题</td>	
		<td width="5%" align="center" class=ButtonList>状态</td>		
	</tr>			
<%
				Do While Not RsLead.Eof
%>
	<tr class="tdbg">			
		<td width="5%" height="22" align="center"><input type="checkbox" value=<%=RsLead("ItemID")%> name="ItemID" onclick="unselectall(this.form)"></td>					  
		<td width="10%" align="left"><%=RsLead("ItemName")%></td>
		<td width="10%" height="22" align="center"><%=ShowChannel_Name(RsLead("ChannelID"))%></td> 
		<td width="10%" height="22" align="center"><%=ShowClass_Name(RsLead("ChannelID"),RsLead("ClassID"))%></td> 
		<td width="10%" align="center"><%=ShowSpecial_Name(RsLead("ChannelID"),RsLead("SpecialID"))%></td>
		<td width="5%" align="center"><b>
<%				If RsLead("Flag")=True Then
					Response.write "<font color=green>√</font>"
				Else
					Response.Write "<font color=red>×</font>"
				End If%></b>
		</td>				
	</tr>	
<%
				RsLead.MoveNext
			Loop
%>
</table>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border">
	<tr class="tdbg">
	  <td align="center">
	<input name="LeadInMdb" type="hidden" value="<%=LeadInMdb%>">
		  <input name="chkAll" type="checkbox" id="chkAll" onclick=CheckAll(this.form) value="checkbox" >全选&nbsp;&nbsp;&nbsp;&nbsp;
	<input name="step" type="hidden" value="1">
	<input name="submit" type=submit value=" 确&nbsp;&nbsp;&nbsp;定 ">
	  </td>
	</tr>
</table>
</form>
<%
			Else
				FoundErr=True
				Errmsg=ErrMsg &  "<br>无任何记录！"
			End If
			RsLead.Close
			Set RsLead=Nothing
		End If
		connLead.close
		set connlead=Nothing
	End If
	If FoundErr=True Then
		Call Cl.ShowErr(ErrMsg)
	End If
End Sub


Sub LeadInData()
	Dim LeadInMdb,ItemMdb,ItemMdbPath
	ItemMdb=DbPath_C
	LeadInMdb=Trim(request.form("LeadInMdb"))
	ItemID=Trim(request.form("ItemID"))
	If LeadInMdb="" Then
		FoundErr=True
		ErrMsg="<br><li>数据库地址不能为空！</li>"
	End If
	If ItemID="" Then
		FoundErr=True
		ErrMsg= ErrMsg & "<br><li>请选择项目！</li>"
	Else
		ItemID=Replace(ItemID," ","")
	End If	 
	If FoundErr<>True Then  
		dim connstrLead,connLead,RsLead,SqlLead,RsF,SqlF,ItemIDTemp
		Set connLead = Server.CreateObject("ADODB.Connection")
		connstrLead="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(LeadInMdb)
		connLead.Open connstrLead
		If Err Then
			err.Clear
			ConnLead.Close
			Set ConnLead = Nothing
			FoundErr=True
	 		ErrMsg= ErrMsg & "<br><li>数据库链接出错，请确认数据库是否存在。</li>"
		End If
		If FoundErr<>True Then
			Set RsLead=server.createobject("adodb.recordset")			
			SqlLead="select * from Item where ItemID in(" & ItemID & ") order by ItemID ASC"			
			RsLead.open SqlLead,ConnLead,1,1
			If Not RsLead.Eof then
				Do While Not RsLead.Eof
					Set RsItem=server.createobject("adodb.recordset")			
					SqlItem="select top 1 * from Item"
					RsItem.open SqlItem,Conn_C,1,3
					RsItem.AddNew
					RsItem.AddNew
					for i=1 to Ubound(copyitem)
						RsItem(i)=RsLead(i)
					next
					RsItem.Update
					RsItem.close
					set rsItem=Nothing

					'过滤信息
					Set RsF=server.createobject("adodb.recordset")			
					SqlF="select * from Filters Where ItemID=" & RsLead("ItemID") & " order by FilterID ASC"			
					RsF.open SqlF,ConnLead,1,1				  
					If Not RsF.Eof then
						Do While Not RsF.Eof
							Set RsItem=server.createobject("adodb.recordset")			
							SqlItem="select top 1 * from Filters"			
							RsItem.open SqlItem,Conn_C,1,3
							RsItem.AddNew