⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 cls.label.coupon.asp

📁 网人分类信息5.0商业版。非常优秀的分类信息系统。比较少见。
💻 ASP
📖 第 1 页 / 共 2 页
字号:
<%
Class Cls_Label_Coupon
'cl
   Private eRs,eI,eRso,eN,eRst,eBCount,eCount,eSql,elClass,eDir,eParentDir
   Private eTarget,e_CSS,eChannelDir,eChannelID,eExport,eTDCSS,eTDStopCSS,eColsNum,eExplain,eCSS,eOpenType,eSymbol,eSymbolCSS,eLi
   Private eTDCSS1,eTDCSS2,eCTDCSS,eCTDCSS1,eCTDCSS2,eBNum,eBCols,eBFontNum,eBCss,eBCompart,eBCompartCss,eChild,eBigID,eCNum,eCCols,eCCss,eCFontNum,eCCompart,eCCompartCss,eCTarget,eBShow,eBShowCss,eCShow,eCShowCss
   Private e_BNum,eBigTitle,e_BigID,e_CNum,eCTitle,eCouponSort,elClassID
   Private eAreaID,eComID,eShowNum,eIsElite,eAuthor,eLen,eEllipsis,eOrderType,eCNewDay,eContentLen,eTagCss,eContent,elOrderType,eTop,eln,eTag,eTags,eTitColor,eTemp,elTitle,elContent,elPIC,ezTopSign,eTopSign,eEnd,AgioTypePic,AgioTypeSign
   
   Private Sub Class_Initialize()
 	 Set eRs = Server.CreateObject("ADODB.Recordset")
   End Sub
   Private Sub Class_Terminate()
     Set eRst = Nothing
     Set eRs = Nothing
   End Sub
   '========================================================================================
   '优惠券分类
   Function GetInCouponSort(Str)
     Str = Split(Str,",")
     eExport = Int(Str(0))
	 eTDCSS = Str(1)
	 eTDCSS1 = Str(2)
	 eTDCSS2 = Str(3)
	 eCTDCSS = Str(4)
	 eCTDCSS1 = Str(5)
	 eCTDCSS2 = Str(6)
	 eBNum = Int(Str(7))
	 eBCols = Int(Str(8))
	 eBFontNum = Int(Str(9))
	 eBCss = Str(10)
	 eBCompart = Str(11)
	 eBCompartCss = Str(12)
	 eTarget = Str(13)
	 eChild = Int(Str(14))
	 eBigID = Str(15)
	 eCNum = Int(Str(16))
	 eCCols = Int(Str(17))
	 eCCss = Str(18)
	 eCFontNum = Int(Str(19))
	 eCCompart = Str(20)
	 eCCompartCss = Str(21)
	 eCTarget = Str(22)
	 eBShow = Int(Str(23))
	 eBShowCss = Str(24)
	 eCShow = Int(Str(25))
	 eCShowCss = Str(26)
     If Ucase(Str(15)) <> "BIGID" Then If eExport = 1 Then GetInCouponSort = "<table cellpadding=0 cellspacing=0 border=0><tr>" Else GetInCouponSort = "<div"&WRMPS.LabelCss(eTDCSS)&">" & vbCrLf & "<ul"&WRMPS.LabelCss(eTDCSS1)&">" & vbCrLf
     If eBNum > 0 Then e_BNum = " Top "&eBNum Else e_BNum = ""
     If eCNum > 0 Then e_CNum = " Top "&eCNum Else e_CNum = ""
	 e_BigID = " where WM_ParentID = 0"
     If eBigID <> "" Then
       If Ucase(Str(15)) <> "BIGID" Then
		 eBigID = "":e_BigID = ""
	   Else
	     eBigID = ClassID
         If IsNumeric(eBigID) and eBigID > 0 Then e_BigID = " where WM_ID = "&eBigID
	   End If
     End If
	 Set eRs = Conn.Execute("Select"&e_BNum&" WM_ID,WM_Name,WM_ParentDir,WM_ChannelDir,WM_Dir From WM_CouponSort"&e_BigID&" Order By WM_ClassID,WM_Taxis")	 
	 eI = 0
	 Do While Not eRs.Eof
	   eI = eI + 1
	   If eBFontNum > 0 Then eBigTitle = WRMPS.GotTopic(WRMPS.LeachHTML(eRs(1)),eBFontNum,1) Else eBigTitle = eRs(1)
	   eBigTitle = "<a href="&WRMPS.GetClassUrl(0,1,1,eRs(3)&eRs(2)&eRs(4),eRs(0))&WRMPS.LabelCss(eBCss)&" Target="&eTarget&">" & eBigTitle & "</a>"
	   If eBCompart <> "§" Then eBigTitle = "<font"&WRMPS.LabelCss(eBCompartCss)&">"&Split(eBCompart,"§")(0)&"</font>"&eBigTitle&"<font"&WRMPS.LabelCss(eBCompartCss)&">"&Split(eBCompart,"§")(1)&"</font>"
	   If eBShow > 1 Then
	     elClass = eRs(0)
	     eli = 0
		 elClass = "WM_ClassID in("&WRDB.GetChildClass(elClass,"WM_CouponSort")&")"
	     If MyCityID > 0 Then
		   eSQL = "Select Count(0) From WM_Coupon where WM_AreaID = "&MyCityID&" and "&elClass&" and WM_Key=1"
		 Else
		   eSQL = "Select Count(0) From WM_Coupon where "&elClass&" and WM_Key=1"
		 End If
	     Set eRst = Conn.Execute(eSQL)
		   eBCount = eRst(0) 
         eRst.Close
		 Select Case eBShow
		   Case 3
		     eBCount = "("&eBCount&")"
		   Case 4
		     eBCount = "["&eBCount&"]"
		 End Select
		 eBCount = " <font"&WRMPS.LabelCss(eBShowCss)&">"&eBCount&"</font>"
	   End If
	   If Ucase(Str(15)) <> "BIGID" and eExport = 1 Then
	     GetInCouponSort = GetInCouponSort & "<td valign=top>"
         GetInCouponSort = GetInCouponSort & "<table cellpadding=0 cellspacing=0 border=0>"
         If eBigID = "" Then GetInCouponSort = GetInCouponSort & "<tr><td"&WRMPS.LabelCss(eTDCSS)&">"
         If eBigID = "" Then GetInCouponSort = GetInCouponSort & eBigTitle&eBCount
         If eBigID = "" Then GetInCouponSort = GetInCouponSort & "</td></tr>"
	   Else
	     If eBigID = "" Then GetInCouponSort = GetInCouponSort & "<li"&WRMPS.LabelCss(eTDCSS2)&">" & eBigTitle&eBCount & "</li>" & vbCrLf 
	   End If
	   If eChild = 1 Then
 	     If eExport = 1 Then
           If Ucase(Str(15)) <> "BIGID" Then GetInCouponSort = GetInCouponSort & "<tr><td>"
           GetInCouponSort = GetInCouponSort & "<table cellpadding=0 cellspacing=0 border=0><tr>"
	     Else
           GetInCouponSort = GetInCouponSort & "<div"&WRMPS.LabelCss(eCTDCSS)&">"& vbCrLf &"<ul"&WRMPS.LabelCss(eCTDCSS1)&">" & vbCrLf 
	     End If
		 Set eRso = Conn.Execute("Select "&e_CNum&" WM_ID,WM_Name,WM_Dir,WM_ParentDir,WM_ChannelDir From WM_CouponSort Where WM_ParentID = "&eRs(0)&" Order By WM_ClassID,WM_Taxis")
		 eN = 0
		 Do While Not eRso.Eof
		   eN = eN + 1
           If eCFontNum > 0 Then eCTitle = WRMPS.GotTopic(WRMPS.LeachHTML(eRso(1)),eCFontNum,1) Else eCTitle = eRso(1)
	       eCTitle = "<a href="&WRMPS.GetClassUrl(0,1,1,eRso(4)&eRso(3)&eRso(2),eRso(0))&WRMPS.LabelCss(eCCss)&" Target="&eCTarget&">" & eCTitle & "</a>"
	       If eCCompart <> "§" Then eCTitle = "<font"&WRMPS.LabelCss(eCCompartCss)&">"&Split(eCCompart,"§")(0)&"</font>"&eCTitle&"<font"&WRMPS.LabelCss(eCCompartCss)&">"&Split(eCCompart,"§")(1)&"</font>"
	       If eCShow > 1 Then
	         elClass = eRso(0)
	         eli = 0
			 elClass = "WM_ClassID in("&WRDB.GetChildClass(elClass,"WM_CouponSort")&")"
	         If MyCityID > 0 Then
		       eSQL = "Select Count(0) From WM_Coupon where WM_AreaID = "&MyCityID&" and "&elClass&" and WM_Key=1"
		     Else
		       eSQL = "Select Count(0) From WM_Coupon where "&elClass&" and WM_Key=1"
		     End If
	         Set eRst = Conn.Execute(eSQL)
		       eCount = eRst(0) 
             eRst.Close
		     Select Case eCShow
		       Case 3
		         eCount = "("&eCount&")"
		       Case 4
		         eCount = "["&eCount&"]"
		     End Select
		     eCount = " <font"&WRMPS.LabelCss(eCShowCss)&">"&eCount&"</font>"
	       End If
 	       If eExport = 1 Then
		     GetInCouponSort = GetInCouponSort & "<td"&WRMPS.LabelCss(eCTDCSS)&">" & eCTitle&eCount & "</td>" & vbCrLf
	       Else
		     GetInCouponSort = GetInCouponSort & "<li"&WRMPS.LabelCss(eCTDCSS2)&">" & eCTitle&eCount & "</li>" & vbCrLf 
	       End If
	       If eCCols > 0 Then If eN Mod eCCols = 0 Then If eExport = 1 Then GetInCouponSort = GetInCouponSort & "</tr>" & vbCrLf & "<tr>" Else GetInCouponSort = GetInCouponSort & "</ul>" & vbCrLf & "<ul"&WRMPS.LabelCss(eCTDCSS1)&">" & vbCrLf 
		 eRso.MoveNext
		 Loop
		 eRso.Close
 	     If eExport = 1 Then
		   GetInCouponSort = GetInCouponSort & "</tr></table>"
		   If Ucase(Str(15)) <> "BIGID" Then GetInCouponSort = GetInCouponSort & "</td></tr>"
	     Else
		   GetInCouponSort = GetInCouponSort & "</ul></div>" & vbCrLf 
	     End If
	   End If
 	   If Ucase(Str(15)) <> "BIGID" Then
	     If eExport = 1 Then GetInCouponSort = GetInCouponSort & "</table></td>"
	     If eBCols > 0 Then If eI Mod eBCols = 0 Then If eExport = 1 Then GetInCouponSort = GetInCouponSort & "</tr>" & vbCrLf & "<tr>" Else GetInCouponSort = GetInCouponSort & "</ul>" & vbCrLf & "<ul"&WRMPS.LabelCss(eTDCSS1)&">" & vbCrLf 
	   End If
	 eRs.Movenext
	 Loop
	 eRs.Close
 	 If Ucase(Str(15)) <> "BIGID" Then 
	   If eExport = 1 Then
	     GetInCouponSort = GetInCouponSort & "</tr></table>"
	   Else
	     GetInCouponSort = GetInCouponSort & "</ul></div>"
	   End If
	 End If
	 GetInCouponSort = Replace(Replace(GetInCouponSort,"<ul"&WRMPS.LabelCss(eCTDCSS1)&">" & vbCrLf & "</ul>",""),"<ul"&WRMPS.LabelCss(eTDCSS1)&">" & vbCrLf & "</ul>","")
	 GetInCouponSort = Replace(GetInCouponSort,"<tr></tr>","")
     Set eRst = Nothing
   End Function

   '优惠券栏目菜单
   Function GetCouponSort(Str)
     Str = Split(Str,",")
     eBigID = Int(Str(0))
	 eExport = Int(Str(1))
	 eTDCSS = Str(2)
	 eTDCSS1 = Str(3)
	 eTDCSS2 = Str(4)
	 eTDStopCSS = Str(5)
	 eColsNum = Int(Str(6))
	 eCSS = Str(7)
	 eExplain = Int(Str(8))
	 eOpenType = Str(9)
	 eSymbol = Str(10)
	 eSymbolCSS = Str(11)
     eCouponSort = ""
	 e_CSS = WRMPS.LabelCss(eCSS)
     e_BigID = " WM_ParentID = 0"
	 If eBigID > 0 Then
	   e_BigID = " WM_ParentID = "&eBigID
	 ElseIf eBigID < 0 Then
	   If ClassID <> "" Then e_BigID = " WM_ParentID = "&ClassID
	 End If
	 Set eRso = Conn.Execute("Select Top 1 WM_ChannelID From WM_CouponSort")
	 If Not eRso.Eof Then eChannelID = eRso(0)
	 eRso.Close
	 If eChannelID = "" Then Exit Function 
	 eRs.Open"Select WM_ID,WM_Name,WM_Dir,WM_ParentDir,WM_ChannelDir From WM_CouponSort Where"&e_BigID&" Order By WM_ClassID,WM_Taxis",Conn,1,1
	 Do While Not eRs.Eof
	   eDir = eRs(2)
	   eParentDir = eRs(3)
	   eChannelDir = eRs(4)
	   If eCouponSort = "" Then
	     eCouponSort = "<a href="&WRMPS.GetClassUrl(0,1,1,eChannelDir&eParentDir&eDir,eRs(0))&" target='"&eOpenType&"'"&e_CSS&">"&eRs(1)&"</a>"
	   Else
	     eCouponSort = eCouponSort & "|" & "<a href="&WRMPS.GetClassUrl(0,1,1,eChannelDir&eParentDir&eDir,eRs(0))&" target='"&eOpenType&"'"&e_CSS&">"&eRs(1)&"</a>"
	   End If
	 eRs.MoveNext
	 Loop
	 eRs.Close
	 If eSymbol <> "§" Then eSymbol = "<font"&WRMPS.LabelCss(eSymbolCSS)&">"&Split(eSymbol,"§")(0)&"</font>{$$Menu$$}<font"&WRMPS.LabelCss(eSymbolCSS)&">"&Split(eSymbol,"§")(1)&"</font>" Else eSymbol = "{$$Menu$$}"
	 eCouponSort = Split(eCouponSort,"|")
	 Select Case eExport
	   Case 2
	     GetCouponSort = "<table border=0 cellspacing=0 cellpadding=0><tr>" & vbCrLf
	   Case 3
	     GetCouponSort = "<div"&WRMPS.LabelCss(eTDCSS)&"><ul"&WRMPS.LabelCss(eTDCSS1)&">" & vbCrLf
	 End Select
	 For eI = 0 To UBound(eCouponSort)
		Select Case eExport
		  Case 1
		    GetCouponSort = GetCouponSort&Replace(eSymbol,"{$$Menu$$}",eCouponSort(eI))
		  Case 2
		    GetCouponSort = GetCouponSort&"  <td"&WRMPS.LabelCss(eTDCSS)&" onMouseOut='mOver(this.ClassName="""&eTDCSS&""")' onMouseOver='mOver(this.ClassName="""&eTDStopCSS&""")'>"&Replace(eSymbol,"{$$Menu$$}",eCouponSort(eI))&"</td>" & vbCrLf
		  Case 3
		    GetCouponSort = GetCouponSort&"  <li"&WRMPS.LabelCss(eTDCSS2)&" onMouseOut='mOver(this.ClassName="""&eTDCSS2&""")' onMouseOver='mOver(this.ClassName="""&eTDStopCSS&""")'>"&Replace(eSymbol,"{$$Menu$$}",eCouponSort(eI))&"</li>"
		End Select
		If eColsNum > 0 Then
		If (eI + 1) mod eColsNum = 0 Then
		  Select Case eExport
		    Case 1
		      GetCouponSort = GetCouponSort&"<br>" & vbCrLf
		    Case 2
			  If UBound(eCouponSort) > eI Then GetCouponSort = GetCouponSort&"</tr>" & vbCrLf & "<tr>"
		    Case 3
		      If UBound(eCouponSort) > eI Then GetCouponSort = GetCouponSort&"</ul>" & vbCrLf & "<ul"&WRMPS.LabelCss(eTDCSS1)&">" & vbCrLf
		  End Select

⌨️ 快捷键说明

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