admin_collection.asp

依蓝旅游网站管理系统Elan2008.SP2

<table width="100%" border="0" cellpadding="0" cellspacing="1" class="Border">
  <tr>
    <td colspan="2" class="top_25"><strong>采集项目导出</strong></td>
  </tr>
  <tr>
    <td width="25%" class="td_ItemName"><strong>选择要导出的项目</strong></td>
    <td width="75%" class="td_25"><select name="CollectionID" size="10" multiple id="CollectionID" style="height:250px; width:250px;">
    <%
	  If RowCount = 0 Then
	     Response.Write "<option value=''>没有可以导出的模板</option>"
		 Disabled = "disabled"
	  Else
	     rsCollection.Open()
		 For i=1 To RowCount
		    Response.Write "<option value='"& rsCollection(0) &"'>"& rsCollection(1) &"</option>"
			If i<RowCount Then rsCollection.MoveNext
		 Next
		 rsCollection.Close()
	  End If
	%>
    </select>
[<span id="ck"><a href="javascript:CheckAll()">全选</a></span>]</td>
  </tr>
  <tr>
    <td class="td_ItemName"><strong>目标数据表</strong></td>
    <td class="td_25"><input name="CollectionData" type="text" id="CollectionData" value="<%=InstallDir%>EL_Collection.mdb" size="30">
      <input name="IsClear" type="checkbox" class="nomargin" id="IsClear" value="1" checked>
先清空目标数据表</td>
  </tr>
  <tr>
    <td class="td_ItemName">&nbsp;</td>
    <td class="td_50"><input name="Submit" type="submit" id="Submit" value=" 导 出 " <%=Disabled%>>
      <input name="Action" type="hidden" id="Action" value="Export">
      <input name="ExportStep" type="hidden" id="ExportStep" value="2"></td>
  </tr>
</table>
</form>
<%
Set rsCollection = Nothing
Set CollectionCmd = Nothing
ElseIf ExportStep = 2 Then

Dim CollectionData, CollectionID, IsClear, CollectionConn
CollectionID = EL_Common.ELRequest("CollectionID", 1)
IsClear = EL_Common.ELRequest("IsClear", 2)
CollectionData = EL_Common.ELRequest("CollectionData", 1)

Set CollectionConn = Server.CreateObject("ADODB.Connection")
CollectionConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(CollectionData)
If Err Then
   Err.Clear
   EL_Common.ShowErrorMsg("打开项目数据表错误，无法完成项目导出操作，请返回上一步检查数据表路径是否正确")
   CollectionConn.Close()
   Set CollectionConn = Nothing
   Exit Sub
End If

Set rsCollection = CollectionConn.Execute("SELECT CollectionID,CollectionName,Charset,ListURL,ListBegin,ListEnd,ListABegin,ListAEnd,ListPType,ListPNPBegin,ListPNPEnd,ListPIDString,ListPIDArea,ListPURLString,ListThumbType,ListThumbBegin,ListThumbEnd,TitleBegin,TitleEnd,KeywordType,KeywordBegin,KeywordEnd,KeywordString,AuthorType,AuthorBegin,AuthorEnd,AuthorString,CopyfromType,CopyfromBegin,CopyfromEnd,CopyfromString,UpdateTimeType,UpdateTimeBegin,UpdateTimeEnd,ContentBegin,ContentEnd,ContentPType,ContentPBegin,ContentPEnd,ContentPURLBegin,ContentPURLEnd,ChannelID,ClassID,OnTop,Commended,Passed,Hits,SkinID,TemplateID,CollectionNum,ArrSetting FROM EL_Collection WHERE 1=2")
If Err Then
   Err.Clear
   EL_Common.ShowErrorMsg("项目数据表结构错误，无法完成项目导出操作")
   rsCollection.Close()
   Set rsCollection = Nothing
   CollectionConn.Close()
   Set CollectionConn = Nothing
   Exit Sub
End If
rsCollection.Close()
Set rsCollection = Nothing

If IsClear = 1 Then '清空
   CollectionConn.Execute("DELETE FROM EL_Collection")
End If

Dim ArrData, j, DL, SQL
Call EL_Common.InitCommonCmd(CollectionCmd, rsCollection, "EL_Collection", "*", "CollectionID In ("& CollectionID &")")
ArrData = rsCollection.GetRows()
rsCollection.Close()
Set rsCollection = Nothing
Set CollectionCmd = Nothing

DL = Ubound(ArrData, 2)
For i = 0 To DL
   SQL = "INSERT INTO EL_Collection(CollectionName,Charset,ListURL,ListBegin,ListEnd,ListABegin,ListAEnd,ListPType,ListPNPBegin,ListPNPEnd,ListPIDString,ListPIDArea,ListPURLString,ListThumbType,ListThumbBegin,ListThumbEnd,TitleBegin,TitleEnd,KeywordType,KeywordBegin,KeywordEnd,KeywordString,AuthorType,AuthorBegin,AuthorEnd,AuthorString,CopyfromType,CopyfromBegin,CopyfromEnd,CopyfromString,UpdateTimeType,UpdateTimeBegin,UpdateTimeEnd,ContentBegin,ContentEnd,ContentPType,ContentPBegin,ContentPEnd,ContentPURLBegin,ContentPURLEnd,ChannelID,ClassID,OnTop,Commended,Passed,Hits,SkinID,TemplateID,CollectionNum,ArrSetting) VALUES("
   For j = 1 To 50
      If TypeName(ArrData(j, i)) = "String" Then
	     If ISNULL(ArrData(j, i)) Then
		    SQL = SQL &"'"& ArrData(j, i) &"',"
		 Else
		    SQL = SQL &"'"& Replace(ArrData(j, i), "'", "''") &"',"
		 End If
	  Else
	     SQL = SQL &"'"& ArrData(j, i) &"',"
	  End If	  
   Next
   SQL = LEFT(SQL, Len(SQL) - 1)
   SQL = SQL &")"
   CollectionConn.Execute(SQL)    
Next

CollectionConn.Close()
Set CollectionConn = Nothing

EL_Common.ShowScriptError()
Response.Redirect "Admin_Collection.asp?Action=Export&ExportStep=3"

ElseIf ExportStep = 3 Then

ComeURL = "Admin_Collection.asp"
EL_Common.ShowSuccessMsg("项目导出成功")

End If
EL_Common.ShowScriptError()
End Sub

Sub Import()
On Error Resume Next
Dim ImportStep, CollectionData, CollectionConn, rsCollection, CollectionCmd, RowCount, i
ImportStep = EL_Common.ELRequest("ImportStep", 2)

If ImportStep < 2 Then
%>
<form name="myform" action="Admin_Collection.asp" method="post">
<table width="100%" border="0" cellpadding="0" cellspacing="1" class="Border">
  <tr>
    <td colspan="2" class="top_25"><strong>采集项目导入：第一步</strong></td>
  </tr>
  <tr>
    <td width="16%" class="td_ItemName"><strong>项目数据表路径</strong></td>
    <td width="84%" class="td_50"><input name="CollectionData" type="text" id="CollectionData" value="<%=InstallDir%>EL_Collection.mdb" size="35"></td>
  </tr>
  <tr>
    <td class="td_ItemName"></td>
    <td class="td_50"><input type="submit" name="Submit3" value=" 下一步 ">
      <input name="Action" type="hidden" id="Action" value="Import">
      <input name="ImportStep" type="hidden" id="ImportStep" value="2"></td>
  </tr>
</table>
</form>
<%
ElseIf ImportStep = 2 Then

CollectionData = EL_Common.ELRequest("CollectionData", 1)

Set CollectionConn = Server.CreateObject("ADODB.Connection")
CollectionConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(CollectionData)
If Err Then
   Err.Clear
   EL_Common.ShowErrorMsg("打开项目数据表错误，无法完成项目导入操作，请返回上一步检查数据表路径是否正确")
   CollectionConn.Close()
   Set CollectionConn = Nothing
   Exit Sub
End If

Set rsCollection = CollectionConn.Execute("SELECT CollectionID,CollectionName FROM EL_Collection")
If Err Then
   Err.Clear
   EL_Common.ShowErrorMsg("项目数据表结构错误，无法完成项目导入操作")
   rsCollection.Close()
   Set rsCollection = Nothing
   CollectionConn.Close()
   Set CollectionConn = Nothing
   Exit Sub
End If
%>
<script language="javascript">
function Check(frm){
  if(frm.CollectionID.value.trim() == "" || frm.CollectionID.selectedIndex == -1){
     alert("请选择导入的项目");
	 frm.CollectionID.focus();
	 return false;
  }
  SubmitOnce(frm);
  return;
}
</script>
<form name="myform" action="Admin_Collection.asp" method="post" onSubmit="return Check(this)">
<table width="100%" border="0" cellpadding="0" cellspacing="1" class="Border">
  <tr>
    <td colspan="3" class="top_25"><strong>采集项目导入：第二步</strong></td>
  </tr>
  <tr>
    <td width="41%" align="center" class="td_ItemName"><strong>选择要导入的项目</strong></td>
    <td width="18%" align="center" class="td_25"></td>
    <td width="41%" align="center" class="td_ItemName"><strong>系统中已存在的项目</strong></td>
  </tr>
  <tr>
    <td align="center" class="td_ItemName">
	<select name="CollectionID" size="10" multiple id="CollectionID" style="height:250px; width:250px;">
    <%
	  Do While Not rsCollection.EOF
	     Response.Write "<option value='"& rsCollection(0) &"'>"& rsCollection(1) &"</option>"
		 rsCollection.MoveNext
	  Loop
	  rsCollection.Close()
	  Set rsCollection = Nothing
	%>
    </select>
	</td>
    <td align="center" class="td_25"><input type="submit" name="Submit13" value=" 执行导入 &gt;&gt; "></td>
    <td align="center" class="td_ItemName"><select name="select2" size="10" multiple id="select2" style="height:250px; width:250px;">
      <%
	  Call EL_Common.InitCommonCmd(CollectionCmd, rsCollection, "EL_Collection", "CollectionID,CollectionName", "1=1 Order By CollectionID DESC")
	  rsCollection.Close()
	  RowCount = CollectionCmd(0)
	  If RowCount = 0 Then
	     Response.Write "<option value=''>没有任何项目</option>"
	  Else
	     rsCollection.Open()
		 For i=1 To RowCount
		    Response.Write "<option value='"& rsCollection(0) &"' disabled>"& rsCollection(1) &"</option>"
			If i<RowCount Then rsCollection.MoveNext
		 Next
		 rsCollection.Close()
	  End If
	  Set rsCollection = Nothing
	  Set CollectionCmd = Nothing
	%>
    </select>
	</td>
  </tr>
  <tr>
    <td colspan="3" align="center" class="td_50"><strong>按住“Ctrl”或“Shift”键可以多选
      <input name="Action" type="hidden" id="Action" value="Import">
      <input name="ImportStep" type="hidden" id="ImportStep" value="3">
      <input name="CollectionData" type="hidden" id="CollectionData" value="<%=CollectionData%>">
    </strong></td>
  </tr>
</table>
</form>
<%
CollectionConn.Close()
Set CollectionConn = Nothing
ElseIf ImportStep = 3 Then

Dim CollectionID, ArrData, DL
CollectionID = EL_Common.ELRequest("CollectionID", 1)
CollectionData = EL_Common.ELRequest("CollectionData", 1)

Set CollectionConn = Server.CreateObject("ADODB.Connection")
CollectionConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(CollectionData)
If Err Then
   Err.Clear
   EL_Common.ShowErrorMsg("打开项目数据表错误，无法完成项目导入操作，请返回上一步检查数据表路径是否正确")
   CollectionConn.Close()
   Set CollectionConn = Nothing
   Exit Sub
End If

Set rsCollection = CollectionConn.Execute("SELECT * FROM EL_Collection WHERE CollectionID IN("& CollectionID &")")
If Err Then
   Err.Clear
   EL_Common.ShowErrorMsg("项目数据表结构错误，无法完成项目导入操作")
   rsCollection.Close()
   Set rsCollection = Nothing
   CollectionConn.Close()
   Set CollectionConn = Nothing
   Exit Sub
End If
ArrData = rsCollection.GetRows()
rsCollection.Close()
Set rsCollection = Nothing
CollectionConn.Close()
Set CollectionConn = Nothing

DL = Ubound(ArrData, 2)
Dim SQL, j
For i = 0 To DL
  SQL = "INSERT INTO EL_Collection(CollectionName,Charset,ListURL,ListBegin,ListEnd,ListABegin,ListAEnd,ListPType,ListPNPBegin,ListPNPEnd,ListPIDString,ListPIDArea,ListPURLString,ListThumbType,ListThumbBegin,ListThumbEnd,TitleBegin,TitleEnd,KeywordType,KeywordBegin,KeywordEnd,KeywordString,AuthorType,AuthorBegin,AuthorEnd,AuthorString,CopyfromType,CopyfromBegin,CopyfromEnd,CopyfromString,UpdateTimeType,UpdateTimeBegin,UpdateTimeEnd,ContentBegin,ContentEnd,ContentPType,ContentPBegin,ContentPEnd,ContentPURLBegin,ContentPURLEnd,ChannelID,ClassID,OnTop,Commended,Passed,Hits,SkinID,TemplateID,CollectionNum,ArrSetting,Status) VALUES("
  For j = 1 To 50
     If ISNULL(ArrData(j, i)) = False Then
	    SQL = SQL &"'"& Replace(ArrData(j, i), "'", "''") &"',"
	 Else
	    SQL = SQL &"'"& ArrData(j, i) &"',"
	 End If
  Next
  SQL = SQL &"1)"
  Conn.Execute(SQL)
Next
EL_Common.ShowScriptError()
Response.Redirect "Admin_Collection.asp?Action=Import&ImportStep=4"

ElseIf ImportStep = 4 Then

ComeURL = "Admin_Collection.asp"
EL_Common.ShowSuccessMsg("项目导入成功")
 
End If

EL_Common.ShowScriptError()
End Sub

Sub ModifyFliter()
On Error Resume Next
Dim FliterCmd, rsFliter
Dim FliterID
FliterID = EL_Common.ELRequest("FliterID", 2)
Call EL_Common.InitCommonCmd(FliterCmd, rsFliter, "EL_Fliter", "*", "FliterID="& FliterID)
rsFliter.Close()
If FliterCmd(0) <> 1 Then
   EL_Common.ShowErrorMsg("指定过滤不存在")
   Set rsFliter = Nothing
   Set FliterCmd = Nothing
   Exit Sub
End If
rsFliter.Open()
CurrentPath = CurrentPath &">> 修改采集过滤"
%>
<table width="100%" border="0" cellspacing="1" cellpadding="0">
  <tr>
    <td><%=CurrentPath%></td>
  </tr>
</table>