📄 item.asp

📁 网人分类信息5.0商业版。非常优秀的分类信息系统。比较少见。
💻 ASP
字号:
<!--#include file="Cook.asp"-->
<%
Dim DBPath,sGconn,Gsrs,i,Gsrso
Dim WR_Name,WR_BaseSetting,WR_Timing,WR_LastTime,WR_ListBegin,WR_ListEnd,WR_LinkBegin,WR_LinkEnd,WR_LinkReset,WR_Content,WR_PageNext,WR_Key,WR_Module,WR_Anamnesis
Dim WR_LeachType,WR_Leach1,WR_Leach2
Dim Action,ID,WR_ID

Call WR.Hand()
Call WM_Content()

Sub sgConnOpen()
  DBPath = Request("DBPath")
  On Error Resume Next
  Set sGconn = Server.CReateObject("ADODB.Connection")
  sGconn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Server.MapPath(DBPath)
  If Err Then Set sGconn = Nothing:Err.Clear:Call WRMPS.ErrView("·数据库路径不正确", 0)
End Sub
Sub sGconnEnd()
  sGconn.Close
  Set sGconn = Nothing
End Sub

Sub WM_Content()
    Action = Request("Action")
	If Action = "" Then Action = "Admit"
    Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 class=td1>" & vbCrLf
    Content = Content & "<tr class=td2><td><a href=Index.asp>系统设置</a> | <a href=Data.asp>数据库管理</a> | <a href=Item.asp?Action=Admit>项目导入</a> | <a href=Item.asp?Action=Export>项目导出</a> | <a href=System_GatheRexe.asp?Action=Timing>定时采集</a></td></tr>" & vbCrLf
    Content = Content & "</table>" & vbCrLf
    Call ConnOpen()
	Set Grs = Server.CReateObject("ADODB.RecordSet")
	Set Gsrs = Server.CReateObject("ADODB.RecordSet")
	Set Gsrso = Server.CReateObject("ADODB.RecordSet")
	Select Case Action
      Case "AdmitSave"
	    ID = Request("ID")
		ID = Replace(ID,"&nbsp;","")
		If ID <> "" Then
		  ID = Split(ID,",")
		  Call sgConnOpen()
		  For i = 0 To Ubound(ID)
		    If ID(i) <> "" Then
		      Set Gsrs = sGconn.Execute("Select WR_Name,WR_BaseSetting,WR_Timing,WR_ListBegin,WR_ListEnd,WR_LinkBegin,WR_LinkEnd,WR_LinkReset,WR_Content,WR_PageNext,WR_Module From WR_Item Where WR_ID="&Int(ID(i)))
			  Do While Not Gsrs.Eof
                WR_Name = Gsrs(0)
				WR_BaseSetting = Gsrs(1)
				WR_Timing = Gsrs(2)
				WR_ListBegin = WR.CheckStr(Gsrs(3),2)
				WR_ListEnd = WR.CheckStr(Gsrs(4),2)
				WR_LinkBegin = WR.CheckStr(Gsrs(5),2)
				WR_LinkEnd = WR.CheckStr(Gsrs(6),2)
				WR_LinkReset = Gsrs(7)
				WR_Content = WR.CheckStr(Gsrs(8),2)
				WR_PageNext = WR.CheckStr(Gsrs(9),2)
				WR_Module = Gsrs(10)
				Gconn.Execute("INSERT Into WR_Item(WR_Name,WR_ChannelID,WR_Class,WR_Area,WR_BaseSetting,WR_Timing,WR_LastTime,WR_ListBegin,WR_ListEnd,WR_LinkBegin,WR_LinkEnd,WR_LinkReset,WR_Content,WR_PageNext,WR_Key,WR_Module,WR_Anamnesis)values('"&WR_Name&"',0,0,0,'"&WR_BaseSetting&"',"&WR_Timing&",Null,'"&WR_ListBegin&"','"&WR_ListEnd&"','"&WR_LinkBegin&"','"&WR_LinkEnd&"','"&WR_LinkReset&"','"&WR_Content&"','"&WR_PageNext&"',1,"&WR_Module&",Null)")
			    Set Grs = Gconn.Execute("Select Top 1 WR_ID From WR_Item Order By WR_ID Desc")
				If Not Grs.Eof Then
				  WR_ID = Grs(0)
				End If
				Grs.Close
		        Set Gsrso = sGconn.Execute("Select WR_Name,WR_Key,WR_LeachType,WR_Leach1,WR_Leach2,WR_Module From WR_Leach Where WR_ItemID="&Int(ID(i)))
			    Do While Not Gsrso.Eof
				  WR_Name = Gsrso(0)
				  WR_Key = Gsrso(1)
				  WR_LeachType = Gsrso(2)
				  WR_Leach1 = WR.CheckStr(Gsrso(3),2)
				  WR_Leach2 = WR.CheckStr(Gsrso(4),2)
				  WR_Module = Gsrso(5)
				  Gconn.Execute("INSERT Into WR_Leach(WR_Name,WR_ItemID,WR_Key,WR_LeachType,WR_Leach1,WR_Leach2,WR_Module)values('"&WR_Name&"',"&WR_ID&","&WR_Key&","&WR_LeachType&",'"&WR_Leach1&"','"&WR_Leach2&"',"&WR_Module&")")
			    Gsrso.MoveNext
			    Loop
			    Gsrso.Close
			  Gsrs.MoveNext
			  Loop
			  Gsrs.Close
			End If
		  Next
		  Call sGconnEnd()
		End If
		Set Gsrs = Nothing
		Set Grs = Nothing
		Call WRMPS.ErrView("·项目导入成功<br>·请修改您导入的项目的基本设置！<meta http-equiv=RefResh content='1;URL=Item.asp'>", 1)

      Case "AdmitTwo"
	    Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 Class=td1>" & vbCrLf
        Content = Content & "<form name=addform method='post' action='?Action=AdmitSave'>" & vbCrLf
        Content = Content & "<input name=DBPath type=hidden value=" & Request("DBPath") & ">" & vbCrLf
        Content = Content & "<tr Class=td4><td colspan=3><strong>可导入项目</strong></td></tr>" & vbCrLf
        Content = Content & "<tr class=td3 align=center>" & vbCrLf
        Content = Content & "<td width='8%'></td>" & vbCrLf
        Content = Content & "<td width='30%'>项目名称</td>" & vbCrLf
        Content = Content & "<td width=*>项目分类</td>" & vbCrLf
        Content = Content & "</tr>" & vbCrLf
        Call sgConnOpen()
        Gsrs.Open "Select WR_ID,WR_Name,WR_Module From WR_Item Order by WR_ID Desc", sGconn, 1, 1
        If Gsrs.EOF Then
          Content = Content & "<tr class=td2><td align=center colspan=9>没有采集项目</td></tr></table>" & vbCrLf
        Else
          ListNum = 20
          Gsrs.PageSize = ListNum
          If Page = "" Then Page = 1
          If Page < 1 Then Page = 1
          Gsrs.AbsolutePage = Page
          i = 0
          Do While Not Gsrs.EOF And i < ListNum
          Content = Content & "<tr class=td2 align=center>" & vbCrLf
          Content = Content & "<td align=center><input type=checkbox name=ID value="&Gsrs(0)&"></td>" & vbCrLf
          Content = Content & "<td>"&Gsrs(1)&"</td>" & vbCrLf
          Content = Content & "<td>"
		  Select Case Gsrs(2)
		    Case 1
		      Content = Content & "新闻"
			Case 2
		      Content = Content & "分类信息"
			Case 3
		      Content = Content & "店铺"
		  End Select
		  Content = Content & "</td>" & vbCrLf
          Content = Content & "</tr>" & vbCrLf
		  Gsrs.MoveNext
          i = i + 1
          Loop
		End If
		Gsrs.CLose
		Set Gsrs = Nothing
		Call sGconnEnd()
        Content = Content & "<tr class=td2><td colspan=2></td><td><input name='chkall' type='checkbox' id='chkall' value='select' onclick=""CheckAll(this.form)"" style='border:0'> 全部选择　<input type=submit name=Submit value='提 交'></td></tr>" & vbCrLf
        Content = Content & "<tr class=td2><td colspan=3><strong>注意：</strong>项目导入后请设置相关频道、栏目、地区以及自定义字段选项里的如目录等等！</td></tr>" & vbCrLf
        Content = Content & "</form>" & vbCrLf
        Content = Content & "</table>" & vbCrLf
	  
      Case "Admit"
        Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 Class=td1>" & vbCrLf
        Content = Content & "<form name=addform method='post' action='?Action=AdmitTwo'>" & vbCrLf
        Content = Content & "<tr Class=td4><td colspan=2><strong>项目导入</strong></td></tr>" & vbCrLf
        Content = Content & "<tr class=td3>" & vbCrLf
        Content = Content & "<td width='35%'><strong>源数据库路径</strong></td>" & vbCrLf
        Content = Content & "<td width='65%'><input name='DBPath' type='text' size=20 style='width:200' value='Data/Item.mdb'></td>" & vbCrLf
        Content = Content & "</tr>" & vbCrLf
        Content = Content & "<tr class=td2><td></td><td><input type=submit name=Submit value='提 交'></td></tr>" & vbCrLf
        Content = Content & "<tr class=td2><td colspan=2><strong>注意：</strong>项目导入后请设置相关频道、栏目、地区以及自定义字段选项里的如目录等等！</td></tr>" & vbCrLf
        Content = Content & "</form>" & vbCrLf
        Content = Content & "</table>" & vbCrLf

	  Case "ExportSave"
	    ID = Request("ID")
		ID = Replace(ID,"&nbsp;","")
		If ID <> "" Then
		  ID = Split(ID,",")
		  Call sgConnOpen()
		  For i = 0 To Ubound(ID)
		    If ID(i) <> "" Then
		      Set Gsrs = Gconn.Execute("Select WR_Name,WR_BaseSetting,WR_Timing,WR_ListBegin,WR_ListEnd,WR_LinkBegin,WR_LinkEnd,WR_LinkReset,WR_Content,WR_PageNext,WR_Module From WR_Item Where WR_ID="&Int(ID(i)))
			  Do While Not Gsrs.Eof
                WR_Name = Gsrs(0)
				WR_BaseSetting = Gsrs(1)
				WR_Timing = Gsrs(2)
				WR_ListBegin = WR.CheckStr(Gsrs(3),2)
				WR_ListEnd = WR.CheckStr(Gsrs(4),2)
				WR_LinkBegin = WR.CheckStr(Gsrs(5),2)
				WR_LinkEnd = WR.CheckStr(Gsrs(6),2)
				WR_LinkReset = Gsrs(7)
				WR_Content = WR.CheckStr(Gsrs(8),2)
				WR_PageNext = WR.CheckStr(Gsrs(9),2)
				WR_Module = Gsrs(10)
				sGconn.Execute("INSERT Into WR_Item(WR_Name,WR_ChannelID,WR_Class,WR_Area,WR_BaseSetting,WR_Timing,WR_LastTime,WR_ListBegin,WR_ListEnd,WR_LinkBegin,WR_LinkEnd,WR_LinkReset,WR_Content,WR_PageNext,WR_Key,WR_Module,WR_Anamnesis)values('"&WR_Name&"',0,0,0,'"&WR_BaseSetting&"',"&WR_Timing&",Null,'"&WR_ListBegin&"','"&WR_ListEnd&"','"&WR_LinkBegin&"','"&WR_LinkEnd&"','"&WR_LinkReset&"','"&WR_Content&"','"&WR_PageNext&"',1,"&WR_Module&",Null)")
			    Set Grs = sGconn.Execute("Select Top 1 WR_ID From WR_Item Order By WR_ID Desc")
				If Not Grs.Eof Then
				  WR_ID = Grs(0)
				End If
				Grs.Close
		        Set Gsrso = Gconn.Execute("Select WR_Name,WR_Key,WR_LeachType,WR_Leach1,WR_Leach2,WR_Module From WR_Leach Where WR_ItemID="&Int(ID(i)))
			    Do While Not Gsrso.Eof
				  WR_Name = Gsrso(0)
				  WR_Key = Gsrso(1)
				  WR_LeachType = Gsrso(2)
				  WR_Leach1 = WR.CheckStr(Gsrso(3),2)
				  WR_Leach2 = WR.CheckStr(Gsrso(4),2)
				  WR_Module = Gsrso(5)
				  sGconn.Execute("INSERT Into WR_Leach(WR_Name,WR_ItemID,WR_Key,WR_LeachType,WR_Leach1,WR_Leach2,WR_Module)values('"&WR_Name&"',"&WR_ID&","&WR_Key&","&WR_LeachType&",'"&WR_Leach1&"','"&WR_Leach2&"',"&WR_Module&")")
			    Gsrso.MoveNext
			    Loop
			    Gsrso.Close
			  Gsrs.MoveNext
			  Loop
			  Gsrs.Close
			End If
		  Next
		  Call sGconnEnd()
		End If
		Set Gsrs = Nothing
		Set Grs = Nothing
		Call WRMPS.ErrView("·项目导出成功<meta http-equiv=RefResh content='1;URL=?Action=Export'>", 1)
	  
      Case "Export"
	    Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 Class=td1>" & vbCrLf
        Content = Content & "<form name=addform method='post' action='?Action=ExportSave'>" & vbCrLf
        Content = Content & "<tr Class=td4><td colspan=3><strong>可导出项目</strong></td></tr>" & vbCrLf
        Content = Content & "<tr class=td3 align=center>" & vbCrLf
        Content = Content & "<td width='8%'></td>" & vbCrLf
        Content = Content & "<td width='30%'>项目名称</td>" & vbCrLf
        Content = Content & "<td width=*>项目分类</td>" & vbCrLf
        Content = Content & "</tr>" & vbCrLf
        Grs.Open "Select WR_ID,WR_Name,WR_Module From WR_Item Where WR_Key = 1 Order by WR_ID Desc", Gconn, 1, 1
        If Grs.EOF Then
          Content = Content & "<tr class=td2><td align=center colspan=9>没有采集项目</td></tr></table>" & vbCrLf
        Else
          ListNum = 20
          Grs.PageSize = ListNum
          If Page = "" Then Page = 1
          If Page < 1 Then Page = 1
          Grs.AbsolutePage = Page
          i = 0
          Do While Not Grs.EOF And i < ListNum
          Content = Content & "<tr class=td2 align=center>" & vbCrLf
          Content = Content & "<td align=center><input type=checkbox name=ID value="&Grs(0)&"></td>" & vbCrLf
          Content = Content & "<td>"&Grs(1)&"</td>" & vbCrLf
          Content = Content & "<td>"
		  Select Case Grs(2)
		    Case 1
		      Content = Content & "新闻"
			Case 2
		      Content = Content & "分类信息"
			Case 3
		      Content = Content & "店铺"
		  End Select
		  Content = Content & "</td>" & vbCrLf
          Content = Content & "</tr>" & vbCrLf
		  Grs.MoveNext
          i = i + 1
          Loop
		End If
		Grs.CLose
        Content = Content & "<tr class=td3>" & vbCrLf
        Content = Content & "<td colspan=2><strong>目标数据库路径</strong></td>" & vbCrLf
        Content = Content & "<td><input name='DBPath' type='text' size=20 style='width:200' value='Data/Item.mdb'></td>" & vbCrLf
        Content = Content & "</tr>" & vbCrLf
        Content = Content & "<tr class=td2><td colspan=2></td><td><input name='chkall' type='checkbox' id='chkall' value='select' onclick=""CheckAll(this.form)"" style='border:0'> 全部选择　<input type=submit name=Submit value='提 交'></td></tr>" & vbCrLf
        Content = Content & "</form>" & vbCrLf
        Content = Content & "</table>" & vbCrLf      
    End Select
	Set Gsrso = Nothing
	Set Gsrs = Nothing
	Set Grs = Nothing
    Call ConnClose()
    Response.write Content
    Call GetBottom()
    Call ClassEnd()
End Sub
%>
⌨️ 快捷键说明

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