wm.class.asp

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

	  Content = Content & "<tr class=td2><td><strong>阅读"&WR_Other(0)&"</strong><br>免费阅读请设为 0，否则有权限的会员阅读此文章时将消耗相应"&WR_Other(0)&"，游客将无法阅读此文章<br><font class=font2>频道内容页设置生成HTML时收费无效</font></td>" & vbCrLf
      Content = Content & "<td><input name='Charge' type='text' style='width:50' maxlength='19' value='" & Rs("WM_Charge") & "'></td></tr>" & vbCrLf
	  Content = Content & "<tr class=td2><td><strong>重复收费</strong><br>选择开启则用户每阅读此内容一次就重复收费一次</td>" & vbCrLf
      Content = Content & "<td><input type=radio name='RepeatCharge' value='1'" & WRMPS.GetCheckVer(1, Rs("WM_RepeatCharge"), 1) & "> 开启　<input type=radio name='RepeatCharge' value='0'" & WRMPS.GetCheckVer(0, Rs("WM_RepeatCharge"), 1) & "> 关闭</td></tr>" & vbCrLf
      Content = Content & "<tr class=td4><td colspan=2><strong>模板选项</strong></td></tr>" & vbCrLf
      Content = Content & "<tr class=td2><td><strong>模板选择</strong></td><td>"&TempSelect(Rs("WM_TempID"),17,2,"TempID")&"</td></tr>" & vbCrLf
	  Content = Content & "<tr Class=td2><td></td><td><input type=submit value='提交修改' onclick=""Loading.style.display='';Loading.style.bottom=100;""></td></tr>" & vbCrLf
	  Content = Content & "</form>" & vbCrLf
	  Content = Content & "</table>" & vbCrLf
    End If
    Rs.Close
    Set Rs = Nothing
    Call DBConnEnd()

  Case "Edit"
    Call DBConnBegin()
    Set Rs=server.createobject("adodb.recordset")
    Rs.Open"Select * From WM_ClassAD Where WM_ID = "&ID&"",Conn,1,1
    If Not Rs.Eof Then
      AreaIDName=WRDB.GetClassName("WM_Area",Rs("WM_AreaID"))
      ClassName=WRDB.GetClassName("WM_ClassSort",Rs("WM_ClassID"))
      Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 Class=td1>" & vbCrLf  
	  Content = Content & "<form action='?Action=EditTwo&SearchKey="&SearchKey&"&PostName="&PostName&"&Days="&Days&"&SearchID="&SearchID&"&AreaName="&AreaName&"' name=myform method=POST>" & vbCrLf
	  Content = Content & "<input type=hidden name=AreaID_ value="&Rs("WM_AreaID")&">" & vbCrLf
	  Content = Content & "<input type=hidden name=ClassID_ value="&Rs("WM_ClassID")&">" & vbCrLf
	  Content = Content & "<input type=hidden name=Page value="&Page&">" & vbCrLf
	  Content = Content & "<input type=hidden name=ID value="&ID&">" & vbCrLf
	  Content = Content & "<tr Class=td4><td colspan=2>&nbsp;<strong>修改分类信息</strong></td></tr>" & vbCrLf  
	  Content = Content & "<tr Class=td2><td><strong>所属地区</strong></td>" & vbCrLf
	  Content = Content & "<td>"&AreaIDName&"　<font onclick='Edit2(b1)' style='cursor:pointer' color=blue>修改请点击</font></td></tr>" & vbCrLf
	  Content = Content & "<tr Class=td2 id=b1 style='display:none'><td><strong>修改地区</strong></td>" & vbCrLf
	  Content = Content & "<td><script src='../Inc/Js/AreaSelect.Js'></Script></td></tr>" & vbCrLf
	  Content = Content & "<tr Class=td2><td width='20%'><strong>所属分类</strong></td>" & vbCrLf
	  Content = Content & "<td width='80%'>"&ClassName&"　<font onclick='Edit(a1)' style='cursor:pointer' color=blue>修改请点击</font></td></tr>" & vbCrLf
	  Content = Content & "<tr Class=td2 id=a1 style='display:none'><td><strong>修改分类</strong></td>" & vbCrLf
	  Content = Content & "<td><script src='../Inc/Js/ClassSelect.Js'></Script></td></tr>" & vbCrLf
	  Content = Content & "<tr Class=td2><td></td><td><input type=submit value='下一步'></td></tr>" & vbCrLf
	  Content = Content & "</form>" & vbCrLf
	  Content = Content & "</table>" & vbCrLf
    End If
    Rs.Close
    Set Rs = Nothing
    Call DBConnEnd()
	
  Case "DJSave"	
    Set Rs = Conn.Execute("Select Top 1 WM_Key,WM_Commend,WM_aProp,WM_aZTop,WM_aTop,WM_aTitColor,WM_aTColor,WM_aBgColor,WM_aBColor,WM_aBold From WM_ClassAD Where WM_ID = "&ID)
    If Not Rs.Eof Then
	    WM_Key = Rs(0)
		WM_Commend = Rs(1)
		WM_aProp = Split(Rs(2),"|")
		WM_aZTop = Rs(3)
		WM_aTop = Rs(4)
		WM_aTitColor = Rs(5)
		WM_aTColor = Rs(6)
		WM_aBgColor = Rs(7)
		WM_aBColor = Rs(8)
		WM_aBold = Rs(9)
		aProp1=WM_aProp(0):aProp2=WM_aProp(1)
		
		If WRMPS.CheckStr(Request("DelDJ"), 1) = 1 Then
		  SQL = SQL & "WM_aZTop="&ConnTime
		  SQL = SQL & ",WM_aTop="&ConnTime
		  SQL = SQL & ",WM_aTitColor=Null"
		  SQL = SQL & ",WM_aTColor="&ConnTime
		  SQL = SQL & ",WM_aBgColor=Null"
		  SQL = SQL & ",WM_aBColor="&ConnTime
		  SQL = SQL & ",WM_aBold="&ConnTime
		  SQL = SQL & ",WM_aProp='0|0'"
		  SQL = SQL & ",WM_Full=0"
		  If Int(aProp1) > 0 Then SQL = SQL & ",WM_Key=0"
		  If Int(aProp2) > 0 Then SQL = SQL & ",WM_Commend=0"
		  Conn.Execute("Update WM_ClassAD Set "&SQL&" Where WM_ID = "&ID)
	      Call WRMPS.ErrView("·道具取消成功<br>·此界面 3 秒钟后自动关闭<script>function Close(){parent.closeWithIframe();parent.location.reload()}setTimeout(""Close()"",3000)</script>",1)
		End If
		
        aKey = WRMPS.CheckStr(Request("aKey"), 1)
        If aKey = "" Then aKey = 0
		If WM_Key = 0 and aKey > 0 Then
		  aProp1 = aProp1+1
		  SQL = SQL & ",WM_Key=1"
		End If
        aCommend = WRMPS.CheckStr(Request("aCommend"), 1)
        If aCommend = "" Then aCommend = 0
		If WM_Commend = 0 and aCommend > 0 Then
		  aProp2 = aProp2+1
		  SQL = SQL & ",WM_Commend=1"
		End If
        aZTop = WRMPS.CheckStr(Request("aZTop"), 1)
        If aZTop = "" Then aZTop = 0
		If aZTop > 0 Then
		  If WM_aZTop < Now() Then WM_aZTop = Now()
		  WM_aZTop = WM_aZTop + aZTop
		  SQL = SQL & ",WM_aZTop='"&WM_aZTop&"'"
		End If
        aTop = WRMPS.CheckStr(Request("aTop"), 1)
        If aTop = "" Then aTop = 0
		If aTop > 0 Then
		  If WM_aTop < Now() Then WM_aTop = Now()
		  WM_aTop = WM_aTop + aTop
		  SQL = SQL & ",WM_aTop='"&WM_aTop&"'"
		End If
        aTColor = WRMPS.CheckStr(Request("aTColor"), 1)
        If aTColor = "" Then aTColor = 0
		If aTColor > 0 Then
		  If WM_aTColor < Now() Then WM_aTColor = Now()
		  WM_aTColor = WM_aTColor + aTColor
	      SQL = SQL & ",WM_aTColor='"&WM_aTColor&"'"
		End If
		aTitColor = WRMPS.CheckStr(Request("aTitColor"), 0)
		If aTitColor = "" Then aTitColor = WM_aTitColor
		If aTitColor = "" Or IsNull(aTitColor) Then aTitColor = Null
	    SQL = SQL & ",WM_aTitColor='"&aTitColor&"'"
		aBColor = WRMPS.CheckStr(Request("aBColor"), 1)
        If aBColor = "" Then aBColor = 0
		If aBColor > 0 Then
		  If WM_aBColor < Now() Then WM_aBColor = Now()
		  WM_aBColor = WM_aBColor + aBColor
		  SQL = SQL & ",WM_aBColor='"&WM_aBColor&"'"
		End If
		aBgColor = WRMPS.CheckStr(Request("aBgColor"), 0)
		If aBgColor = "" Then aBgColor = WM_aBgColor
		If aBgColor = "" Or IsNull(aBgColor) Then aBgColor = Null
		SQL = SQL & ",WM_aBgColor='"&aBgColor&"'"
        aBold = WRMPS.CheckStr(Request("aBold"), 1)
        If aBold = "" Then aBold = 0
		If aBold > 0 Then
		  If WM_aBold < Now() Then WM_aBold = Now()
		  WM_aBold = WM_aBold + aBold
		  SQL = SQL & ",WM_aBold='"&WM_aBold&"'"
		End If
        WM_Full = WRMPS.CheckStr(Request("WM_Full"), 1)
        If WM_Full = "" Then WM_Full = 0
		If WM_Full > 0 Then
		  SQL = SQL & ",WM_Full=1"
		End If

	   SQL = " WM_aProp='"&aProp1&"|"&aProp2&"'"&SQL
	   Conn.Execute("Update WM_ClassAD Set"&SQL&" Where WM_ID = "&ID)
	   Call WRMPS.ErrView("·道具购买成功<br>·此界面 3 秒钟后自动关闭<script>function Close(){parent.closeWithIframe();parent.location.reload()}setTimeout(""Close()"",3000)</script>",1)
    Else
	   Call WRMPS.ErrView("·操作错误<br>·此界面 3 秒钟后自动关闭<script>function Close(){parent.closeWithIframe();parent.location.reload()}setTimeout(""Close()"",3000)</script>",0)
    End If
    Rs.Close
	Set Rs=Nothing

  Case "DJ"
      Set Rs = Conn.Execute("Select Top 1 WM_aZTop,WM_aTop,WM_aTitColor,WM_aBgColor,WM_aBold,WM_aProp,WM_Commend,WM_Key,WM_aTColor,WM_aBColor,WM_Full From WM_ClassAD Where WM_ID = "&ID)
      If Not Rs.Eof Then
	    WM_aZTop = Rs(0)
		WM_aTop = Rs(1)
		WM_aTitColor = Rs(2)
		WM_aBgColor = Rs(3)
		WM_aBold = Rs(4)
		WM_aProp = Split(Rs(5),"|")
		WM_Commend = Rs(6)
		WM_Key = Rs(7)
		WM_aTColor = Rs(8)
		WM_aBColor = Rs(9)
		WM_Full = Rs(10)
	  Else
	    Call WRMPS.ErrView("·操作错误",0)
      End If
      Rs.Close
	  Set Rs=Nothing

	  Content = Content & "<table width='100%' cellpadding='0' cellspacing=0>" & vbCrLf
      Content = Content & "<form name='myform' action='?Action=DJSave&ID="&ID&"' method='post'>"
      Content = Content & "  <tr>" & vbCrlf
      Content = Content & "    <td width='33%'>"
	  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/dj1.gif'></div></td>" & vbCrlf
      Content = Content & "    <td style='padding:0 5px' valign=top><strong>自动审核道具</strong><br><br>"
      If WM_Key > 0 Then
	    Content = Content & "此信息已审核"
	  Else
	    Content = Content & "道具使用："&WM_aProp(0)&"次<br><input type=checkbox name=aKey value=1> 购买"
	  End If
	  Content = Content & "</td>" & vbCrlf
	  Content = Content & "  </tr>" & vbCrlf
      Content = Content & "</table>" & vbCrlf
	  Content = Content & "</td>" & vbCrlf
	  
      Content = Content & "    <td width='34%'>"
	  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/dj3.gif'></div></td>" & vbCrlf
      Content = Content & "    <td style='padding:0 5px' valign=top><strong>总置顶道具</strong><br><br>"
      If Cdate(WM_aZTop) > Now() Then
	    Content = Content & "已使用 (到期："&Year(WM_aZTop)&"-"&Month(WM_aZTop)&"-"&Day(WM_aZTop)&")<br>再次"
	  End If
	  Content = Content & "购买 <input type=text name=aZTop value=0 size=5> 天"
	  Content = Content & "</td>" & vbCrlf
	  Content = Content & "  </tr>" & vbCrlf
      Content = Content & "</table>" & vbCrlf
	  Content = Content & "</td>" & vbCrlf

      Content = Content & "    <td width='33%'>"
	  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/dj4.gif'></div></td>" & vbCrlf
      Content = Content & "    <td style='padding:0 5px' valign=top><strong>分类置顶道具</strong><br><br>"
      If Cdate(WM_aTop) > Now() Then
	    Content = Content & "已使用 (到期："&Year(WM_aTop)&"-"&Month(WM_aTop)&"-"&Day(WM_aTop)&")<br>再次"
	  End If
	  Content = Content & "购买 <input type=text name=aTop value=0 size=5> 天"
	  Content = Content & "</td>" & vbCrlf
	  Content = Content & "  </tr>" & vbCrlf
      Content = Content & "</table>" & vbCrlf
	  Content = Content & "</td>" & vbCrlf
	  
      Content = Content & "  </tr><tr><td height=8px colspan=3></td></tr><tr>" & 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/dj2.gif'></div></td>" & vbCrlf
      Content = Content & "    <td style='padding:0 5px' valign=top><strong>自动推荐道具</strong><br><br>"
      If WM_Commend > 0 Then
	    Content = Content & "此信息已推荐"
	  Else
	    Content = Content & "道具使用："&WM_aProp(1)&"次<br><input type=checkbox name=aCommend value=1> 购买"
	  End If
	  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/dj5.gif'></div></td>" & vbCrlf
      Content = Content & "    <td style='padding:0 5px' valign=top><strong>标题变色道具</strong><br><br>"
      If Cdate(WM_aTColor) > Now() Then
	    Content = Content & "已使用 <span style='padding:5px;background:"&WM_aTitColor&"' title='当前颜色'><img width=0 height=0 align=absmiddle></span>(到期："&Year(WM_aTColor)&"-"&Month(WM_aTColor)&"-"&Day(WM_aTColor)&")<br>再次"
	  End If
	  Content = Content & "购买 <input type=text name=aTColor value=0 size=5> 天"
	  Content = Content & "<br>换换颜色 "&Color("aTitColor")
	  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/dj6.gif'></div></td>" & vbCrlf
      Content = Content & "    <td style='padding:0 5px' valign=top><strong>标题背景色道具</strong><br><br>"
      If Cdate(WM_aBColor) > Now() Then
	    Content = Content & "已使用 <span style='padding:5px;background:"&WM_aBgColor&"' title='当前颜色'><img width=0 height=0 align=absmiddle></span>(到期："&Year(WM_aBColor)&"-"&Month(WM_aBColor)&"-"&Day(WM_aBColor)&")<br>再次"
	  End If
	  Content = Content & "购买 <input type=text name=aBColor value=0 size=5> 天"
	  Content = Content & "<br>换换颜色 "&Color("aBgColor")
	  Content = Content & "</td>" & vbCrlf
	  Content = Content & "  </tr>" & vbCrlf
      Content = Content & "</table>" & vbCrlf
	  Content = Content & "</td>" & vbCrlf

      Content = Content & "  </tr><tr><td height=8px colspan=3></td></tr><tr>" & 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/dj7.gif'></div></td>" & vbCrlf
      Content = Content & "    <td style='padding:0 5px' valign=top><strong>标题加粗道具</strong><br><br>"