<%@language=vbscript codepage=936 %>
<%
'|-----------------------------------------------------------------------|
'|---------飞越软件信息采集器v1.0 for 动易网站管理系统2005/2006 ---------|
'|-------------------------- 作者:科技创造自由 --------------------------|
'|------------------ 飞越快乐家园  http://www.fy66.net/ -----------------|
'|--动易版主Top在本插件的编写过程中给予了大力支持,特此表示诚恳的感谢!----|
'|------ 本插件多处代码参考了SNA新闻采集系统for动易4.03,特此声明! -------|
'|----- 转载请保留版权信息,手下留情,留下的是对别人的尊重,谢谢! ----------|
'|-----------------------------------------------------------------------|
option explicit
response.buffer=true	
Const PurviewLevel=0
%>
<!--#include file="../conn.asp"-->
<!--#include file="../inc/Function.asp"-->
<!--#include file="Admin_ChkPurview.asp"-->
<!--#include file="Admin_ST_Conn.asp"-->
<!--#include file="Admin_ST_Function.asp"-->

<%
Collect
'dim Action
Dim Rs,Sql,RsItem,SqlItem,ItemID,ItemName,ClassID,SpecialID,Flag
'Dim FoundErr,ErrMsg
Dim ObjInstalled,tClass,tSpecial
ObjInstalled=IsObjInstalled("Scripting.FileSystemObject")
Action=trim(request("Action"))
dim TruePath,fso
TruePath=Server.MapPath("DataBackup")
Set fso = Server.CreateObject("Scripting.FileSystemObject")
%>
<html>
<head>
<title>软件采集系统</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" type="text/css" href="Admin_Style.css">
<SCRIPT language=javascript>
    function unselectall(thisform){
        if(thisform.chkAll.checked){
            thisform.chkAll.checked = thisform.chkAll.checked&0;
        }   
    }
    function CheckAll(thisform){
        for (var i=0;i<thisform.elements.length;i++){
            var e = thisform.elements[i];
            if (e.Name !="chkAll"&&e.disabled!=true)
                e.checked = thisform.chkAll.checked;
        }
    }
</script>
</head>
<body leftmargin="0" topmargin="0" marginwidth="0" marginheight="0">
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border">
  <tr class='topbg'> 
    <td height="22" colspan="2" align="center" ><strong>采 集 系 统 数 据 库 管 理</strong></td>
  </tr>
</table>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border">
  <tr class="tdbg"> 
    <td width="65" height="30"><strong>管理导航：</strong></td>
    <td height="30"><a href="Admin_ST_Database.asp">管理首页</a> | <a href="Admin_ST_Database.asp?Action=Compact">数据库压缩</a> | <a href="Admin_ST_Database.asp?Action=Backup">数据库备份</a> | <a href="Admin_ST_Database.asp?Action=Restore">数据库恢复</a> | <a href="Admin_ST_Database.asp?Action=LeadOut">项目导出</a> | <a href="Admin_ST_Database.asp?Action=LeadIn">项目导入</a><!-- | <a href="Admin_ST_Database.asp?Action=ShowUpData">检查更新数据</a>--> | <a href="Admin_ST_Database.asp?Action=Init">系统初始化</a></td>
  </tr>
</table>
<% 
if Action="Compact" or Action="CompactData" then
	call ShowCompact()
elseif Action="Backup" or Action="BackupData" then
        call ShowBackup()
elseif Action="Restore" or Action="RestoreData" then
        call ShowRestore()
elseif Action="LeadOut" or Action="LeadOutData" then 
	call ShowLeadOut()
elseif  Action="LeadIn" or Action="ShowLeadInData" or Action="LeadInData"  Then
    call  ShowLeadIn()
elseif  Action="ShowUpData" or Action="UpData"  Then
    call  ShowUpData()
elseif Action="Init" or Action="Clear" then
	call ShowInit()
	set conn=nothing 
Else
    call main()
End  If
call closeconn()
call closeconnitem()
%>

<%Sub Main%>
<br>
<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>
  <tr>
	<td colspan="2" align="left" class="tdbg" height="100">
	<br>
	<p align="center">欢迎使用软件采集系统，使用数据库管理功能之前请阅读此说明。</p>
	<p>1、数据库压缩：因使用了历史记录，数据库的记录数会越来越多，使用压缩功能将会使数据库体积减少不少。
	<p>2、数据库备份：备份数据以防意外。
	<p>3、数据库恢复：使用本功能可以恢复数据库，前提是有数据库备份。
	<p>4、项目导出：将软件采集项目和过滤项目导出到一个数据库
	<p>5、项目导入：和朋友交流本系统项目的设置心得，这可是少不了的哦。
	<!--<p>6、检查更新数据：在使用项目导入功能后必须使用本功能更新数据，否则不能正常采集。-->
	<p>6、系统初始化：清空采集项目、采集历史记录等数据，一旦清空将不可恢复。    
	<p>
	　</td>
	</tr>
</table>
<%End Sub%>



<%
Sub ShowCompact
	If Action="Compact" Then
%>
<form method="post" action="Admin_ST_Database.asp?Action=CompactData">
	<table class='border' width='100%' border='0' align='center' cellpadding='0' cellspacing='0'>
		<tr class='title'>
			<td align='center' height='22' valign='middle'><b>数据库在线压缩</b></td>
		</tr>
		<tr class='tdbg'>
			<td align='center' height='120' valign='middle'><br><br>压缩前，建议先备份数据库，以免发生意外错误。<br><br><br><input name="submit" type=submit value=" &nbsp;压缩数据库&nbsp; " <%If ObjInstalled=False Then response.Write "disabled"%>><br><%If ObjInstalled=False Then Response.Write "<br><b><font color=red>您的服务器不支持 FSO(Scripting.FileSystemObject)组件! 不能使用本功能</font></b>"%><br></td>
		</tr>
	</table>
</form>

<%
	Else
 	  Call CompactData()
	end if
End Sub
%>

<%
Sub ShowBackup
	If Action="Backup" Then
%>
<form method="post" action="Admin_ST_Database.asp?Action=BackupData">
	<table width='100%' border='0' align='center' cellpadding='0' cellspacing='0' class='border'>
		<tr class='title'>
			<td align='center' height='22' valign='middle'><b>备 份 数 据 库</b></td>
		</tr>
		<tr class='tdbg'>
			<td height='150' align='center' valign='middle'>
				<table cellpadding='3' cellspacing='1' border='0' width='100%'>
					<tr>
						<td width='200' height='33' align='right'>备份目录：</td><td><input type=text size=20 name="BackPath" value="Databackup"></td><td>相对路径目录，如目录不存在，将自动创建</td>
					</tr>
					<tr>
						<td width='200' height='34' align='right'>备份名称：</td><td height='34'><input type=text size=20 name="BackMdb" value="<%=Date()%>"></td><td height='34'>不用输入文件名后缀（默认为“.asa”）。如有同名文件，将覆盖</td>
					</tr>
					<tr align='center'>
						<td height='40' colspan='3' valign=middle><input name='submit' type=submit value=' 开始备份 ' <%If ObjInstalled=false Then response.Write "disabled"%>><br><%If ObjInstalled=false Then Response.Write "<b><font color=red>你的服务器不支持 FSO(Scripting.FileSystemObject)组件! 不能使用本功能</font></b>"%></td>
					</tr>
				</table>
			</td>
		</tr>
	</table>
</form>
<%	Else
	   Call BackUpData()
	End If
End Sub
%>
<%Sub ShowRestore
If Action="Restore" Then
%>

<form method="Post" action="Admin_ST_Database.asp?Action=RestoreData" onsubmit="return confirm('确定恢复数据吗？');">
	<table width='100%' class='border' border='0' align='center' cellpadding='0' cellspacing='0'>
		<tr class='title'>
			<td align='center' height='22' valign='middle'><b>数据库恢复</b></td>
		</tr>
		<tr class='tdbg'>
			<td align='center' height='150' valign='middle'>
				<table width='100%' border='0' cellspacing='0' cellpadding='0'>
					<tr>
						<td width='200' height='30' align='right'>原备份数据库路径（相对）：</td>
						<td height='30'><input name="RestorePath" size=50 maxlength='200' type="text" id="RestorePath" value="Databackup\PowerEasy.asa"></td>
					</tr>
					<tr align='center'>
						<td height='40' colspan='2'><input name="submit" type="submit" value=" 恢复数据 " <%If ObjInstalled=false Then response.Write "disabled"%>></td>
					</tr>
				</table>
			</td>
		</tr>
	</table>
</form>
<br><b>说明：</b><br>&nbsp;&nbsp;&nbsp;&nbsp;原备份数据库的扩展名必须为：asa或者asp<br><br>
<%
Else
   Call RestoreData()
end if
End Sub
%>









<%Sub  ShowLeadOut()
	If Action="LeadOut" Then
%>
<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">
<form method="post" name="myform" action="Admin_ST_Database.asp?Action=LeadOutData">
   <tr class="tdbg">         
      <td width="5%"  align="center" class=ButtonList height="22">选择</td>                 
      <td width="10%" align="center" class=ButtonList>项目名称</td>
      <td width="10%" align="center" class=ButtonList>所属频道</td> 
      <td width="10%" align="center" class=ButtonList>所属栏目</td> 
      <td width="10%" align="center" class=ButtonList>所属专题</td>   
      <td width="5%"  align="center" class=ButtonList>状态</td>      
   </tr>         
<%
	Set RsItem=server.createobject("adodb.recordset")         
	SqlItem="select ItemID,ItemName,ListStr,ListPaingType,ListPaingStr2,ListPaingID1,ListPaingID2,ListPaingStr3,ChannelID,ClassID,SpecialID,Flag from Item order by ItemID DESC"
	RsItem.open SqlItem,ConnItem,1,1
	If (Not RsItem.Eof)  And (Not RsItem.Bof) then
		Do While Not RsItem.Eof
%>
   <tr class="tdbg">         
      <td width="5%" height="22" align="center"><input type="checkbox" value=<%=RsItem("ItemID")%> name="ItemID" onclick="unselectall(this.form)"></td>                 
      <td width="10%" align="left"><%=RsItem("ItemName")%></td>
      <td width="10%" align="center"><%Call ShowName(1,RsItem("ChannelID"))%></td>   
      <td width="10%" align="center"><%Call ShowName(2,RsItem("ClassID"))%></td>   
      <td width="10%" align="center"><%Call ShowName(3,RsItem("SpecialID"))%></td>   
      <td width="5%" align="center">
      <%
			If RsItem("Flag")=True Then
				Response.write "√"
			Else
				Response.write "<font color=red>×</font>"
			End If
      %>
      </td>      
   </tr>   
<%
			RsItem.MoveNext
		Loop
%>
   <tr class="tdbg">
      <td colspan=7 height="52" align="center">
      <input name="chkAll" type="checkbox" id="chkAll" onclick=CheckAll(this.form) value="checkbox" >全选&nbsp;&nbsp;&nbsp;&nbsp;
      导出到数据库：<input type="text" name="LeadOutMdb" size="30" value="Databackup/LeadOut.mdb">
      <input type="submit" name="submit" value="导出" style="cursor: hand;background-color: #cccccc;">
      </td>
   </tr>
   <%Else%>
      <tr class="tdbg">
        <td colspan='9' class="tdbg" align="center"><br>系统中暂无采集项目！</td>
      </tr>
<%
	End If
	RsItem.Close
	Set RsItem=Nothing
%>
</form>
</table>
<%
	Else
	   Call LeadOutData()
	End If
End Sub
%>













<%

Sub ShowLeadIn
If  Action="LeadIn" Then
%>
<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">
<form method="post" action="Admin_ST_Database.asp?Action=ShowLeadInData">
   <tr class="tdbg">
      <td align="center" valign="middle" height="100">
        <br>数据库位置：<input name="LeadInMdb" type="text" id="LeadInMdb" size="23" value="Databackup/LeadIn.mdb">
      </td>
   </tr>
   <tr class="tdbg">
      <td align="center">
        <input name="submit" type=submit value=" 下&nbsp;一&nbsp;步 ">
      </td>
   </tr>
</form>
</table>
<%
ElseIf Action="ShowLeadInData" Then
   Call ShowLeadInData()
Else
   Call LeadInData()
End if
End Sub

Sub ShowUpData()
If Action="ShowUpData" Then
%>
<form method="post" action="Admin_ST_Database.asp?Action=UpData">
<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>
	<td height="34" align='left' class="tdbg">请选择要更新的数据</td>
  </tr>
  <tr>
	<td align='left' class="tdbg">
        <input name="ChannelData" type="checkbox" disabled value="yes" checked>频道部分数据&nbsp;&nbsp;
        <input type="checkbox" name="ItemData" value="yes" checked disabled>项目数据
    </td>
  </tr>
  <tr align='center'>
        <td height='40' colspan='3' class="tdbg"><input name='submit' type=submit value=' 开始更新 '></td>
  </tr>
</table>
</form>
<%Else
   Call UpData()
End If
End Sub

sub ShowInit()
%>
<table cellpadding="0" cellspacing="1" border="0" width="100%" class="border" align=center>
<form action="Admin_ST_Database.asp" method="post" name="form1" id="form1" onSubmit="return confirm('确实要清除选定的表吗？一旦清除将无法恢复！');">
  <tr>
	<td colspan="2" align="center" class="title"><b>系 统 初 始 化</b></td>
    </tr>
    <tr class="tdbg"> 
      <td width="100%" height="150" align=center valign="middle">
<%
if Action="Clear" then
	call ClearData()
else
%>        <b><br>
        <font color="#FF6600">请慎用此功能，因为一旦清除将无法恢复！</font><br>
        <br>
        </b> 
        <table border="0" cellspacing="0" cellpadding="5">
          <tr>
            <td align="center"><b>请选择你要清空的数据库：</b></td>
          </tr>
          <tr>
            <td><fieldset>
		<table width="500" border="0" cellpadding="0" cellspacing="5">
          <tr> 
            <td width="25%"><input name="Item" type="checkbox" id="Item" value="yes" style="border: 0px;background-color: #eeeeee;"> 采集项目</td>
            <td width="25%"><input name="Histroly" type="checkbox" id="Histroly" value="yes" style="border: 0px;background-color: #eeeeee;"> 历史记录</td>
            <!--<td width="25%"><input name="FilesType" type="checkbox" id="FilesType" value="yes" style="border: 0px;background-color: #eeeeee;"> 文件类型 </td>-->
            <td width="25%"><input name="Filters" type="checkbox" id="Filters" value="yes" style="border: 0px;background-color: #eeeeee;"> 过滤设置</td>
          </tr>
        </table></fieldset></td>
          </tr>
        </table>  
		  <tr class="tdbg">
            <td align="center"><input name="Action" type="hidden" id="Action2" value="Clear">
              <input type="submit" name="Submit" value="&nbsp;清除数据&nbsp;"></td>
          </tr>
        <%
end if
%>
      </td>
    </tr>
</form>
</table>
<%
end sub
%>
</body>
</html>
<%
sub CompactData()
	Dim Engine,strDBPath,DBPath
	DBPath = server.mappath(DbItem)'数据库文件
	if instr(DBPath,"/") then 
		strDBPath = left(DBPath,instrrev(DBPath,"/"))
	else
		strDBPath = left(DBPath,instrrev(DBPath,"\"))
	end if
	On Error Resume Next
	Set ConnItem=Nothing
	On Error GoTo 0
	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 & "itemtemp.mdb"
		fso.CopyFile strDBPath & "itemtemp.mdb",DBPath
		fso.DeleteFile(strDBPath & "itemtemp.mdb")
		Set fso = nothing
		Set Engine = nothing
		response.write"数据库压缩成功!"
	Else
		response.write"数据库没有找到!"
	End If
end sub

sub BackUpData()
	Dim BackPath,BackMdb
        BackPath=Trim(Request("BackPath"))
        BackMdb="Collect_" & 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
	   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(DbItem),server.mappath(BackPath & "/" & BackMdb & ".asa")
	   If fso.FileExists(server.mappath(BackPath & "/" & BackMdb & ".asa"))=True Then
              response.write "数据库备份成功,数据库备份为：" & BackPath & "/" & BackMdb & ".asa"
           Else
              response.write "数据库备份失败!"
	   End If
	   Set fso = nothing
	End If
end sub

sub RestoreData()
	Dim RestorePath
        RestorePath=request.form("RestorePath")
        If RestorePath="" Then
           FoundErr=True
           ErrMsg="<br><li>请指定原备份的数据库文件名！</li>"
        else
           RestorePath=Replace(RestorePath," ","")
        End If
        If FoundErr<>True Then
           If fso.FileExists(server.mappath(RestorePath))=True then
              fso.copyfile server.mappath(RestorePath),server.mappath(DbItem)
              response.write "数据库恢复成功!"
           Else
              response.write "<br><li>数据库：" & RestorePath & " 不存在！"
           End If
	   Set fso = nothing
	End If
end sub

sub showContent()
%>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border">
	<tr class="tdbg">
          <td rowspan="2" align="right">操作选项：</td>
          <td rowspan="2">
  	<form method="Post" action="Admin_ST_Database.asp?Action=RestoreData" onsubmit="return confirm('确定恢复数据吗？');">
	<input name="RestorePath" type="text" id="RestorePath" value="Databackup\2003-3-3.asa">
	<input name="submit" type="submit" value="&nbsp;恢复数据&nbsp;" style="cursor: hand;background-color: #cccccc;" <%If ObjInstalled=false Then response.Write "disabled"%>>
	</form>
	  </td>
	</tr>
</table>
<%
end sub

Sub LeadOutData()
   Dim LeadOutMdb,RsF,SqlF,RsLead,SqlLead,ItemIDTemp
   LeadOutMdb=trim(request.form("LeadOutMdb"))
   ItemID=trim(request.form("ItemID"))
   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
      If fso.FileExists(Server.MapPath(LeadOutMdb)) Then
      Else
         '不存在则创建
         If fso.FileExists(Server.MapPath("ItemTemp.mdb")) Then
            fso.CopyFile Server.MapPath("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,ConnItem,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
               RsLead("ItemName")=RsItem("ItemName")
               RsLead("ChannelID")=RsItem("ChannelID")
               RsLead("ClassID")=RsItem("ClassID")
               RsLead("SpecialID")=RsItem("SpecialID")
               RsLead("WebName")=RsItem("WebName")
               RsLead("WebUrl")=RsItem("WebUrl")
               RsLead("ItemDemo")=RsItem("ItemDemo")
               RsLead("LoginType")=RsItem("LoginType")
               RsLead("LoginUrl")=RsItem("LoginUrl")
               RsLead("LoginPostUrl")=RsItem("LoginPostUrl")
               RsLead("LoginUser")=RsItem("LoginUser")
               RsLead("LoginPass")=RsItem("LoginPass")
               RsLead("LoginFalse")=RsItem("LoginFalse")
               RsLead("ListStr")=RsItem("ListStr")
               RsLead("LsString")=RsItem("LsString")
               RsLead("LoString")=RsItem("LoString")
               RsLead("ListPaingType")=RsItem("ListPaingType")
               RsLead("LPsString")=RsItem("LPsString")
               RsLead("LPoString")=RsItem("LPoString")
               RsLead("ListPaingStr1")=RsItem("ListPaingStr1")
               RsLead("ListPaingStr2")=RsItem("ListPaingStr2")
               RsLead("ListPaingID1")=RsItem("ListPaingID1")
               RsLead("ListPaingID2")=RsItem("ListPaingID2")
               RsLead("ListPaingStr3")=RsItem("ListPaingStr3")
               RsLead("HsString")=RsItem("HsString")
               RsLead("HoString")=RsItem("HoString")
               RsLead("HttpUrlType")=RsItem("HttpUrlType")
               RsLead("HttpUrlStr")=RsItem("HttpUrlStr")
               RsLead("TsString")=RsItem("TsString")
               RsLead("ToString")=RsItem("ToString")
               RsLead("CsString")=RsItem("CsString")
               RsLead("CoString")=RsItem("CoString")
               RsLead("AuthorType")=RsItem("AuthorType")
               RsLead("AsString")=RsItem("AsString")
               RsLead("AoString")=RsItem("AoString")
               RsLead("AuthorStr")=RsItem("AuthorStr")
               RsLead("UpdateTimeType")=RsItem("UpdateTimeType")
               RsLead("UsString")=RsItem("UsString")
               RsLead("UoString")=RsItem("UoString")
               RsLead("UpdateTimeStr")=RsItem("UpdateTimeStr")
               RsLead("CopyFromType")=RsItem("CopyFromType")
               RsLead("FsString")=RsItem("FsString")
               RsLead("FoString")=RsItem("FoString")
               RsLead("CopyFromStr")=RsItem("CopyFromStr")
               RsLead("KeyType")=RsItem("KeyType")
               RsLead("KsString")=RsItem("KsString")
               RsLead("KoString")=RsItem("KoString")
               RsLead("KeyStr")=RsItem("KeyStr")
               RsLead("NewsPaingType")=RsItem("NewsPaingType")
               RsLead("NPsString")=RsItem("NPsString")
               RsLead("NPoString")=RsItem("NPoString")
               RsLead("NewsPaingStr1")=RsItem("NewsPaingStr1")
               RsLead("NewsPaingStr2")=RsItem("NewsPaingStr2")
               RsLead("Flag")=RsItem("Flag")
               RsLead("DsStringbType")=RsItem("DsStringbType")
               RsLead("DsStringb")=RsItem("DsStringb")
               RsLead("DoStringb")=RsItem("DoStringb")
               RsLead("DsStringbb")=RsItem("DsStringbb")
               RsLead("DoStringbb")=RsItem("DoStringbb")
               RsLead("XsStringbType")=RsItem("XsStringbType")
               RsLead("XsStringb")=RsItem("XsStringb")
               RsLead("XoStringb")=RsItem("XoStringb")
               RsLead("XsStringbb")=RsItem("XsStringbb")
               RsLead("XoStringbb")=RsItem("XoStringbb")
               RsLead("BsStringbType")=RsItem("BsStringbType")
               RsLead("BsStringb")=RsItem("BsStringb")
               RsLead("BoStringb")=RsItem("BoStringb")
               RsLead("BoStringbstr")=RsItem("BoStringbstr")
               RsLead("YsStringbType")=RsItem("YsStringbType")
               RsLead("YsStringb")=RsItem("YsStringb")
               RsLead("YoStringb")=RsItem("YoStringb")
               RsLead("YoStringbstr")=RsItem("YoStringbstr")
               RsLead("PsStringbType")=RsItem("PsStringbType")
               RsLead("PsStringb")=RsItem("PsStringb")
               RsLead("PoStringb")=RsItem("PoStringb")
               RsLead("PoStringbstr")=RsItem("PoStringbstr")
               RsLead("HsStringbType")=RsItem("HsStringbType")
               RsLead("HsStringb")=RsItem("HsStringb")
               RsLead("HoStringb")=RsItem("HoStringb")
               RsLead("HoStringbstr")=RsItem("HoStringbstr")
               RsLead("JsStringbType")=RsItem("JsStringbType")
               RsLead("JsStringb")=RsItem("JsStringb")
               RsLead("JoStringb")=RsItem("JoStringb")
               RsLead("JoStringbstr")=RsItem("JoStringbstr")
               RsLead("SsStringbType")=RsItem("SsStringbType")
               RsLead("SsStringb")=RsItem("SsStringb")
               RsLead("SoStringb")=RsItem("SoStringb")
               RsLead("SoStringbstr")=RsItem("SoStringbstr")
               RsLead("ZsStringbType")=RsItem("ZsStringbType")
               RsLead("ZsStringb")=RsItem("ZsStringb")
               RsLead("ZoStringb")=RsItem("ZoStringb")
               RsLead("ZoStringbstr")=RsItem("ZoStringbstr")
               RsLead("LsStringbType")=RsItem("LsStringbType")
               RsLead("LsStringb")=RsItem("LsStringb")
               RsLead("LoStringb")=RsItem("LoStringb")
               RsLead("LoStringbstr")=RsItem("LoStringbstr")
               RsLead("MsStringbType")=RsItem("MsStringbType")
               RsLead("MsStringb")=RsItem("MsStringb")
               RsLead("MoStringb")=RsItem("MoStringb")
               RsLead("MoStringbstr")=RsItem("MoStringbstr")
               RsLead("QsStringbType")=RsItem("QsStringbType")
               RsLead("QsStringb")=RsItem("QsStringb")
               RsLead("QoStringb")=RsItem("QoStringb")
               RsLead("QoStringbstr")=RsItem("QoStringbstr")
               RsLead("Script_IFRAME")=RsItem("Script_IFRAME")
               RsLead("Script_OBJECT")=RsItem("Script_OBJECT")
               RsLead("Script_SCRIPT")=RsItem("Script_SCRIPT")
               RsLead("Script_Div")=RsItem("Script_Div")
               RsLead("Script_CLASS")=RsItem("Script_CLASS")
               RsLead("Script_Span")=RsItem("Script_Span")
               RsLead("Script_IMG")=RsItem("Script_IMG")
               RsLead("Script_FONT")=RsItem("Script_FONT")
               RsLead("Script_A")=RsItem("Script_A")
               RsLead("Script_HTML")=RsItem("Script_HTML")
               RsLead("Script_Table")=RsItem("Script_Table")
               RsLead("Script_Tr")=RsItem("Script_Tr")
               RsLead("Script_Td")=RsItem("Script_Td")
               RsLead("CollectionNum")=RsItem("CollectionNum")
               RsLead("CollectionType")=RsItem("CollectionType")
               RsLead("SkinID")=RsItem("SkinID")
               RsLead("TemplateID")=RsItem("TemplateID")
               RsLead("OnTop")=RsItem("OnTop")
               RsLead("Hot")=RsItem("Hot")
               RsLead("Elite")=RsItem("Elite")
               RsLead("Hits")=RsItem("Hits")
               RsLead("Stars")=RsItem("Stars")
               RsLead("ShowCommentLink")=RsItem("ShowCommentLink")
               RsLead("CollecOrder")=RsItem("CollecOrder")
               RsLead("Passed")=RsItem("Passed")
               RsLead("CreateImmediate")=RsItem("CreateImmediate")
               RsLead("SaveFiles")=RsItem("SaveFiles")
               RsLead("lasttimestr")=RsItem("lasttimestr")
               RsLead("FileSavebType")=RsItem("FileSavebType")
               RsLead("FileSavebNum")=RsItem("FileSavebNum")
               RsLead("FileSavebstr")=RsItem("FileSavebstr")
               RsLead("SaveNameTypeb")=RsItem("SaveNameTypeb")
               RsLead("SaveDir")=RsItem("SaveDir")
               RsLead("SoftPoint")=RsItem("SoftPoint")
               ItemIDTemp=RsLead("ItemID")
               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,ConnItem,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.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
	Call WriteSuccessMsg("数据成功导出为：" & LeadOutMdb)
   Else
	Call WriteErrMsg()
   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,ListStr,ListPaingType,ListPaingStr2,ListPaingID1,ListPaingID2,ListPaingStr3,ChannelID,ClassID,SpecialID,Flag from Item order by ItemID DESC"
         RsLead.open SqlLead,ConnLead,1,1
         If Not RsLead.Eof then
%>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border">
<form method="post" action="Admin_ST_Database.asp?Action=LeadInData">
  <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%"  align="center" class=ButtonList height="22">选择</td>                 
      <td width="10%" align="center" class=ButtonList>项目名称</td>
      <td width="10%" align="center" class=ButtonList>所属频道</td> 
      <td width="10%" 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"><%Call ShowName(1,RsLead("ChannelID"))%></td> 
      <td width="10%" height="22" align="center"><%Call ShowName(2,RsLead("ClassID"))%></td> 
      <td width="10%" height="22" align="center"><%Call ShowName(3,RsLead("SpecialID"))%></td> 
      <td width="5%" align="center">
      <%If RsLead("Flag")=True Then
           Response.write "√"
        Else
           Response.Write "<font color=red>×</font>"
      End If%>
      </td>            
   </tr>   
<%
            RsLead.MoveNext
            Loop
%>

   <tr class="tdbg" >
     <td colspan=6><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=" 开始导入 ">
     </td>
   </tr>
</form>
</table>
<%
         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 WriteErrMsg()
   End If
End Sub

Sub LeadInData()
   Dim LeadInMdb,ItemMdbPath,connstrLead,connLead,RsLead,SqlLead,RsF,SqlF,ItemIDTemp
   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
      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,ConnItem,1,3
               RsItem.AddNew
               RsItem("ItemName")=RsLead("ItemName")
               RsItem("ChannelID")=RsLead("ChannelID")
               RsItem("ClassID")=RsLead("ClassID")
               RsItem("SpecialID")=RsLead("SpecialID")
               RsItem("WebName")=RsLead("WebName")
               RsItem("WebUrl")=RsLead("WebUrl")
               RsItem("ItemDemo")=RsLead("ItemDemo")
               RsItem("LoginType")=RsLead("LoginType")
               RsItem("LoginUrl")=RsLead("LoginUrl")
               RsItem("LoginPostUrl")=RsLead("LoginPostUrl")
               RsItem("LoginUser")=RsLead("LoginUser")
               RsItem("LoginPass")=RsLead("LoginPass")
               RsItem("LoginFalse")=RsLead("LoginFalse")
               RsItem("ListStr")=RsLead("ListStr")
               RsItem("LsString")=RsLead("LsString")
               RsItem("LoString")=RsLead("LoString")
               RsItem("ListPaingType")=RsLead("ListPaingType")
               RsItem("LPsString")=RsLead("LPsString")
               RsItem("LPoString")=RsLead("LPoString")
               RsItem("ListPaingStr1")=RsLead("ListPaingStr1")
               RsItem("ListPaingStr2")=RsLead("ListPaingStr2")
               RsItem("ListPaingID1")=RsLead("ListPaingID1")
               RsItem("ListPaingID2")=RsLead("ListPaingID2")
               RsItem("ListPaingStr3")=RsLead("ListPaingStr3")
               RsItem("HsString")=RsLead("HsString")
               RsItem("HoString")=RsLead("HoString")
               RsItem("HttpUrlType")=RsLead("HttpUrlType")
               RsItem("HttpUrlStr")=RsLead("HttpUrlStr")
               RsItem("TsString")=RsLead("TsString")
               RsItem("ToString")=RsLead("ToString")
               RsItem("CsString")=RsLead("CsString")
               RsItem("CoString")=RsLead("CoString")
               RsItem("AuthorType")=RsLead("AuthorType")
               RsItem("AsString")=RsLead("AsString")
               RsItem("AoString")=RsLead("AoString")
               RsItem("AuthorStr")=RsLead("AuthorStr")
               RsItem("UpdateTimeType")=RsLead("UpdateTimeType")
               RsItem("UsString")=RsLead("UsString")
               RsItem("UoString")=RsLead("UoString")
               RsItem("UpdateTimeStr")=RsLead("UpdateTimeStr")
               RsItem("CopyFromType")=RsLead("CopyFromType")
               RsItem("FsString")=RsLead("FsString")
               RsItem("FoString")=RsLead("FoString")
               RsItem("CopyFromStr")=RsLead("CopyFromStr")
               RsItem("KeyType")=RsLead("KeyType")
               RsItem("KsString")=RsLead("KsString")
               RsItem("KoString")=RsLead("KoString")
               RsItem("KeyStr")=RsLead("KeyStr")
               RsItem("NewsPaingType")=RsLead("NewsPaingType")
               RsItem("NPsString")=RsLead("NPsString")
               RsItem("NPoString")=RsLead("NPoString")
               RsItem("NewsPaingStr1")=RsLead("NewsPaingStr1")
               RsItem("NewsPaingStr2")=RsLead("NewsPaingStr2")
               RsItem("Flag")=RsLead("Flag")
               RsItem("DsStringbType")=RsLead("DsStringbType")
               RsItem("DsStringb")=RsLead("DsStringb")
               RsItem("DoStringb")=RsLead("DoStringb")
               RsItem("DsStringbb")=RsLead("DsStringbb")
               RsItem("DoStringbb")=RsLead("DoStringbb")
               RsItem("XsStringbType")=RsLead("XsStringbType")
               RsItem("XsStringb")=RsLead("XsStringb")
               RsItem("XoStringb")=RsLead("XoStringb")
               RsItem("XsStringbb")=RsLead("XsStringbb")
               RsItem("XoStringbb")=RsLead("XoStringbb")
               RsItem("BsStringbType")=RsLead("BsStringbType")
               RsItem("BsStringb")=RsLead("BsStringb")
               RsItem("BoStringb")=RsLead("BoStringb")
               RsItem("BoStringbstr")=RsLead("BoStringbstr")
               RsItem("YsStringbType")=RsLead("YsStringbType")
               RsItem("YsStringb")=RsLead("YsStringb")
               RsItem("YoStringb")=RsLead("YoStringb")
               RsItem("YoStringbstr")=RsLead("YoStringbstr")
               RsItem("PsStringbType")=RsLead("PsStringbType")
               RsItem("PsStringb")=RsLead("PsStringb")
               RsItem("PoStringb")=RsLead("PoStringb")
               RsItem("PoStringbstr")=RsLead("PoStringbstr")
               RsItem("HsStringbType")=RsLead("HsStringbType")
               RsItem("HsStringb")=RsLead("HsStringb")
               RsItem("HoStringb")=RsLead("HoStringb")
               RsItem("HoStringbstr")=RsLead("HoStringbstr")
               RsItem("JsStringbType")=RsLead("JsStringbType")
               RsItem("JsStringb")=RsLead("JsStringb")
               RsItem("JoStringb")=RsLead("JoStringb")
               RsItem("JoStringbstr")=RsLead("JoStringbstr")
               RsItem("SsStringbType")=RsLead("SsStringbType")
               RsItem("SsStringb")=RsLead("SsStringb")
               RsItem("SoStringb")=RsLead("SoStringb")
               RsItem("SoStringbstr")=RsLead("SoStringbstr")
               RsItem("ZsStringbType")=RsLead("ZsStringbType")
               RsItem("ZsStringb")=RsLead("ZsStringb")
               RsItem("ZoStringb")=RsLead("ZoStringb")
               RsItem("ZoStringbstr")=RsLead("ZoStringbstr")
               RsItem("LsStringbType")=RsLead("LsStringbType")
               RsItem("LsStringb")=RsLead("LsStringb")
               RsItem("LoStringb")=RsLead("LoStringb")
               RsItem("LoStringbstr")=RsLead("LoStringbstr")
               RsItem("MsStringbType")=RsLead("MsStringbType")
               RsItem("MsStringb")=RsLead("MsStringb")
               RsItem("MoStringb")=RsLead("MoStringb")
               RsItem("MoStringbstr")=RsLead("MoStringbstr")
               RsItem("QsStringbType")=RsLead("QsStringbType")
               RsItem("QsStringb")=RsLead("QsStringb")
               RsItem("QoStringb")=RsLead("QoStringb")
               RsItem("QoStringbstr")=RsLead("QoStringbstr")
               RsItem("Script_IFRAME")=RsLead("Script_IFRAME")
               RsItem("Script_OBJECT")=RsLead("Script_OBJECT")
               RsItem("Script_SCRIPT")=RsLead("Script_SCRIPT")
               RsItem("Script_Div")=RsLead("Script_Div")
               RsItem("Script_CLASS")=RsLead("Script_CLASS")
               RsItem("Script_Span")=RsLead("Script_Span")
               RsItem("Script_IMG")=RsLead("Script_IMG")
               RsItem("Script_FONT")=RsLead("Script_FONT")
               RsItem("Script_A")=RsLead("Script_A")
               RsItem("Script_HTML")=RsLead("Script_HTML")
               RsItem("Script_Table")=RsLead("Script_Table")
               RsItem("Script_Tr")=RsLead("Script_Tr")
               RsItem("Script_Td")=RsLead("Script_Td")
               RsItem("CollectionNum")=RsLead("CollectionNum")
               RsItem("CollectionType")=RsLead("CollectionType")
               RsItem("SkinID")=RsLead("SkinID")
               RsItem("TemplateID")=RsLead("TemplateID")
               RsItem("OnTop")=RsLead("OnTop")
               RsItem("Hot")=RsLead("Hot")
               RsItem("Elite")=RsLead("Elite")
               RsItem("Hits")=RsLead("Hits")
               RsItem("Stars")=RsLead("Stars")
               RsItem("ShowCommentLink")=RsLead("ShowCommentLink")
               RsItem("CollecOrder")=RsLead("CollecOrder")
               RsItem("Passed")=RsLead("Passed")
               RsItem("CreateImmediate")=RsLead("CreateImmediate")
               RsItem("SaveFiles")=RsLead("SaveFiles")
               RsItem("lasttimestr")=RsLead("lasttimestr")
               RsItem("FileSavebType")=RsLead("FileSavebType")
               RsItem("FileSavebNum")=RsLead("FileSavebNum")
               RsItem("FileSavebstr")=RsLead("FileSavebstr")
               RsItem("SaveNameTypeb")=RsLead("SaveNameTypeb")
               RsItem("SaveDir")=RsLead("SaveDir")
               RsItem("SoftPoint")=RsLead("SoftPoint")
               ItemIDTemp=RsItem("ItemID")
               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,ConnItem,1,3
                     RsItem.AddNew
                     RsItem("ItemID")=ItemIDTemp
                     RsItem("FilterName")=RsF("FilterName")
                     RsItem("FilterObject")=RsF("FilterObject")
                     RsItem("FilterType")=RsF("FilterType")
                     RsItem("FilterContent")=RsF("FilterContent")
                     RsItem("FisString")=RsF("FisString")
                     RsItem("FioString")=RsF("FioString")
                     RsItem("FilterRep")=RsF("FilterRep")
                     RsItem.Update
                     RsItem.Close
                     Set RsItem=Nothing
                  RsF.MoveNext
                  Loop
               End If
               RsF.Close
               Set RsF=Nothing
            RsLead.MoveNext
            Loop
         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 WriteSuccessMsg("数据导入成功<br><!--请使用 检查更新数据 功能更新导入的数据-->")
   Else
      Call WriteErrMsg()
   End If
End Sub

Sub UpData()
   Dim sqlItem
   Set RsItem=server.createobject("adodb.recordset")         
   SqlItem="select * from Item"
   RsItem.open SqlItem,ConnItem,1,1
   If Not RsItem.Eof Then
      Do While (Not RsItem.Eof) and (Not RsItem.Bof)
         FoundErr=False
         ErrMsg=ErrMsg & "<b>" & RsItem("ItemName") & "</b> 项目数据： "
         If RsItem("ItemName")="" or isnull(RsItem("ItemName")) Then
            FoundErr=True
            ErrMsg=ErrMsg & "项目名称"
         End If
            If RsItem("ClassID")="" or RsItem("ClassID")=0 Or IsNull(RsItem("ClassID")) Then
               FoundErr=True
               ErrMsg=ErrMsg & " 栏目"
            Else
               'set tClass=conn.execute("select C.Child,C.LinkUrl From PE_Class C inner join PE_Template P on C.TemplateID=P.TemplateID Where C.ClassID=" & RsItem("ClassID"))
               set tClass=conn.execute("select C.Child,C.LinkUrl From PE_Class C Where C.ClassID=" & RsItem("ClassID"))
               If tClass.bof and tClass.eof then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 栏目"
               Else
                  if tClass(0)>0 then
                     FoundErr=True
                     ErrMsg=ErrMsg & " 栏目"
                  End if
                  If tClass(1)<>"" then
                     FoundErr=True
                     ErrMsg=ErrMsg & " 栏目"
                  End if
               End If
               Set tClass=Nothing
            End If
         If RsItem("WebName")="" or IsNull(RsItem("WebName")) Then
            FoundErr=True
            ErrMsg=ErrMsg & " 网站名称"
         End If
         If RsItem("WebUrl")="" Or IsNull(RsItem("WebUrl")) Then
            FoundErr=True
            ErrMsg=ErrMsg & "、网站地址"
         End If
         If RsItem("LoginType")="" or IsNull(RsItem("LoginType")) Then
            FoundErr=True
            ErrMsg=ErrMsg & " 网站登录类型"
         else
            If RsItem("LoginType")=1 Then
               If RsItem("LoginUrl")="" or RsItem("LoginPostUrl")="" or Instr(RsItem("LoginUser"),"=")=0 or Instr(RsItem("LoginPass"),"=")=0 or RsItem("LoginFalse")="" then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 网站登录参数"
               End If
            End If
         End If
         If RsItem("ListPaingType")="" or IsNull(RsItem("ListPaingType")) Then
            FoundErr=True
            ErrMsg=ErrMsg & " 列表分页类型"
         Else
            If RsItem("ListPaingType")=0 Then
               If RsItem("ListStr")="" or IsNull(RsItem("ListStr"))=True Then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 列表索引"
               End If
            ElseIf RsItem("ListPaingType")=1 Then
               If RsItem("ListStr")="" Then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 列表索引"
               End If
               If RsItem("LPsString")="" or IsNull(RsItem("LPsString")) or RsItem("LPoString")="" Or IsNull(RsItem("LPoString")) then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 列表分页标记"
               end If
               If IsNull(RsItem("ListPaingStr1"))<>True and Len(RsItem("ListPaingStr1"))<15 Then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 索引分页重定向"
               End If
            ElseIf RsItem("ListPaingType")=2 Then
               If Len(RsItem("ListPaingStr2"))<15 or Instr(RsItem("ListPaingStr2"),"{$ID}")=0 Then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 列表原始字符"
               End If
               If IsNumeric(RsItem("ListPaingID1"))=False or IsNumeric(RsItem("ListPaingID2"))=False or (RsItem("ListPaingID1")=0 and RsItem("ListPaingID2")=0) Then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 列表分页范围"
               End If
            ElseIf RsItem("ListPaingType")=3 Then
               If RsItem("ListPaingStr3")="" Then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 列表手动分页标记"
               End If
            Else
               FoundErr=True
               ErrMsg=ErrMsg & " 列表分页类型"
            End If
         End If
         If RsItem("LsString")="" or IsNull(RsItem("LsString")) Or RsItem("LoString")="" Or IsNull(RsItem("LoString")) Then
            FoundErr=True
            ErrMsg=ErrMsg & " 列表标记设置"
         End If
         If RsItem("HsString")="" or IsNull(RsItem("HsString")) Or RsItem("HoString")="" Or IsNull(RsItem("HoString")) Then
            FoundErr=True
            ErrMsg=ErrMsg & " 链接标记设置"
         End If
         If IsNull(RsItem("HttpUrlType")) Then
            FoundErr=True
            ErrMsg=ErrMsg & " 链接类型"
         Else
            If RsItem("HttpUrlType")=1 and Len(Rsitem("HttpUrlStr"))<15 Then
               FoundErr=True
               ErrMsg=ErrMsg & " 链接字符"
            End If
         End If
         If RsItem("TsString")="" or IsNull(RsItem("TsString")) Or RsItem("ToString")="" Or IsNull(RsItem("ToString")) Then
            FoundErr=True
            ErrMsg=ErrMsg & " 标题标记设置"
         End If
         If RsItem("CsString")="" or IsNull(RsItem("CsString")) Or RsItem("CoString")="" Or IsNull(RsItem("CoString")) Then
            FoundErr=True
            ErrMsg=ErrMsg & " 正文标记设置"
         End If
         If IsNull(RsItem("AuthorType")) Then
            FoundErr=True
            ErrMsg=ErrMsg & " 作者标记设置"
         Else
            If RsItem("AuthorType")=1 Then
               If RsItem("AsString")="" or IsNull(RsItem("AsString")) Or RsItem("AoString")="" Or IsNull(RsItem("AoString")) Then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 作者标记设置"
               End If
            ElseIf RsItem("AuthorType")=2 Then
               If RsItem("AuthorStr")="" or IsNull(RsItem("AuthorStr")) Then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 指定作者设置"
               End If 
            End If
         End If
         If RsItem("CopyFromType")=1 Then
            If RsItem("FsString")="" or RsItem("FoString")="" Then
               FoundErr=True
               ErrMsg=ErrMsg & " 来源标记设置"
            End If
         ElseIf RsItem("CopyFromType")=2 Then
            If RsItem("CopyFromStr")="" Then
               FoundErr=True
               ErrMsg=ErrMsg & " 指定来源设置"
            End If 
         End If
         If RsItem("KeyType")=1 Then
            If RsItem("KsString")="" or RsItem("KoString")="" Then
               FoundErr=True
               ErrMsg=ErrMsg & " 关键字标记设置"
            End If
         ElseIf RsItem("KeyType")=2 Then
            If RsItem("KeyStr")="" Then
               FoundErr=True
               ErrMsg=ErrMsg & " 指定关键字设置"
            End If 
         End If
         If RsItem("NewsPaingType")=1 Then
            If RsItem("NPsString")="" or RsItem("NPoString")="" Then
               FoundErr=True
               ErrMsg=ErrMsg & " 正文分页标记设置"
            End If
            If RsItem("NewsPaingStr")<>"" And Len(RsItem("NewsPaingStr"))<15 Then
               FoundErr=True
               ErrMsg=ErrMsg & " 正文分页绝对链接"
            End If
         ElseIf RsItem("NewsPaingType")=2 Then
            FoundErr=True
            ErrMsg=ErrMsg & " 正文分页类型"
         End If
         If FoundErr=False Then
            ErrMsg=ErrMsg & " 状态--正常<br>"
         Else
            ErrMsg=ErrMsg & " 设置不正确 状态--<font color=red>异常</font><br>"
         End If
         foundErr=False
         RsItem.movenext
      Loop
   end if
   rsItem.close
   set rsItem=nothing
If FoundErr=False Then
   Call WriteSuccessMsg(ErrMsg)
Else
   Call WriteErrMsg()
End If
End Sub

sub ClearData()
	dim z
	z=0
	if request("Item")="yes" then
		connItem.execute("delete From Item")
                connItem.execute("delete From CollecTemp")
		response.write "成功清除了所有采集项目！<br>"
		z=z+1
	end if
	if request("Histroly")="yes" then
		connItem.execute("delete from Histroly")
                connItem.execute("delete from HistrolyNews")
		response.write "成功清除了历史记录！<br>"
		z=z+1
	end if
	if request("Filters")="yes" then
		connItem.execute("delete from Filters")
		response.write "成功清除了过滤设置！<br>"
		z=z+1
	end if
	if request("FilesType")="yes" then
		connItem.execute("delete from FilesType")
		response.write "成功清除了文件类型！<br>"
		z=z+1
	end if
	if z>0 then
		response.write cstr(z) & "个数据库被清空，你可以开始添加新内容。"
	else
		response.write "你没有选择任何数据库，0个数据库被清空。"
	end if

end sub
%>
<br>
<table width="100%" border="0" cellpadding="0" cellspacing="1" class="border" >
  <tr>
   <td colspan='2' height="20" align="center"><a href='http://www.fy66.net/' target=_blank style='color:#449AE8'>插件作者:飞越快乐家园站长-科技创造自由</a></td>
  </tr>
</table> 