📄 classshop.asp
字号:
If ShowPage Then
Dim PageHTML, PageString
PageHTML = EL_Common.Lang("BaseConfig.ShowPage", "")
PageHTML = EL_Common.ReplaceText(PageHTML, "\{\$PageList\}", EL_Common.ShowPage(URLParameters, CurrentPage, PageSizes, PageCounts, TotalRowCount, EL_Channel.ItemName, EL_Channel.ItemUnit))
ReturnString = ReturnString & PageHTML
End If
ShopList = ReturnString
End Function
Private Function Label_GetShopPhoto(ByVal HTML)
Dim Match, Matches, ReturnString, Parameters, Temp
CommonRegExp.Pattern = "<!--\{\$GetShopPhoto\(([ 0-9]+|[ ]*ChannelID[ ]*),([ 0-9\|]+|[ ]*ClassID[ ]*),([ 0-9]+),[ ]*(True|False)[ ]*,([ 0-9\-]+),([ 0-9\-]+),([ 0-9]+),([ 0-9]+),([ 0-9]+),([ 0-9]+),[ ]*(True|False)[ ]*,([ 0-9]+),([ 0-9]+),([ 0-9]+),([ 0-9]+)\)\}-->"
Set Matches = CommonRegExp.Execute(HTML)
ReturnString = HTML
Temp = ""
For Each Match in Matches
Parameters = EL_Common.GetLabelParameters(Match.Value, "GetShopPhoto")
Temp = ShopPhoto(Parameters(0), Parameters(1), Parameters(2), Parameters(3), Parameters(4), Parameters(5), Parameters(6), Parameters(7), Parameters(8), Parameters(9), Parameters(10), Parameters(11), Parameters(12), Parameters(13), Parameters(14))
ReturnString = Replace(ReturnString, Match.Value, Temp)
Next
CommonRegExp.Pattern = "\{\$GetShopPhoto\(([ 0-9]+|[ ]*ChannelID[ ]*),([ 0-9\|]+|[ ]*ClassID[ ]*),([ 0-9]+),[ ]*(True|False)[ ]*,([ 0-9\-]+),([ 0-9\-]+),([ 0-9]+),([ 0-9]+),([ 0-9]+),([ 0-9]+),[ ]*(True|False)[ ]*,([ 0-9]+),([ 0-9]+),([ 0-9]+),([ 0-9]+)\)\}"
Set Matches = CommonRegExp.Execute(ReturnString)
For Each Match in Matches
Parameters = EL_Common.GetLabelParameters(Match.Value, "GetShopPhoto")
Temp = ShopPhoto(Parameters(0), Parameters(1), Parameters(2), Parameters(3), Parameters(4), Parameters(5), Parameters(6), Parameters(7), Parameters(8), Parameters(9), Parameters(10), Parameters(11), Parameters(12), Parameters(13), Parameters(14))
ReturnString = Replace(ReturnString, Match.Value, Temp)
Next
Set Matches = Nothing
Label_GetShopPhoto = ReturnString
End Function
Private Function ShopPhoto(ByVal iChannelID, ByVal ArrClassID, ByVal PhotoNum, ByVal IsCommend, ByVal TitleLen, ByVal ContentLen, ByVal PhotoWidth, ByVal PhotoHeight, ByVal OrderType, ByVal OpenType, ByVal ShowHint, ByVal ShowType, ByVal ColNum, ByVal EffectID, ByVal TimeOuts)
Dim ShopCmd, rsShop, i, ReturnString, RowCount
Dim SQLTables, SQLFields, SQLCondition, SQLOrder, SQL
Dim ChannelCmd, rsChannel, ChannelDir, ChannelModule, ItemName, ItemUnit, Disabled, UploadDir
iChannelID = Eval(iChannelID)
If Instr(ArrClassID, "|")<1 Then
ArrClassID = Eval(ArrClassID)
End If
ArrClassID = CStr(ArrClassID)
If iChannelID <> ChannelID Then
Call EL_Common.InitCommonCmd(ChannelCmd, rsChannel, "EL_Channel", "ChannelDir,ChannelModule,ItemName,ItemUnit,Disabled,UploadDir", "ChannelID="& iChannelID &" AND ChannelType=0")
rsChannel.Close()
If ChannelCmd(0) <> 1 Then
Set rsChannel = Nothing
Set ChannelCmd = Nothing
ArticlePhoto = EL_Common.Lang("BaseConfig.ChannelError", "·频道参数错误")
Exit Function
Else
rsChannel.Open()
ChannelDir = rsChannel(0)
ChannelModule = rsChannel(1)
ItemName = rsChannel(2)
ItemUnit = rsChannel(3)
Disabled = rsChannel(4)
UploadDir = rsChannel(5)
rsChannel.Close()
End If
Set rsChannel = Nothing
Set ChannelCmd = Nothing
Else
ChannelDir = EL_Channel.ChannelDir
ChannelModule = EL_Channel.ChannelModule
ItemName = EL_Channel.ItemName
ItemUnit = EL_Channel.ItemUnit
Disabled = EL_Channel.Disabled
UploadDir = EL_Channel.UploadDir
End If
If ChannelModule <> 7 Then
ShopPhoto = EL_Common.Lang("BaseConfig.ChannelModuleError", "·频道模块错误")
Exit Function
End If
If Disabled Then
ShopPhoto = EL_Common.Lang("BaseConfig.Disabled", "·该频道已被禁用")
Exit Function
End If
PhotoNum = EL_Common.ELClng(PhotoNum)
TitleLen = EL_Common.ELClng(TitleLen)
ContentLen = EL_Common.ELClng(ContentLen)
IsCommend = Eval(IsCommend)
PhotoWidth = EL_Common.ELClng(PhotoWidth)
PhotoHeight = EL_Common.ELClng(PhotoHeight)
ColNum = EL_Common.ELClng(ColNum)
OrderType = EL_Common.ELClng(OrderType)
OpenType = EL_Common.ELClng(OpenType)
ShowHint = Eval(ShowHint)
ShowType = EL_Common.ELClng(ShowType)
EffectID = EL_Common.ELClng(EffectID)
TimeOuts = EL_Common.ELClng(TimeOuts)
If PhotoWidth<=0 Then PhotoWidth = EL_Common.Lang("Article.PhotoWidth", 120)
If PhotoHeight<=0 Then PhotoHeight = EL_Common.Lang("Article.PhotoHeight", 80)
If OpenType > 1 Then OpenType = 1
If ColNum < 1 Then ColNum = 1
SQLTables = "EL_Shop"
SQLFields = "EL_Shop.ProductID,EL_Shop.ProductName,EL_Shop.Points,EL_Shop.DefaultPictrue"
SQLOrder = "EL_Shop.OnTop DESC"
Select Case OrderType
Case 1: SQLOrder = SQLOrder &",EL_Shop.ProductID ASC"
Case 2: SQLOrder = SQLOrder &",EL_Shop.ProductID DESC"
Case 3: SQLOrder = SQLOrder &",EL_Shop.UpdateTime ASC"
Case 4: SQLOrder = SQLOrder &",EL_Shop.UpdateTime DESC"
Case 5: SQLOrder = SQLOrder &",EL_Shop.Hits ASC"
Case 6: SQLOrder = SQLOrder &",EL_Shop.Hits DESC"
Case Else: SQLOrder = SQLOrder &",EL_Shop.ProductID DESC"
End Select
SQLCondition = " EL_Shop.ChannelID="& ChannelID &" And EL_Shop.DefaultPictrue<>'' And EL_Shop.Passed="& EL_True &" And EL_Shop.Deleted="& EL_False &" "
If ArrClassID = "" Or ArrClassID = "0" Or Replace(ArrClassID, "|", "") = "" Then
'SQLCondition = SQLCondition &""
Else
If ShowClassType = 1 Then
ArrClassID = ArrClassID
Else
ArrClassID = EL_Common.GetAllClassID(ArrClassID)
End If
SQLCondition = SQLCondition &"AND EL_Shop.ClassID In("& ArrClassID &") "
End If
If IsCommend Then SQLCondition = SQLCondition &" AND EL_Shop.Commended="& EL_True &" "
If PhotoNum < 1 Then PhotoNum = EL_Common.Lang("Shop.TopNum", 10)
Call EL_Common.InitCommonCmd(ShopCmd, rsShop, SQLTables, " TOP "& PhotoNum &" "& SQLFields, SQLCondition &" ORDER BY "& SQLOrder)
rsShop.Close()
RowCount = ShopCmd(0)
If RowCount = 0 Then
Set rsShop = Nothing
Set ShopCmd = Nothing
ShopPhoto = EL_Common.RegExpStaticLabel(EL_Common.Lang("BaseConfig.NoPictrue", "·没有任何{$ItemName}图片"), "{$ItemName}", ItemName)
ShopPhoto = Replace(ShopPhoto, "{$InstallDir}", InstallDir)
ShopPhoto = Replace(ShopPhoto, "{$PhotoWidth}", PhotoWidth)
ShopPhoto = Replace(ShopPhoto, "{$PhotoHeight}", PhotoHeight)
Exit Function
End If
Dim Title_Name, Title_TPoint
If ShowHint = True Then
Title_Name = EL_Common.RegExpStaticLabel(EL_Common.Lang("Shop.Name", "{$ItemName}标题"), "{$ItemName}", ItemName)
Title_TPoint = EL_Common.RegExpStaticLabel(EL_Common.Lang("Shop.TPoint", "兑换{$PointItemName}"), "{$PointItemName}", PointItemName)
End If
rsShop.Open()
If ShowType = 4 Then
Dim PictrueID
PictrueID = EL_Common.GetRndNumber()
ReturnString = "<script language='javascript'>"& VBCRLF
ReturnString = ReturnString &"var PictrueList = new Array();"& VBCRLF
ReturnString = ReturnString &"var PictrueURL = new Array();"& VBCRLF
ReturnString = ReturnString &"var PictrueText = new Array();"& VBCRLF
ReturnString = ReturnString &"var PictrueIndex = 0;"& VBCRLF
For i = 1 To RowCount
ReturnString = ReturnString &"PictrueList["& i-1 &"] = """& EL_Common.PictrueURL(rsShop("DefaultPictrue"), EL_Channel.FilePath) &""";"& VBCRLF
ReturnString = ReturnString &"PictrueURL["& i-1 &"] = """& InstallDir & ChannelDir &"/ShowProduct.asp?ProductID="& rsShop("ProductID") &""";"& VBCRLF
If TitleLen >= 0 Then
ReturnString = ReturnString &"PictrueText["& i-1 &"] = """& EL_Common.HTMLDecode(EL_Common.GetTopic(rsShop("ProductName"), TitleLen)) &""";"& VBCRLF
Else
ReturnString = ReturnString &"PictrueText["& i-1 &"] = """";"& VBCRLF
End If
If i < RowCount Then rsShop.MoveNext
Next
ReturnString = ReturnString &"function NextPictrue(){"& VBCRLF
ReturnString = ReturnString &" if(PictrueIndex<"& RowCount-1 &") PictrueIndex++ ;"& VBCRLF
ReturnString = ReturnString &" else PictrueIndex=0;"& VBCRLF
ReturnString = ReturnString &" if(document.all){"& VBCRLF
ReturnString = ReturnString &" Pictrue_"& PictrueID &".filters.revealTrans.Transition=Math.floor(Math.random()*"& EffectID &");"& VBCRLF
ReturnString = ReturnString &" Pictrue_"& PictrueID &".filters.revealTrans.apply();"& VBCRLF
ReturnString = ReturnString &" Pictrue_"& PictrueID &".filters.revealTrans.play();"& VBCRLF
ReturnString = ReturnString &" }"& VBCRLF
ReturnString = ReturnString &" document.getElementById(""Pictrue_"& PictrueID &""").src = PictrueList[PictrueIndex];"& VBCRLF
ReturnString = ReturnString &" document.getElementById(""URL_"& PictrueID &""").href = PictrueURL[PictrueIndex];"& VBCRLF
ReturnString = ReturnString &" document.getElementById(""URL_"& PictrueID &""").title = """& Title_Name &"""+PictrueText[PictrueIndex];"& VBCRLF
If TitleLen >= 0 Then
ReturnString = ReturnString &" document.getElementById(""Text_"& PictrueID &""").innerText = PictrueText[PictrueIndex];"& VBCRLF
End If
ReturnString = ReturnString &" theTimer = setTimeout('NextPictrue()', "& TimeOuts &");"& VBCRLF
ReturnString = ReturnString &"}"& VBCRLF
ReturnString = ReturnString &"</script>"
ReturnString = ReturnString &"<div class='piclisttd'><a id='URL_"& PictrueID &"' href='' title='' "& EL_Common.ArrOpenType(OpenType) &"><img class='piclisti' id='Pictrue_"& PictrueID &"' src='' style='FILTER: revealTrans(duration=1,transition=23)' width='"& PhotoWidth &"' height='"& PhotoHeight &"' border='0'>"
If TitleLen >= 0 Then
ReturnString = ReturnString &"<br><span id='Text_"& PictrueID &"' class='piclistn'></span>"
End If
ReturnString = ReturnString &"</a></div>"
ReturnString = ReturnString &"<script>NextPictrue()</script>"
Else
ReturnString = "<table width='' border='0' cellspacing='0' cellpadding='0' class='piclist'><tr>"
For i = 1 To RowCount
ReturnString = ReturnString &"<td class='piclisttd'>"
Select Case ShowType
Case 2:
ReturnString = ReturnString &"<span style='float:left;'><a href='"& InstallDir & ChannelDir &"/ShowProduct.asp?ProductID="& rsShop("ProductID") &"' "
If ShowHint = True Then ReturnString = ReturnString &"title='"& Title_Name &"："& EL_Common.ServerHTMLEncode(rsShop("ProductName")) & VBCRLF & Title_TPoint &"："& rsShop("Points") &"' "
ReturnString = ReturnString & EL_Common.ArrOpenType(OpenType) &">"
ReturnString = ReturnString &"<img class='piclisti' src='"& EL_Common.PictrueURL(rsShop("DefaultPictrue"), EL_Channel.FilePath) &"' width='"& PhotoWidth &"' height='"& PhotoHeight &"' border='0'>"
If TitleLen >= 0 Then ReturnString = ReturnString &"<br><span class='piclistn'>"& EL_Common.HTMLEncode(EL_Common.GetTopic(rsShop("ProductName"), TitleLen)) &"</span>"
ReturnString = ReturnString &"</a></span>"
If ContentLen >=0 Then ReturnString = ReturnString &"<span class='piclistc'>"& EL_Common.GetTopic(EL_Common.RemoveHTML(rsShop("Content")), ContentLen) &"</span>"
Case 3:
ReturnString = ReturnString &"<a href='"& InstallDir & ChannelDir &"/ShowProduct.asp?ProductID="& rsShop("ProductID") &"' "
If ShowHint = True Then ReturnString = ReturnString &"title='"& Title_Name &"："& EL_Common.ServerHTMLEncode(rsShop("ProductName")) & VBCRLF & Title_TPoint &"："& rsShop("Points") &"' "
ReturnString = ReturnString & EL_Common.ArrOpenType(OpenType) &">"
ReturnString = ReturnString &"<img align='left' class='piclisti' src='"& EL_Common.PictrueURL(rsShop("DefaultPictrue"), EL_Channel.FilePath) &"' width='"& PhotoWidth &"' height='"& PhotoHeight &"' border='0'>"
ReturnString = ReturnString &"</a>"
If TitleLen >= 0 Then
ReturnString = ReturnString &"<a href='"& InstallDir & ChannelDir &"/ShowProduct.asp?ProductID="& rsShop("ProductID") &"' "
If ShowHint = True Then ReturnString = ReturnString &"title='"& Title_Name &"："& EL_Common.ServerHTMLEncode(rsShop("ProductName")) & VBCRLF & Title_TPoint &"："& rsShop("Points") &"' "
ReturnString = ReturnString &"<span class='piclistn'>"& EL_Common.HTMLEncode(EL_Common.GetTopic(rsShop("ProductName"), TitleLen)) &"</span>"
ReturnString = ReturnString &"</a>"
End If
If ContentLen >=0 Then ReturnString = ReturnString &"<span class='piclistc'>"& EL_Common.GetTopic(EL_Common.RemoveHTML(rsShop("Content")), ContentLen) &"</span>"
Case Else:
ReturnString = ReturnString &"<a href='"& InstallDir & ChannelDir &"/ShowProduct.asp?ProductID="& rsShop("ProductID") &"' "
If ShowHint = True Then ReturnString = ReturnString &"title='"& Title_Name &"："& EL_Common.ServerHTMLEncode(rsShop("ProductName")) & VBCRLF & Title_TPoint &"："& rsShop("Points") &"' "
ReturnString = ReturnString & EL_Common.ArrOpenType(OpenType) &">"
ReturnString = ReturnString &"<img class='piclisti' src='"& EL_Common.PictrueURL(rsShop("DefaultPictrue"), EL_Channel.FilePath) &"' width='"& PhotoWidth &"' height='"& PhotoHeight &"' border='0'>"
If TitleLen >= 0 Then ReturnString = ReturnString &"<br><span class='piclistn'>"& EL_Common.HTMLEncode(EL_Common.GetTopic(rsShop("ProductName"), TitleLen)) &"</span>"
ReturnString = ReturnString &"</a>"
If ContentLen >=0 Then ReturnString = ReturnString &"<br><span class='piclistc'>"& EL_Common.GetTopic(EL_Common.RemoveHTML(rsShop("Content")), ContentLen) &"</span>"
End Select
ReturnString = ReturnString &"</td>"
If (i Mod ColNum) = 0 And i<RowCount Then
ReturnString = ReturnString &"</tr><tr>"
End If
If i<RowCount Then rsShop.MoveNext
Next
ReturnString = ReturnString &"</tr></table>"
End If
rsShop.Close()
Set rsShop = Nothing
Set ShopCmd = Nothing
ShopPhoto = ReturnString
End Function
Private Function Label_ShowComment(ByVal HTML, ByVal InfoID)
Dim Match, Matches, ReturnString, Parameters, Temp
CommonRegExp.Pattern = "<!--\{\$Sho⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -