wm.class.asp

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

      If Cdate(WM_aBold) > Now() Then
	    Content = Content & "已使用 (到期："&Year(WM_aBold)&"-"&Month(WM_aBold)&"-"&Day(WM_aBold)&")<br>再次"
	  End If
	  Content = Content & "购买 <input type=text name=aBold value=0 size=5> 天"
	  Content = Content & "</td>" & vbCrlf
	  Content = Content & "  </tr>" & vbCrlf
      Content = Content & "</table>" & vbCrlf
	  Content = Content & "</td>" & vbCrlf

      Content = Content & "    <td>"
	  Content = Content & "<table width='100%' cellpadding='0' cellspacing=0>" & vbCrLf
      Content = Content & "  <tr>" & vbCrlf
      Content = Content & "    <td align=center width='90px'><div style='border:1px #999999 solid;padding:5px'><img src='../member/Img/dj8.gif'></div></td>" & vbCrlf
      Content = Content & "    <td style='padding:0 5px' valign=top><strong>全屏信息道具</strong><br><br>"
      If WM_Full > 0 Then
	    Content = Content & "已使用"
	  Else
	    Content = Content & "购买 <input type=checkbox name=WM_Full value=1> 购买"
	  End If
	  Content = Content & "</td>" & vbCrlf
	  Content = Content & "  </tr>" & vbCrlf
      Content = Content & "</table>" & vbCrlf
	  Content = Content & "</td>" & vbCrlf


      Content = Content & "  </tr>" & vbCrlf
	  Content = Content & "  <tr class=td2><td colspan=3 height=60px><div style='text-align:center'>"
	  Content = Content & "<br><input type=checkbox name=DelDJ value=1>取消所有已使用的道具　<input type=submit value='确认使用'></div>"
      Content = Content & "  <tr class=td3><td colspan=3><li>后台使用道具不收任何费用。</td></tr>" & vbCrlf
      Content = Content & "</form>"
      Content = Content & "</table>" & vbCrlf

  Case Else
	  If SearchID <> "" Then
	    SearchID = Replace(Replace(SearchID, " ", ""), "&nbsp;", "")
	    If Split(SearchID,",")(0) <> "" Then
		Select Case Split(SearchID,",")(1)
		  Case 1
		    If IsNumeric(Split(SearchID,",")(0)) Then
			  Search_ID = " and WM_ID =" & Split(SearchID,",")(0)
			Else
			  Call WRMPS.ErrView("·搜索出错：ID必须为数字",0)
			End If
		  Case 2
		    Search_ID = " and WM_Title like'%" & Split(SearchID,",")(0) &"%'"
		  Case 3
		    Search_ID = " and WM_Post ='" & Split(SearchID,",")(0) &"'"
		End Select
		End If
	  Else
	    Search_ID = ""
	  End If
      Call DBConnBegin()
      Set Rs = Conn.Execute("Select WM_CreateHTML From WM_Channel Where WM_ID="&ChannelID)
	  If Not Rs.Eof Then
	    CreateHTML = Rs(0)
	  End If
	  Rs.Close
      Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 class=td1><tr class=td2>" & vbCrLf
      Content = Content & "<form name='form1' action='WM.Class.asp?SearchKey="&SearchKey&"&Days="&Days&"&SearchID="&SearchID&"&AreaName="&AreaName&"' method='post'><td width='10%'>"
	  Content = Content & "<select name=PostName onChange='javascript:submit()'>" & vbCrLf
      Content = Content & "<option value=''>==录入==</option>" & vbCrLf
      Set Rso = Conn.Execute("Select WM_UserName From WM_admin")
      Do While Not Rso.Eof
        Content = Content & "<option value='"&Rso(0)&"'"&WRMPS.GetCheckVer(Rso(0),PostName,0)&">"&Rso(0)&" 的信息</option>" & vbCrLf
	  Rso.Movenext
	  Loop
	  Rso.Close
      Content = Content & "</select></td></form>" & vbCrLf
      Content = Content & "<form name='form1' action='WM.Class.asp?PostName="&PostName&"&Days="&Days&"&SearchID="&SearchID&"&AreaName="&AreaName&"' method='get'><td width='10%'>"
	  Content = Content & "<select name=SearchKey onChange='javascript:submit()'>" & vbCrLf
      Content = Content & "<option value=0"&WRMPS.GetCheckVer(0,Int(SearchKey),0)&">==类型==</option>" & vbCrLf
      Content = Content & "<option value=1"&WRMPS.GetCheckVer(1,Int(SearchKey),0)&">待审核</option>" & vbCrLf
      Content = Content & "<option value=2"&WRMPS.GetCheckVer(2,Int(SearchKey),0)&">已审核</option>" & vbCrLf
      Content = Content & "<option value=3"&WRMPS.GetCheckVer(3,Int(SearchKey),0)&">已推荐</option>" & vbCrLf
      Content = Content & "<option value=15"&WRMPS.GetCheckVer(15,Int(SearchKey),0)&">已过期</option>" & vbCrLf
      Content = Content & "<option value=4"&WRMPS.GetCheckVer(4,Int(SearchKey),0)&">游客发布</option>" & vbCrLf
      Content = Content & "<option value=5"&WRMPS.GetCheckVer(5,Int(SearchKey),0)&">会员发布</option>" & vbCrLf
      Content = Content & "<option value=6"&WRMPS.GetCheckVer(6,Int(SearchKey),0)&">后台发布</option>" & vbCrLf
      Content = Content & "<option value=7"&WRMPS.GetCheckVer(7,Int(SearchKey),0)&">代理发布</option>" & vbCrLf
      Content = Content & "<option value=8"&WRMPS.GetCheckVer(8,Int(SearchKey),0)&">采集</option>" & vbCrLf
      Content = Content & "<option value=9"&WRMPS.GetCheckVer(9,Int(SearchKey),0)&">收费信息</option>" & vbCrLf
      Content = Content & "<option value=10"&WRMPS.GetCheckVer(10,Int(SearchKey),0)&">使用道具</option>" & vbCrLf
      Content = Content & "<option value=11"&WRMPS.GetCheckVer(11,Int(SearchKey),0)&">用户推荐过</option>" & vbCrLf
      Content = Content & "<option value=12"&WRMPS.GetCheckVer(12,Int(SearchKey),0)&">用户投诉过</option>" & vbCrLf
      Content = Content & "<option value=13"&WRMPS.GetCheckVer(13,Int(SearchKey),0)&">用户投诉分类错误</option>" & vbCrLf
      Content = Content & "<option value=14"&WRMPS.GetCheckVer(14,Int(SearchKey),0)&">用户投诉为中介信息</option>" & vbCrLf
      Content = Content & "</select></td></form>" & vbCrLf
	  Content = Content & "<form name='form1' action='WM.Class.asp?SearchKey="&SearchKey&"&PostName="&PostName&"&SearchID="&SearchID&"&AreaName="&AreaName&"' method='get'><td width='10%'>"
	  Content = Content & " <select name='Days' onChange='javascript:submit()'>" & vbCrLf
	  Content = Content & "<option value=0>==日期==</option>" & vbCrLf
      For i=0 to 180
	    Content = Content & "<option value='"&date()-i&"'"&WRMPS.GetCheckVer(date()-i,Days,0)&">"&date()-i&"</option>" & vbCrLf
	  Next
      Content = Content & "</select> </td></form>" & vbCrLf
	  
	  Content = Content & "<form name='form1' action='WM.Class.asp?SearchKey="&SearchKey&"&PostName="&PostName&"&Days="&Days&"&SearchID="&SearchID&"' method='get'><td width='10%'>"
	  Content = Content & WRDB.GetAreaSort(0,1,Int(AreaName),"AreaName onChange='javascript:submit()'")
      Content = Content & "</td></form>" & vbCrLf
	  If SearchID <> "" Then
	    S1 = Split(SearchID,",")(0)
		S2 = Int(Split(SearchID,",")(1))
	  End If
	  Content = Content & "<form name='form1' action='WM.Class.asp?SearchKey="&SearchKey&"&PostName="&PostName&"&Days="&Days&"&AreaName="&AreaName&"' method='get'><td width='60%'>"
	  Content = Content & "<input type='text' name='SearchID' size=10 value="&S1&"><select name=SearchID><option value=1"&WRMPS.GetCheckVer(1,S2,0)&">按ID</option><option value=2"&WRMPS.GetCheckVer(2,S2,0)&">按标题</option><option value=3"&WRMPS.GetCheckVer(3,S2,0)&">按发布人</option></select> <input type=submit name='Submit' value='查找'></td></form>" & vbCrLf
	  
	  Content = Content & "</tr></Table>" & vbCrLf

      Content = Content & "<table width='100%' cellpadding=2 cellspacing=1 border=0 align=center class=td1>" & vbCrLf
      Content = Content & "<form action='?Action=Save&Page="&Page&"&SearchKey="&SearchKey&"&PostName="&PostName&"&Days="&Days&"&SearchID="&SearchID&"&AreaName="&AreaName&"' name=myform method=POST>" & vbCrLf
      Content = Content & "<tr class=td4 align=center>" & vbCrLf
      Content = Content & "<td width='3%'></td>" & vbCrLf
      If CreateHTML > 1 Then Content = Content & "<td width='4%'>HTML</td>" & vbCrLf
	  Content = Content & "<td>标题</td>" & vbCrLf
      Content = Content & "<td width='15%'>添加日期</td>" & vbCrLf
      Content = Content & "<td width='4%'>审核</td>" & vbCrLf
      Content = Content & "<td width='4%'>推荐</td>" & vbCrLf
      Content = Content & "<td width='8%'>查看/回复</td>" & vbCrLf
      Content = Content & "<td width='10%'>发布者</td>" & vbCrLf
      Content = Content & "<td width='5%'>道具</td>" & vbCrLf
      Content = Content & "<td width='12%'>操作</td></tr>" & vbCrLf
	  Dim SKey,PName,Ds,SID
      Select Case SearchKey
	    Case 1
		  SKey = " and WM_Key=0"
	    Case 2
		  SKey = " and WM_Key=1"
	    Case 3
		  SKey = " and WM_Commend=1 and WM_Key=1"
	    Case 4
		  SKey = " and WM_PostType=0 and WM_Key=1"
	    Case 5
		  SKey = " and WM_PostType=1 and WM_Key=1"
	    Case 6
		  SKey = " and WM_PostType=2 and WM_Key=1"
	    Case 7
		  SKey = " and WM_PostType=3 and WM_Key=1"
	    Case 8
		  SKey = " and WM_PostType=4 and WM_Key=1"
	    Case 9
		  SKey = " and WM_Charge>0 and WM_Key=1"
	    Case 10
		  SKey = " and (WM_aZTop > "&ConnTime&" Or WM_aTop > "&ConnTime&" Or WM_aTColor > "&ConnTime&" Or WM_aBColor > "&ConnTime&" Or WM_aBold > "&ConnTime&" Or WM_aProp <> '0|0') and WM_Key=1"
	    Case 11
		  SKey = " and WM_mCommend>0 and WM_Key=1"
	    Case 12
		  SKey = " and WM_mTrash>0 and WM_Key=1"
	    Case 13
		  SKey = " and WM_mSortErr>0 and WM_Key=1"
	    Case 14
		  SKey = " and WM_mAgency>0 and WM_Key=1"
	    Case 15
          SKey = " and "&ConnTime&">WM_EndTime"
		Case Else
		  SKey = " and WM_Key=1"
	  End Select
	  If PostName <> "" Then PName = " and WM_PostType = 2 and WM_Post = '"&PostName&"'" Else PName = ""
	  If Days > 0 Then
	    If ConnTypeStr = 0 Then
          Ds = " and WM_PostTime>#"&CDate(Days)&"# and WM_PostTime<#"&CDate(Days)+1&"#"
		Else
          Ds = " and WM_PostTime>'"&CDate(Days)&"' and WM_PostTime<'"&CDate(Days)+1&"'"
		End If
	  End If
	  If AreaName <> "" Then
  	    If AreaName > 0 Then AN = " and WM_AreaID="&AreaName Else AN = ""
	  Else
	    AN = ""
	  End If
	  SQL = SKey&PName&Ds&Search_ID&AN 
	  If SQL <> "" Then
	    If Lcase(Left(SQL,4)) = " and" Then SQL = Right(SQL,len(SQL)-4)
	  End If

      Set ClsPageList = New Cls_PageView  
      ClsPageList.strTableName = "WM_ClassAD"  
      ClsPageList.strPageUrl = ""  
      ClsPageList.strFieldsList = "WM_ID,WM_title,WM_PostTime,WM_Key,WM_Commend,WM_Re,WM_Hit,WM_PostType,WM_Post,WM_ChannelDir,WM_ClassDir,WM_ChannelID,WM_AreaID,WM_aZTop,WM_aTop,WM_aTColor,WM_aBColor,WM_aBold,WM_aProp,WM_Full"  
      ClsPageList.strCondiction = SQL
      ClsPageList.strOrderList = "WM_ID desc"  
      ClsPageList.strPrimaryKey = "WM_ID"  
      ClsPageList.intPageSize = 20
      ClsPageList.intPageNow = Page
      ClsPageList.strCookiesName = "RecordCount"  
      ClsPageList.strPageVar = "Page"  
      ClsPageList.intRefresh = 1
	  ClsPageList.inAdmin = 1
      ClsPageList.objConn = Conn  
      ClsPageList.InitClass  
      arrPage = ClsPageList.arrPage  
      strPageList = ClsPageList.strPageList  
      Set ClsPageList = nothing  

      If IsArray(arrPage) Then
         For i = 0 to UBound(arrPage, 2)  
            Content = Content & "<tr class=td2 align=center>" & vbCrLf
            Content = Content & "<td><input type=checkbox name=CSaveID value="&arrPage(0,i)&" style='border:0'></td>" & vbCrLf
            If CreateHTML > 1 Then
			  Content = Content & "<td><a href=?Action=Save&Work=Cre&CSaveID="&arrPage(0,i)&"&Page="&Page&"&SearchKey="&SearchKey&"&PostName="&PostName&"&Days="&Days&"&SearchID="&SearchID&"&AreaName="&AreaName&">"
			  Call WRMPS.FsoBegin()
			  If WRMPS.FsoIsTrue("File",WRMPS.GetShowUrl(1,1,2,arrPage(0,i),arrPage(2,i),arrPage(9,i)&"/"&arrPage(10,i),arrPage(11,i))) Then
			    Content = Content & "<strong>(√)</strong>"
			  Else
			    Content = Content & "<strong><font color=#FF0000>(×)</font></strong>"
			  End If
			  Call WRMPS.FsoEnd()
			  Content = Content & "</a></td>" & vbCrLf
			End If
            Content = Content & "<td align=left><a href="&WRMPS.GetShowUrl(1,1,0,arrPage(0,i),arrPage(2,i),arrPage(9,i)&"/"&arrPage(10,i),arrPage(11,i))&" target=_blank>"&arrPage(1,i)&"</a></td>" & vbCrLf
            Content = Content & "<td>"&arrPage(2,i)&"</td>" & vbCrLf
            Content = Content & "<td>"
			if arrPage(3,i)=1 then Content = Content & "√" else Content = Content & "<b><font color=#FF0000>×</font></b>"
			Content = Content & "</td>" & vbCrLf
            Content = Content & "<td>"
			if arrPage(4,i)=1 then Content = Content & "<b><font color=#FF0000>√</font></b>" else Content = Content & "×"
			Content = Content & "</td>" & vbCrLf
            Content = Content & "<td>"&arrPage(6,i)&"/<a href=WM.Class_Re.asp?ChannelID="&ChannelID&"&AID="&arrPage(0,i)&">"&arrPage(5,i)&"</a></td>" & vbCrLf
            Content = Content & "<td align=left>"
			Select Case arrPage(7,i)
			  Case 0
                Content = Content & "游客|"
			  Case 1
                Content = Content & "<font color=red>会员</font>|"
			  Case 2
                Content = Content & "<font color=blue>后台</font>|"
			  Case 3
                Content = Content & "<font color=red>代理</font>|"
			  Case 4
                Content = Content & "<font color=#FF9900>采集</font>|"
			End Select
			Content = Content & arrPage(8,i)&"</td>" & vbCrLf
            
			Content = Content & "<td><a href=# onClick=""openWithIframe('信息道具','?Action=DJ&ID="&arrPage(0,i)&"',800,500);"">"
			If arrPage(13,i) < Now() And arrPage(14,i) < Now() And arrPage(15,i) < Now() And arrPage(16,i) < Now() And arrPage(17,i) < Now() And Trim(arrPage(18,i)) = "0|0" And arrPage(19,i) = 0 Then
			  Content = Content & "<img src='../Member/img/djno.gif' title='未使用道具' border=0>"
			Else
			  Content = Content & "<img src='../Member/img/dj.gif' title='已使用道具' border=0>"
			End If
			Content = Content & "</a></td>" & vbCrLf

			Content = Content & "<td>"
			Content = Content & "<a href='?Action=Edit&ID="&arrPage(0,i)&"&Page="&Page&"&SearchKey="&SearchKey&"&PostName="&PostName&"&Days="&Days&"&SearchID="&SearchID&"&AreaName="&AreaName&"'>修改</a> <a href='?Action=Save&Work=Del&CSaveID="&arrPage(0,i)&"&Page="&Page&"&SearchKey="&SearchKey&"&PostName="&PostName&"&Days="&Days&"&SearchID="&SearchID&"&AreaName="&AreaName&"' onclick=""return confirm('确定删除？');Loading.style.display='';Loading.style.bottom=100;"">删除</a>"
			Content = Content & "</td></tr>" & vbCrLf
         Next  
       End If  
       Content = Content & "</table>" & vbCrLf
       Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 align=center class=td3><tr><td height=30>" & vbCrLf
       Content = Content & "<input name='chkall' type='checkbox' id='chkall' value='select' onclick=""CheckAll(this.form)"" style='border:0'>全选　<select name='Work'>"
	   If SearchKey = 1 Then Content = Content & "<option value='Key'>审核</option>"
	   If SearchKey <> 1 Then Content = Content & "<option value='Tui'>推荐</option><option value='NoTui'>取消推荐</option>"
       Content = Content & "<option value='Del'>删除</option></select>　<input type=submit name='submit' value='操 作' onclick=""Loading.style.display='';Loading.style.bottom=100;"">" & vbCrLf
       Content = Content & "</td><td align=right>" & vbCrLf
       Content = Content & strPageList ' 插入分页
       Content = Content & "</td></tr></Form>"
       If CreateHTML > 1 Then Content = Content & "<tr><td class=td2 colspan=2><strong>　注：</strong>HTML栏中 <strong><font color=#FF0000>(×)</font></strong> 代表此静态页面不存在，可以点击生成。</td></tr>" & vbCrLf
	   Content = Content &"</table>" & vbCrLf

	   Call DBConnEnd()
End Select
Call WRMPS.Loading("")
Call ClassEnd()
Response.write Content
Call GetBottom()
%>