user_classad.asp

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

<!--#include file="Cook.asp"-->
<!--#include file="../Inc/Cls.Sift.asp"-->
<%
Dim SearchKey,Days,SearchID,N,Rs1,AreaIDName
Dim title,Pic,Dayss,Contact,Tel,AddRess,QQ,PostTime
Dim WM_Pic,WM_Key
Dim IP,i,ComID,Code,CodeAnswer
Dim O_ClassKey,WM_ClassDir,WM_ChannelDir,WM_Tag,Tag,Search_ID,S1,S2,MyClassNum,MyCountOut,MyIntegral,DCountOut,DIntegral,WM_Commend
Dim MyClassN,DC1,DI1,DC2,DI2,DC3,DI3,DC4,DI4,DC5,DI5,DC6,DI6,DC7,DI7,DC8,DI8
Dim eCount,TestCon
Dim DB1,DB2,DB3,DB4,DB5,DB6,DB7,DB8,DB9,DB10,DB1T,DB2T,DB3T,DB4T,DB5T,DB6T,DB7T,DB8T,DB9T,DB10T
Dim WM_aZTop,WM_aTop,WM_aTitColor,WM_aBgColor,WM_aBold,WM_aProp,WM_aTColor,WM_aBColor
Dim aKey,aCommend,aZTop,aTop,aTColor,aBColor,aTitColor,aBgColor,aBold,aProp1,aProp2,WM_Full

ChannelID = 2
WM_ChannelDir = "Class"
ID = WRMPS.CheckStr(Request("ID"), 0)
Page = WRMPS.CheckStr(Request("page"),1)
ComID = WRMPS.CheckStr(Request("ComID"),1)
SearchKey = WRMPS.CheckStr(Request("SearchKey"),1)
Days = WRMPS.CheckStr(Request("Days"),0)
SearchID = WRMPS.CheckStr(Request("SearchID"),0)
If Days = "" Then Days = 0 Else Days = Cdate(Days)
If SearchKey = "" Then SearchKey = 0

If Int(FlagClass(0)) < 1 and (ComID = 0 or (ComID > 0 and Int(FlagCom(23)) < 1)) Then Call WRMPS.ErrView("·您没有权限使用此功能", 0)

Select Case Request("Action")
  Case "AddSave","AddTwo","Add" 
    If ComID > 0 Then
      Set Rs = Conn.Execute("Select WM_ClaimUser,WM_RZBL,WM_CheckUser,WM_Key From WM_Company Where WM_ID="&ComID)
      If Not Rs.Eof Then
        If Rs(1) > 0 Then '已认领
	      If MemName <> Rs(0) Then Call WRMPS.ErrView("·此店铺已被认领，您不是店主，没有权限操作此功能",0)
        Else '未认领
      	  If Rs(3) = 0 Then Call WRMPS.ErrView("·操作错误",0)
        End If
      Else
        Call WRMPS.ErrView("·操作错误",0)
      End If
      Rs.Close
    End If
End Select

Select Case Request("Action")
  Case "AddSave"
    Call WRMPS.CheckSubmit()
    ClassID = WRMPS.CheckStr(Request.form("ClassID"),1)
    AreaID = WRMPS.CheckStr(Request.form("AreaID"),1)
    title = WRMPS.CheckStr(Request("title"),0)
    For i = 1 To Request.Form("Content").Count
      Content = Content & Request.Form("Content")(i)
    Next
	Content = WRMPS.CheckStr(Content,4)
    Pic = WRMPS.CheckStr(WRMPS.CheckStr(Request("Pic"),0),4)
    Days = WRMPS.CheckStr(Request("Days"),1)
    Contact = WRMPS.CheckStr(Request("Contact"),0)
    Email = WRMPS.CheckStr(Request("Email"),0)
    Tel = WRMPS.CheckStr(Request("Tel"),0)
    AddRess = WRMPS.CheckStr(Request("AddRess"),0)
    QQ = WRMPS.CheckStr(Request("QQ"),0)
	If title = "" Then Call WRMPS.ErrView("·请填写信息标题　",0)
    If Content = "" Then Call WRMPS.ErrView("·请填写内容介绍　",0)
    If Contact = "" Then Contact = Null
    If Email = "" Then Email = NUll
    If Pic = "" Then Pic = Null
    If Tel = "" Then Tel = Null
    If AddRess = "" Then AddRess = Null
    If QQ = "" Then QQ = Null
	PostTime = Now()
    EndTime = Cdate(Now()+Days)
	IP = Request.ServerVariables("REMOTE_ADDR")
	WM_Tag = WRMPS.CheckStr(Request("WM_Tag"),0)
    If Left(WM_Tag,1) = "," Then WM_Tag = Right(WM_Tag,Len(WM_Tag)-1)
    If Right(WM_Tag,1) = "," Then WM_Tag = Left(WM_Tag,Len(WM_Tag)-1)
	If ComID = "" Then ComID = 0
	Code = WRMPS.CheckStr(Request.form("Code"),0)
	CodeAnswer = WRMPS.CheckStr(Request.form("CodeAnswer"),0)
	If WRMPS.CheckCode("UserClass",1) Then If Code <> WRMPS.GetCookies("Code") Then Call WRMPS.ErrView("·您没有输入验证码或验证码不正确",0)
	If WRMPS.CheckCode("UserClass",2) and UBound(WR_CodeQA) >= 0 Then If Split(WR_CodeQA(WRMPS.GetCookies("IDQuestionNo")),"|")(1) <> CodeAnswer Then Call WRMPS.ErrView("·验证问题答案不正确",0)
	WRMPS.DelCookies "IDQuestionNo"
    WRMPS.DelCookies "Code"

	'信息过滤器
	Set WRClass = New Cls_Sift
	  Select Case WRClass.ClassSift(title,Content,Tel,Email,QQ)
	    Case 1
	      Call WRMPS.ErrView("·信息发布失败，可能原因有：<br>·被系统判定为非法或垃圾信息<br>·电话邮箱等输入不完整",0)
	    Case 2
	      Call WRMPS.ErrView("·信息发布失败<br>·您的IP已被列入系统黑名单",0)
	  End Select
	Set WRClass = Nothing

	DB1 = WRMPS.CheckStr(Request("DB1"),0)
	If DB1 = "" Then DB1 = Null:DB1T = Null Else DB1T = WRMPS.CheckStr(Request("DB1T"),0)
	DB2 = WRMPS.CheckStr(Request("DB2"),0)
	If DB2 = "" Then DB2 = Null:DB2T = Null Else DB2T = WRMPS.CheckStr(Request("DB2T"),0)
	DB3 = WRMPS.CheckStr(Request("DB3"),0)
	If DB3 = "" Then DB3 = Null:DB3T = Null Else DB3T = WRMPS.CheckStr(Request("DB3T"),0)
	DB4 = WRMPS.CheckStr(Request("DB4"),0)
	If DB4 = "" Then DB4 = Null:DB4T = Null Else DB4T = WRMPS.CheckStr(Request("DB4T"),0)
	DB5 = WRMPS.CheckStr(Request("DB5"),0)
	If DB5 = "" Then DB5 = Null:DB5T = Null Else DB5T = WRMPS.CheckStr(Request("DB5T"),0)
	DB6 = WRMPS.CheckStr(Request("DB6"),0)
	If DB6 = "" Then DB6 = Null:DB6T = Null Else DB6T = WRMPS.CheckStr(Request("DB6T"),0)
	DB7 = WRMPS.CheckStr(Request("DB7"),0)
	If DB7 = "" Then DB7 = Null:DB7T = Null Else DB7T = WRMPS.CheckStr(Request("DB7T"),0)
	DB8 = WRMPS.CheckStr(Request("DB8"),0)
	If DB8 = "" Then DB8 = Null:DB8T = Null Else DB8T = WRMPS.CheckStr(Request("DB8T"),0)
	DB9 = WRMPS.CheckStr(Request("DB9"),0)
	If DB9 = "" Then DB9 = Null:DB9T = Null Else DB9T = WRMPS.CheckStr(Request("DB9T"),0)
	DB10 = WRMPS.CheckStr(Request("DB10"),0)
	If DB10 = "" Then DB10 = Null:DB10T = Null Else DB10T = WRMPS.CheckStr(Request("DB10T"),0)

	Set Rs = Conn.Execute("Select WM_ClassNum,WM_CountOut,WM_Integral From WM_Member Where WM_ID = "&MemID)
	If Not Rs.Eof Then
	    MyClassNum = Rs(0)
	    MyCountOut = Rs(1)
	    MyIntegral = Rs(2)
	End If
	Rs.Close
	If MyClassNum >= Int(FlagClass(3)) Then
	  DCountOut = Int(FlagClass(5))
	  DIntegral = Int(FlagClass(4))
	End If
	If ComID > 0 Then
	  DCountOut = DCountOut + Int(FlagCom(25))
	  DIntegral = DIntegral + Int(FlagCom(24))
	  WM_Key = Int(FlagCom(26))
	Else
	  DCountOut = DCountOut + Int(FlagClass(2))
	  DIntegral = DIntegral + Int(FlagClass(1))
	  WM_Key = Int(FlagClass(6))
	End If
	If Instr(","&WR_ClassAD(2)&",",","&Hour(Time())&",") > 0 Then WM_Key = 0
	If MyCountOut - DCountOut < 0 Or MyIntegral - DIntegral < 0 Then Call WRMPS.ErrView("·您的账户积分或"&WR_Other(0)&"已不够本次支付，请先兑换"&WR_Other(0)&"或充值！<meta http-equiv=refresh content='1;URL=User_Exchange.asp'>",0)
	If Int(FlagClass(3)) > 0 Then 
	  If MyClassNum >= Int(FlagClass(3)) Then Call WRDB.SaveConsume(0,MemName,0,Int(FlagClass(5)),Int(FlagClass(4)),0,"分类信息超过数量扣除")
	End If
	If ComID > 0 Then
	  If Int(FlagCom(26)) > 0 Then Call WRDB.SaveConsume(0,MemName,0,Int(FlagCom(25)),Int(FlagCom(24)),0,"店铺优惠信息“"&Title&"”发布成功")
	Else
	  If Int(FlagClass(6)) > 0 Then Call WRDB.SaveConsume(0,MemName,0,Int(FlagClass(2)),Int(FlagClass(1)),0,"信息“"&Title&"”发布成功")
	End If

	Set Rs = Conn.Execute("Select WM_ParentDir,WM_Dir From WM_ClassSort Where WM_ID="&ClassID)
	If Not Rs.Eof Then
	  WM_ClassDir = Rs(0)&Rs(1)
	Else
	  Call WRMPS.ErrView("·请按规定操作　",0)
	End If
    Rs.Close
	
	Set Rs=server.createobject("adodb.recordset")
	Rs.Open "Select WM_title,WM_Content,WM_Pic,WM_ClassID,WM_AreaID,WM_Contact,WM_Email,WM_QQ,WM_AddRess,WM_Tel,WM_Ip,WM_Key,WM_PostTime,WM_EndTime,WM_Hit,WM_Re,WM_Commend,WM_PostType,WM_Post,WM_ChannelID,WM_ClassDir,WM_ChannelDir,WM_mCommend,WM_mSortErr,WM_mTrash,WM_mAgency,WM_Tag,WM_Charge,WM_RepeatCharge,WM_DB1,WM_DB2,WM_DB3,WM_DB4,WM_DB5,WM_DB6,WM_DB7,WM_DB8,WM_DB9,WM_DB10,WM_DB1T,WM_DB2T,WM_DB3T,WM_DB4T,WM_DB5T,WM_DB6T,WM_DB7T,WM_DB8T,WM_DB9T,WM_DB10T,WM_ComID,WM_Collection,WM_aZTop,WM_aTop,WM_aBold,WM_aProp,WM_aTColor,WM_aBColor,WM_TempID,WM_Full From WM_ClassAD Where WM_ID=1",Conn,1,3
	  Rs.AddNew
	  Rs(0) = Title
	  Rs(1) = Content
	  Rs(2) = Pic
	  Rs(3) = ClassID
	  Rs(4) = AreaID
	  Rs(5) = Contact
	  Rs(6) = Email
	  Rs(7) = QQ
	  Rs(8) = AddRess
	  Rs(9) = Tel
	  Rs(10) = IP
	  Rs(11) = WM_Key
	  Rs(12) = PostTime
	  Rs(13) = EndTime
	  Rs(14) = 0
	  Rs(15) = 0
	  Rs(16) = 0
	  Rs(17) = 1
	  Rs(18) = MemName
	  Rs(19) = ChannelID
	  Rs(20) = WM_ClassDir
	  Rs(21) = WM_ChannelDir
	  Rs(22) = 0
	  Rs(23) = 0
	  Rs(24) = 0
	  Rs(25) = 0
	  Rs(26) = WM_Tag
	  Rs(27) = 0
	  Rs(28) = 0
	  Rs(29) = DB1
	  Rs(30) = DB2
	  Rs(31) = DB3
	  Rs(32) = DB4
	  Rs(33) = DB5
	  Rs(34) = DB6
	  Rs(35) = DB7
	  Rs(36) = DB8
	  Rs(37) = DB9
	  Rs(38) = DB10
	  Rs(39) = DB1T
	  Rs(40) = DB2T
	  Rs(41) = DB3T
	  Rs(42) = DB4T
	  Rs(43) = DB5T
	  Rs(44) = DB6T
	  Rs(45) = DB7T
	  Rs(46) = DB8T
	  Rs(47) = DB9T
	  Rs(48) = DB10T
	  Rs(49) = ComID
	  Rs(50) = 0
	  Rs(51) = Now()
	  Rs(52) = Now()
	  Rs(53) = Now()
	  Rs(54) = "0|0"
	  Rs(55) = Now()
	  Rs(56) = Now()
	  Rs(57) = 0
	  Rs(58) = 0
	  Rs.Update
    Rs.Close
	Set Rs = Conn.Execute("Select max(WM_ID) from WM_ClassAD")
    If Not Rs.EOF Then
	  ID = Rs(0)
    End If
    Rs.Close
	Call WRMPS.CreTextToImg(ID,1,Email,Tel,QQ,AddRess)
	If WM_Key = 1 Then
  	  Conn.Execute("Update WM_Config Set WM_ClassNum = WM_ClassNum + 1")
	  Conn.Execute("Update WM_Member Set WM_ClassNum = WM_ClassNum + 1 Where WM_ID = "&MemID)
	  Call WRMPS.SCache("ClassNum",WRMPS.GetCache("ClassNum") + 1)
	  Set ClsCre = New Cls_Create
      Call ClsCre.CreClass("CRE",ID,WM_Key)
      Set ClsCre = Nothing
      Call WRMPS.ErrView("·信息发布成功<br>·<a href=?Action=Add>返回继续发布</a><br>·<a href=../Index.asp>返回首页</a><meta http-equiv=refresh content='1;URL=User_ClassAD.asp'>",1)
	Else
      Call WRMPS.ErrView("·信息发布成功，请等待管理员的审核<meta http-equiv=refresh content='1;URL=User_ClassAD.asp'>",1)
	End If
    Call DBConnEnd()

  Case "AddTwo" 
    ClassID = WRMPS.CheckStr(Request.form("ClassID"),1)
    AreaID = WRMPS.CheckStr(Request.form("AreaID"),1)
    If ClassID ="" Then Call WRMPS.ErrView("·请选择信息所属分类<meta http-equiv=refresh content='1;URL=?Action=Add'>",0)
    If ClassID < 1 Then Call WRMPS.ErrView("·请选择信息所属分类<meta http-equiv=refresh content='1;URL=?Action=Add'>",0)
    If AreaID ="" Then Call WRMPS.ErrView("·请选择信息所在地区<meta http-equiv=refresh content='1;URL=?Action=Add'>",0)
    If AreaID < 1 Then Call WRMPS.ErrView("·请选择信息所在地区<meta http-equiv=refresh content='1;URL=?Action=Add'>",0)
    Set Rs = Conn.Execute("Select * From WM_Member Where WM_ID = "&MemID)
    If Not Rs.Eof Then
      Content = Content & PageTop()
      Content = Content & UserPath(",<a href=User_ClassAD.asp>分类信息管理</a>")

      Content = Content & "<Script language='JavaScript' Src='../Inc/GetDate.Js'></Script>" & vbCrLf 
	  Content = Content & "<table width='100%' cellpadding=0 cellspacing=1 class=td1>" & vbCrLf                 
	  Content = Content & "<form action='?Action=AddSave' name=myform method=POST onSubmit='return ClassPost()'>" & vbCrLf  
	  Content = Content & "<input type=hidden name=ClassID value="&ClassID&">" & vbCrLf  
	  Content = Content & "<input type=hidden name=AreaID value="&AreaID&">" & vbCrLf  
	  Content = Content & "<input type=hidden name=ComID value="&ComID&">" & vbCrLf  
	  Content = Content & "<tr><td colspan=2 Class=td4>发布分类信息</td></tr>" & vbCrLf
      Content = Content & "<tr Class=td2><td width='20%'><strong>信息标题</strong></td><td width='80%'><input type=text maxlength=100 name=title size=40 onKeyUp=""javascript:replaceInput(this,event)""> <font color='#FF0000'>*</font></td></tr>" & vbCrLf  
      Set Rso = Server.CreateObject("ADODB.RecordSet")
	  Rso.Open "Select WM_DB from WM_ClassSort Where WM_ID="&ClassID, Conn, 1, 1