📄 cls.label.coupon.asp
字号:
End If
End If
Next
Select Case eExport
Case 2
GetCouponSort = GetCouponSort & "</tr></table>" & vbCrLf
Case 3
GetCouponSort = GetCouponSort & "</ul></div>" & vbCrLf
End Select
End Function
'个性化优惠券调用标签
Function GetInCoupon(byval Str)
Str = Split(Str,",")
eExport = Int(Str(0))
eTDCSS = Str(1)
eTDCSS1 = Str(2)
eTDCSS2 = Str(3)
eBigID = Str(4)
eAreaID = Int(Str(5))
eComID = Int(Str(6))
eShowNum = Int(Str(7))
eIsElite = Int(Str(8))
eColsNum = Int(Str(9))
eAuthor = Str(10)
eLen = Int(Str(11))
eEllipsis = Int(Str(12))
eOrderType = Int(Str(13))
eCNewDay = Int(Str(14))
eContentLen = Int(Str(15))
eTagCss = Str(16)
eContent = WRMPS.GetReplace(Str(17),"§№§",",")
eSql = "":GetInCoupon = "":elOrderType=""
If eComID > 0 Then
eSql = eSql& " and WM_ComID="&eComID
ElseIf eComID = -1 Then
eSql = eSql& " and WM_ComID="&ID
End If
Select Case eIsElite
Case 1
eSql = eSql & " and A.WM_Commend = 1"
Case 2
eSql = eSql & " and A.WM_Commend = 0"
End Select
If eAreaID = -1 Then eAreaID = MyCityID
If eAreaID > 0 Then
eAreaID = WRDB.GetChildClass(eAreaID,"WM_Area")
eSql = eSql & " and A.WM_AreaID in("&eAreaID&")"
End If
If IsNumeric(eBigID) Then
If Int(eBigID) <> 0 Then
If Int(eBigID) = -1 Then eBigID = ClassID
If eBigID > 0 Then
elClassID = WRDB.GetChildClass(eBigID,"WM_CouponSort")
eSql = eSql & " and A.WM_ClassID in("&Trim(elClassID)&")"
End If
End If
Else
If Instr(eBigID,"|") > 0 Then eBigID = WRMPS.GetReplace(eBigID,"|",",")
If eBigID <> "" Then eSql = eSql & " and A.WM_ClassID In("&Trim(eBigID)&")"
End If
If Ucase(eAuthor) = "C" Then eAuthor = Author
If eAuthor <> "" Then eSql = eSql & " and A.WM_Post = '"&eAuthor&"'"
eSql = eSql & " and A.WM_Key=1"
If Ucase(Left(eSql,4)) = " AND" Then eSql = " where "&Right(eSql,Len(eSql)-4)
Select Case ConnTypeStr
Case 0
eTop = " iif(A.WM_aZTop>="&ConnTime&",A.WM_aZTop,) Desc,"
If ClassID <> "" Then eTop = eTop & " iif(A.WM_aTop>="&ConnTime&",A.WM_aTop,) Desc,"
Case 1
eTop = " Case when A.WM_aZTop>="&ConnTime&" Then A.WM_aZTop End Desc,"
If ClassID <> "" Then eTop = eTop & " Case when A.WM_aTop>="&ConnTime&" Then A.WM_aTop End Desc,"
End Select
Select Case eOrderType
Case 1
elOrderType = " Order By "&eTop&"A.WM_ID Desc"
Case 2
elOrderType = " Order By "&eTop&"A.WM_Hit Desc,A.WM_ID Desc"
Case 3
elOrderType = " Order By "&eTop&"A.WM_Re Desc,A.WM_ID Desc"
Case 4
elOrderType = " Order By "&eTop&"A.WM_Commend Desc,A.WM_ID Desc"
Case 5
elOrderType = " Order By "&eTop&"A.WM_Collection Desc,A.WM_ID Desc"
End Select
Select Case eExport
Case 2
GetInCoupon = GetInCoupon & "<table width='100%' border=0 cellpadding=0 cellspacing=0><tr>"
Case 3
GetInCoupon = GetInCoupon & "<div"&WRMPS.LabelCss(eTDCSS)&"><ul"&WRMPS.LabelCss(eTDCSS1)&">" & vbCrLf
End Select
eSql = "Select Top "&eShowNum&" A.WM_ID,A.WM_Title,A.WM_Intro,A.WM_Path,A.WM_ClassID,A.WM_AreaID,A.WM_Time,A.WM_Hit,A.WM_Re,A.WM_User,A.WM_Commend,A.WM_ClassDir,A.WM_ChannelID,A.WM_ChannelDir,B.WM_Name,A.WM_Tel,A.WM_AddRess,A.WM_Tags,A.WM_aZTop,A.WM_aTop,A.WM_aTitColor,A.WM_aTColor,A.WM_aBgColor,A.WM_aBColor,A.WM_aBold,A.WM_ComID,A.WM_Collection,A.WM_Begin,A.WM_End,A.WM_Agio,A.WM_AgioType,WM_Item,WM_Circumscribe From WM_Coupon A Inner Join WM_CouponSort B on A.WM_ClassID = B.WM_ID"&eSql&elOrderType
eRs.Open eSql,Conn,1,1
If eRs.Eof Then GetInCoupon = "":eRs.Close:Exit Function
eln=0
Do While not eRs.eof
eln=eln+1
eTag = "":eTags = "":eTitColor="":AgioTypePic = "":AgioTypeSign = ""
eTemp = eContent
eTemp = WRMPS.GetReplace(eTemp,"{$ID}",eRs(0))
eTemp = WRMPS.GetReplace(eTemp,"{$No}",eln)
eTemp = WRMPS.GetReplace(eTemp,"{$Url}",WRMPS.GetShowUrl(1,1,0,eRs(0),eRs(6),eRs(13)&"/"&eRs(11)&"/",eRs(12)))
eTemp = WRMPS.GetReplace(eTemp,"{$ClassName}",eRs(14))
eTemp = WRMPS.GetReplace(eTemp,"{$ClassUrl}",WRMPS.GetClassUrl(0,1,1,eRs(13)&"/"&eRs(11)&"/",eRs(4)))
eTemp = WRMPS.GetReplace(eTemp,"{$AreaName}",WRMPS.GetAreaUrl(eRs(5),"Name"))
eTemp = WRMPS.GetReplace(eTemp,"{$AreaUrl}",WRMPS.GetAreaUrl(eRs(5),"Url"))
If eLen > 0 Then elTitle = WRMPS.GotTopic(WRMPS.LeachHTML(eRs(1)),eLen,eEllipsis) Else elTitle = eRs(1)
If eRs(21) > Now() Then eTitColor = "color:"&eRs(20)
If eRs(23) > Now() Then eTitColor = eTitColor & ";background:"&eRs(22)
If eRs(24) > Now() Then eTitColor = eTitColor & ";font-weight:bold"
If eTitColor <> "" Then elTitle = "<span style='"&eTitColor&"'>"&elTitle&"</span>"
eTemp = WRMPS.GetReplace(eTemp,"{$Title}",elTitle)
eTemp = WRMPS.GetReplace(eTemp,"{$Year}",Year(eRs(6)))
eTemp = WRMPS.GetReplace(eTemp,"{$Month}",Month(eRs(6)))
eTemp = WRMPS.GetReplace(eTemp,"{$Day}",Day(eRs(6)))
eTemp = WRMPS.GetReplace(eTemp,"{$Hour}",Hour(eRs(6)))
eTemp = WRMPS.GetReplace(eTemp,"{$Minute}",Minute(eRs(6)))
eTemp = WRMPS.GetReplace(eTemp,"{$Second}",Second(eRs(6)))
eTemp = WRMPS.GetReplace(eTemp,"{$Re}",eRs(8))
eTemp = WRMPS.GetReplace(eTemp,"{$Hit}",eRs(7))
eTemp = WRMPS.GetReplace(eTemp,"{$Collection}",eRs(26))
eTemp = WRMPS.GetReplace(eTemp,"{$Begin}",eRs(27))
eTemp = WRMPS.GetReplace(eTemp,"{$End}",eRs(28))
eTemp = WRMPS.GetReplace(eTemp,"{$Tel}",eRs(15))
eTemp = WRMPS.GetReplace(eTemp,"{$AddRess}",eRs(16))
If Instr(eTemp,"{$Content}") > 0 Then
If eContentLen > 0 Then elContent = WRMPS.GotTopic(WRMPS.LeachHTML(eRs(2)),eContentLen,1)
eTemp = WRMPS.GetReplace(eTemp,"{$Content}",elContent)
End If
elPIC = WRMPS.CheckStr(eRs(3),5)
If elPIC = "" Then elPIC = UrlPath&"Skins/"&WR_Setting(5)&"/nopic.gif"
eTemp = WRMPS.GetReplace(eTemp,"{$Pic}",elPIC)
eTemp = WRMPS.GetReplace(eTemp,"{$PostName}",WRUser.DispUser(0,eRs(9)))
If Instr(eTemp,"{$Tags}") > 0 Then
eTag = eRs(17)
If eTag <> "" and Isnull(eTag) = false Then
eTag = Split(eTag,",")
For ei=0 To UBound(eTag)
If eTag(ei) <> "" Then
If eTags = "" Then
eTags = "<a href="&UrlPath&"Search/S?Key="&escape(eTag(ei))&WRMPS.LabelCss(eTagCss)&" target=_blank>"&eTag(ei)&"</a>"
Else
eTags = eTags&",<a href="&UrlPath&"Search/S?Key="&escape(eTag(ei))&WRMPS.LabelCss(eTagCss)&" target=_blank>"&eTag(ei)&"</a>"
End If
End If
Next
Else
eTags = ""
End If
eTemp = WRMPS.GetReplace(eTemp,"{$Tags}",eTags)
End If
If eRs(25) > 0 and Instr(eTemp,"{$ComSign}") > 0 Then
eTemp = WRMPS.GetReplace(eTemp,"{$ComSign}","<Img Src='"&UrlPath&"Skins/"&WR_Setting(5)&"/Com.gif' alt='商家发布' align=absmiddle>")
End If
eTemp = WRMPS.GetReplace(eTemp,"{$ComSign}","")
If Instr(eTemp,"{$CommendSign}") > 0 Then
If eRs(10) = 1 Then eTemp = WRMPS.GetReplace(eTemp,"{$CommendSign}","<img src='"&UrlPath&"Skins/"&WR_Setting(5)&"/Elite.gif' align=absmiddle alt='推荐'>") Else eTemp = WRMPS.GetReplace(eTemp,"{$CommendSign}","")
End If
If Instr(eTemp,"{$NewSign}") > 0 Then
If eRs(6) >= (Now()-eCNewDay) Then eTemp = WRMPS.GetReplace(eTemp,"{$NewSign}","<img src='"&UrlPath&"Skins/"&WR_Setting(5)&"/New.gif' align=absmiddle alt='新进信息'>") Else eTemp = WRMPS.GetReplace(eTemp,"{$NewSign}","")
End If
If Instr(eTemp,"{$zTopSign}") > 0 Then
ezTopSign = "":ezTopSign = eRs(18)
If ezTopSign > Now() Then eTemp = WRMPS.GetReplace(eTemp,"{$zTopSign}","<Img Src='"&UrlPath&"Skins/"&WR_Setting(5)&"/zTop.gif' alt='总置顶' align=absmiddle border=0>")
eTemp = WRMPS.GetReplace(eTemp,"{$zTopSign}","")
End If
If Instr(eTemp,"{$TopSign}") > 0 Then
eTopSign = "":eTopSign = eRs(19)
If eTopSign > Now() Then eTemp = WRMPS.GetReplace(eTemp,"{$TopSign}","<Img Src='"&UrlPath&"Skins/"&WR_Setting(5)&"/Top.gif' alt='置顶' align=absmiddle border=0>")
eTemp = WRMPS.GetReplace(eTemp,"{$TopSign}","")
End If
eTemp = WRMPS.GetReplace(eTemp,"{$AgioType}",WRMPS.GetReplace(WRMPS.GetReplace(WRMPS.GetReplace(eRs(30),0,"折扣券"),1,"抵价券"),2,"礼品券"))
eTemp = WRMPS.GetReplace(eTemp,"{$Agio}",eRs(29)&WRMPS.GetReplace(WRMPS.GetReplace(WRMPS.GetReplace(eRs(30),0,"折"),1,"元"),2,"礼品券"))
eEnd = eRs(28)
AgioTypePic = eRs(30)
Select Case AgioTypePic
Case 0
AgioTypePic = UrlPath&"Skins/"&WR_Setting(5)&"/Agio_0.png"
AgioTypeSign = "<Img Src='"&UrlPath&"Skins/"&WR_Setting(5)&"/Agio_0.gif' alt='折扣券' align=absmiddle border=0>"
Case 1
AgioTypePic = UrlPath&"Skins/"&WR_Setting(5)&"/Agio_1.png"
AgioTypeSign = "<Img Src='"&UrlPath&"Skins/"&WR_Setting(5)&"/Agio_1.gif' alt='抵价券' align=absmiddle border=0>"
Case 2
AgioTypePic = UrlPath&"Skins/"&WR_Setting(5)&"/Agio_2.png"
AgioTypeSign = "<Img Src='"&UrlPath&"Skins/"&WR_Setting(5)&"/Agio_2.gif' alt='礼品券' align=absmiddle border=0>"
End Select
If eEnd <> "" Then If eEnd < Date() Then AgioTypePic = UrlPath&"Skins/"&WR_Setting(5)&"/Agio_5.png":AgioTypeSign = "<Img Src='"&UrlPath&"Skins/"&WR_Setting(5)&"/Agio_5.gif' alt='已过期' align=absmiddle border=0>"
eTemp = WRMPS.GetReplace(eTemp,"{$AgioTypePic}",AgioTypePic)
eTemp = WRMPS.GetReplace(eTemp,"{$AgioTypeSign}",AgioTypeSign)
eTemp = WRMPS.GetReplace(eTemp,"{$Item}",eRs(31))
eTemp = WRMPS.GetReplace(eTemp,"{$Circumscribe}",eRs(32))
Select Case eExport
Case 2
eTemp = "<td"&WRMPS.LabelCss(eTDCss)&">"&eTemp&"</td>" & vbCrLf
Case 3
eTemp = "<li"&WRMPS.LabelCss(eTDCSS2)&">"&eTemp&"</li>"
End Select
If eColsNum > 0 Then
If Int(eln) Mod eColsNum = 0 And eln <> eRs.RecordCount Then
Select Case eExport
Case 1
eTemp = eTemp & "<br>"& vbCrLf
Case 2
eTemp = eTemp & "</tr>"&vbCrLf&"<tr>"& vbCrLf
Case 3
eTemp = eTemp & "</ul>"&vbCrLf&"<ul"&WRMPS.LabelCss(eTDCSS1)&">"& vbCrLf
End Select
End If
End If
GetInCoupon = GetInCoupon & eTemp
eRs.movenext
Loop
Select Case eExport
Case 2
GetInCoupon = GetInCoupon & "</tr></table>" & vbCrLf
Case 3
GetInCoupon = GetInCoupon & "</ul></div>"& vbCrLf
End Select
eRs.Close
eTemp = "":eShowNum=0
End Function
End Class
Set ClsCoupon = New Cls_Label_Coupon
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -