user_collection.asp

网人分类信息5.0商业版。非常优秀的分类信息系统。比较少见。

<!--#include file="Cook.asp" -->
<%
If Int(UserFlag(11)) < 1 Then Call WRMPS.ErrView("·您没有权限使用此功能", 0)
Dim eType,CollectionSort,i,n,Url,eSort,NewSort,Title

ID = WRMPS.CheckStr(Request("ID"), 0)
eType = WRMPS.CheckStr(Request("Type"), 0)
Page = WRMPS.CheckStr(Request("page"),1)
Title = WRMPS.CheckStr(Request("Tit"), 0)
Url = WRMPS.CheckStr(Request("Url"), 0)

  Call DBConnBegin()
  Set Rs = Server.CreateObject("ADODB.RecordSet")
  Rs.Open "Select WM_CollectionSort From WM_Member Where WM_ID = "&MemID ,Conn,1,1
  If Not Rs.Eof Then
	 CollectionSort = Rs(0)
  End If
  Rs.Close
Select Case Request("Action")
  Case "Del"
	 Conn.Execute("Delete From WM_Collection Where WM_User='"&MemName&"' and WM_ID="&ID)
	 Call WRMPS.ErrView("·删除成功<meta http-equiv=refresh content='1;URL=?Type="&eType&"&Page="&Page&"'>",1)
	 
  Case "EditSave"
	 If Title <> "" and Url <> "" Then
	   If ID <> "" Then
	     eSort = WRMPS.CheckStr(Request("Sort"), 0)
		 If eSort = "" Then eSort = NUll
	     Conn.Execute("Update WM_Collection Set WM_Title='"&Title&"',WM_Url='"&Url&"',WM_Sort='"&eSort&"' Where WM_User='"&MemName&"' and WM_ID="&ID)
	   Else
	     Call WRMPS.ErrView("·操作错误<meta http-equiv=refresh content='1;URL=?Type="&eType&"&Page="&Page&"'>",0)
	   End IF
	 Else
	    Call WRMPS.ErrView("·收藏标题或URL不能为空<meta http-equiv=refresh content='1;URL=?Type="&eType&"&Page="&Page&"'>",0)
	 End If
	 Call WRMPS.ErrView("·收藏修改成功<meta http-equiv=refresh content='1;URL=?Type="&eType&"&Page="&Page&"'>",1)
	 
  Case "Edit"
      Content = Content & PageTop()
      Content = Content & UserPath(",<a href=User_Collection.asp>收藏管理</a>")
      Set Rs = Conn.Execute("Select WM_Title,WM_Url,WM_Sort From WM_Collection Where WM_User='"&MemName&"' and WM_ID="&ID)
	  If Not Rs.Eof Then
	  Url = Rs(1)
	  Title = Rs(0)
	  eSort = Rs(2)
	  Content = Content & "<table width='100%' cellpadding=0 cellspacing=1 class=td1>" & vbCrLf
      Content = Content & "<tr><td colspan=2 class=td4><strong>修改收藏</strong></td></tr>" & vbCrLf
      Content = Content & "<form action='?Action=EditSave&ID="&ID&"&Type="&eType&"&Page="&Page&"' name=myform method=POST>" & vbCrLf
	  Content = Content & "<tr>" & vbCrLf
      Content = Content & "<td width='20%' class=td2>所属分类</td>" & vbCrLf
      Content = Content & "<td class=td2 width='80%'><select name=Sort>"
	  Content = Content & "<option value=''"&WRMPS.GetCheckVer("",eSort,0)&"></option>"
	  Content = Content & "<option value='文章收藏'"&WRMPS.GetCheckVer("文章收藏",eSort,0)&">文章收藏</option>"
	  Content = Content & "<option value='信息收藏'"&WRMPS.GetCheckVer("信息收藏",eSort,0)&">信息收藏</option>"
	  Content = Content & "<option value='店铺收藏'"&WRMPS.GetCheckVer("店铺收藏",eSort,0)&">店铺收藏</option>"
	  Content = Content & "<option value='优惠券收藏'"&WRMPS.GetCheckVer("优惠券收藏",eSort,0)&">优惠券收藏</option>"
      If CollectionSort <> "" and IsNull(CollectionSort) = False Then
	    For i=0 To UBound(Split(CollectionSort,","))
	      Content = Content & "<option value='"&Split(CollectionSort,",")(i)&"'"&WRMPS.GetCheckVer(Split(CollectionSort,",")(i),eSort,0)&">"&Split(CollectionSort,",")(i)&"</option>"
	    Next
	  End If
	  Content = Content & "</select></td>" & vbCrLf
      Content = Content & "</tr>" & vbCrLf
	  Content = Content & "<tr>" & vbCrLf
      Content = Content & "<td class=td2>收藏名称</td>" & vbCrLf
      Content = Content & "<td class=td2><input type=text name=Tit size=50 maxlength=50 value="""&Title&"""></td>" & vbCrLf
      Content = Content & "</tr>" & vbCrLf
	  Content = Content & "<tr>" & vbCrLf
      Content = Content & "<td class=td2>URL</td>" & vbCrLf
      Content = Content & "<td class=td2><input type=text name=Url size=50 maxlength=100 value="""&Url&"""></td>" & vbCrLf
      Content = Content & "</tr>" & vbCrLf
	  Content = Content & "<tr>" & vbCrLf
      Content = Content & "<td class=td2></td>" & vbCrLf
      Content = Content & "<td class=td2><input type='submit' name='submit' value='确认收藏'></td>" & vbCrLf
      Content = Content & "</tr>" & vbCrLf
      Content = Content & "</form>" & vbCrLf
      Content = Content & "</Table>" & vbCrLf
	  Content = Content & PageButtom()
	  Else
	    Call WRMPS.ErrView("·收藏信息不存在<meta http-equiv=refresh content='1;URL=?Type="&eType&"&Page="&Page&"'>",0)
	  End If
  
  Case "DelSort"
    If CollectionSort <> "" and IsNull(CollectionSort) = False Then
	  For i=0 To UBound(Split(CollectionSort,","))
	    If Split(CollectionSort,",")(i) <> eType Then
		  If NewSort = "" Then
		    NewSort = Split(CollectionSort,",")(i)
		  Else
		    NewSort = NewSort & "," & Split(CollectionSort,",")(i)
		  End If
		End If
	  Next
	  Conn.Execute("Update WM_Member Set WM_CollectionSort = '"&NewSort&"' Where WM_ID = "&MemID)
	  Conn.Execute("Update WM_Collection Set WM_Sort = Null Where WM_User='"&MemName&"' and WM_Sort='"&eType&"'")
	  Response.redirect "?Page="&Page
	End If

  Case "Add"
    eSort = WRMPS.CheckStr(Request("Sort"), 0)
	If eSort = "文章收藏" Or eSort = "信息收藏" Or eSort = "店铺收藏" Or eSort = "优惠券收藏" Then Call WRMPS.ErrView("·分类名称不有为默认类别名称<meta http-equiv=refresh content='1;URL=?Type="&eType&"&Page="&Page&"'>",0)
	If eSort <> "" Then
	  If Instr(","&CollectionSort&",",","&eSort&",") > 0 Then  Call WRMPS.ErrView("·此分类已经存在<meta http-equiv=refresh content='1;URL=?Type="&eType&"&Page="&Page&"'>",0)
	  If CollectionSort <> "" Then CollectionSort = CollectionSort & "," & eSort Else CollectionSort = eSort
	  Conn.Execute("Update WM_Member Set WM_CollectionSort = '"&CollectionSort&"' Where WM_ID = "&MemID)
	  Response.redirect "?Type="&eType&"&Page="&Page
	Else
	  Call WRMPS.ErrView("·请填写分类名称<meta http-equiv=refresh content='1;URL=?Type="&eType&"&Page="&Page&"'>",0)
	End If
	
  Case Else
    Content = Content & PageTop()
    Content = Content & UserPath(",<a href=User_Collection.asp>收藏管理</a>")
	Content = Content & "<table width='100%' cellpadding=0 cellspacing=1 class=td1>" & vbCrLf
    Content = Content & "<tr><td colspan=2 class=td4><strong>收藏管理</strong></td></tr>" & vbCrLf
    Content = Content & "<tr><td width='15%' valign=top>"
	Content = Content & "　 <a href=User_Collection.asp><strong style=""font-size:14px;line-height:180%"">所有收藏</strong></a><br>"
	Content = Content & "　 <a href=?Type="&Server.URLEncode("文章收藏")&"><strong style=""font-size:14px;line-height:180%"">文章收藏</strong></a><br>"
	Content = Content & "　 <a href=?Type="&Server.URLEncode("信息收藏")&"><strong style=""font-size:14px;line-height:180%"">信息收藏</strong></a><br>"
	Content = Content & "　 <a href=?Type="&Server.URLEncode("店铺收藏")&"><strong style=""font-size:14px;line-height:180%"">店铺收藏</strong></a><br>"
	Content = Content & "　 <a href=?Type="&Server.URLEncode("优惠券收藏")&"><strong style=""font-size:14px;line-height:180%"">优惠券收藏</strong></a><br>"
    If CollectionSort <> "" and IsNull(CollectionSort) = False Then
	  For i=0 To UBound(Split(CollectionSort,","))
	    Content = Content & "<a href=?Type="&Server.URLEncode(Split(CollectionSort,",")(i))&"&Page="&Page&"&Action=DelSort>删</a> <a href=?Type="&Split(CollectionSort,",")(i)&"><strong style=""font-size:14px;line-height:180%"">"&Split(CollectionSort,",")(i)&"</strong></a><br>"
	  Next
	End If
	Content = Content & "<hr size=1 color=#cccccc>"
    Content = Content & "<form action='?Type="&eType&"&Page="&Page&"&Action=Add' name=myform method=POST>" & vbCrLf
	Content = Content & "<input type='text' name='sort' size=10>"
	Content = Content & "<input type='submit' name='submit' value='添加'>"
    Content = Content & "</form>" & vbCrLf

	Content = Content & "</td><td width='85%' valign=top>"
	  
      Content = Content & "<table width='100%' cellpadding=2 cellspacing=1 border=0 align=center class=td1>" & vbCrLf
	  Content = Content & "<tr align=center>" & vbCrLf
      Content = Content & "<td class=td3>名称</td>" & vbCrLf
      Content = Content & "<td class=td3 width='15%'>操作</td></tr>" & vbCrLf
      If eType <> "" Then SQL = " and WM_Sort='"&eType&"'"
	  SQL = "Select WM_ID,WM_Title,WM_Url From WM_Collection Where WM_User = '"&MemName&"'"&SQL&" Order By WM_ID Desc"
	  Rs.Open Sql, Conn, 1, 1
        If Rs.EOF Then
          Content = Content & "<tr><td colspan=3>还没有任何收藏</td></tr></table>" & vbCrLf
        Else
          '分页的实现
          ListNum = 20
          Rs.PageSize = ListNum
          If Page = "" Then Page = 1
          If Page < 1 Then Page = 1
          Rs.AbsolutePage = Page
          i = 0
          Do While Not Rs.EOF And i < ListNum
		    Url = Rs(2)
            Content = Content & "<tr class=td2>" & vbCrLf
	        Content = Content & "<td><a href='"&Url&"' target=_blank>"&Rs(1)&"</a></td>" & vbCrLf
	        Content = Content & "<td align=center><a href='?Action=Edit&Type="&eType&"&Page="&Page&"&ID="&Rs(0)&"'>修改</a> | <a href='?Action=Del&Type="&eType&"&Page="&Page&"&ID="&Rs(0)&"' onclick=""return confirm('确定删除？');"">删除</a></td></tr>" & vbCrLf
          Rs.MoveNext
          i = i + 1
          Loop
          URLParameter = "Type="&eType
          Content = Content & "</table>" & vbCrLf
          Content = Content & "<table width='100%' cellpadding=2 cellspacing=1 align=center><tr><td align=right class=td5>" & vbCrLf
          Content = Content & WRMPS.GetPageList(URLParameter, ListNum, Rs.RecordCount, Page) ' 插入分页
          Content = Content & "</td></tr></table>" & vbCrLf
        End If
	  Rs.Close
	Content = Content & "</td></tr>" & vbCrLf
    Content = Content & "</Table>" & vbCrLf
	  
	Content = Content & PageButtom()
End Select 
Set Rs=Nothing
Call DBConnEnd()
Call ClassEnd()
Response.write Content
%>