📄 classshop.asp
字号:
End Function
Private Function Label_GetShopList(ByVal HTML)
Dim Match, Matches, ReturnString, Parameters, Temp
CommonRegExp.Pattern = "<!--\{\$GetShopList\(([ 0-9]+|[ ]*ChannelID[ ]*),([ 0-9\|]+|[ ]*ClassID[ ]*),([ 0-9]+),([ 0-9]+),[ ]*(True|False)[ ]*,([ 0-9]+),[ ]*(True|False)[ ]*,[ ]*(True|False)[ ]*,([ 0-9]+),([ 0-9]+),([ 0-9]+),([ 0-9]+),([ 0-9]+),([ 0-9]+),([ 0-9]+),[ ]*(True|False)[ ]*,[ ]*(True|False)[ ]*,[ \w\""]]*,[ \w\""]]*,[ \w\""]]*\)\}-->"
Set Matches = CommonRegExp.Execute(HTML)
ReturnString = HTML
Temp = ""
For Each Match in Matches
Parameters = EL_Common.GetLabelParameters(Match.Value, "GetShopList")
Temp = ShopList(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), Parameters(15), Parameters(16), Parameters(17), Parameters(18), Parameters(19))
ReturnString = Replace(ReturnString, Match.Value, Temp)
Next
CommonRegExp.Pattern = "\{\$GetShopList\(([ 0-9]+|[ ]*ChannelID[ ]*),([ 0-9\|]+|[ ]*ClassID[ ]*),([ 0-9]+),([ 0-9]+),[ ]*(True|False)[ ]*,([ 0-9]+),[ ]*(True|False)[ ]*,[ ]*(True|False)[ ]*,([ 0-9]+),([ 0-9]+),([ 0-9]+),([ 0-9]+),([ 0-9]+),([ 0-9]+),([ 0-9]+),[ ]*(True|False)[ ]*,[ ]*(True|False)[ ]*,[ \w\""]]*,[ \w\""]]*,[ \w\""]]*\)\}"
Set Matches = CommonRegExp.Execute(ReturnString)
For Each Match in Matches
Parameters = EL_Common.GetLabelParameters(Match.Value, "GetShopList")
Temp = ShopList(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), Parameters(15), Parameters(16), Parameters(17), Parameters(18), Parameters(19))
ReturnString = Replace(ReturnString, Match.Value, Temp)
Next
Set Matches = Nothing
Label_GetShopList = ReturnString
End Function
Private Function ShopList(ByVal iChannelID, ByVal ArrClassID, ByVal ShopNum, ByVal TitleLen, ByVal ShowPoints, ByVal ShowBookButton, ByVal ShowClassName, ByVal IsCommend, ByVal OrderType, ByVal OpenType, ByVal ColNum, ByVal ListType, ByVal ListPicWidth, ByVal ListPicHeight, ByVal ShowIcon, ByVal ShowHint, ByVal ShowPage, ByVal ClassA, ByVal Class1, ByVal Class2)
Dim ShopCmd, rsShop, i, ReturnString
Dim PageSizes, RowCount, TotalRowCount, PageCounts
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,ShowPageSize,ItemName,ItemUnit,Disabled,UploadDir", "ChannelID="& iChannelID &" AND ChannelType=0")
rsChannel.Close()
If ChannelCmd(0) <> 1 Then
Set rsChannel = Nothing
Set ChannelCmd = Nothing
ArticleList = EL_Common.Lang("BaseConfig.ChannelError", "·频道参数错误")
Exit Function
Else
rsChannel.Open()
ChannelDir = rsChannel(0)
ChannelModule = rsChannel(1)
PageSizes = rsChannel(2)
ItemName = rsChannel(3)
ItemUnit = rsChannel(4)
Disabled = rsChannel(5)
UploadDir = rsChannel(6)
rsChannel.Close()
End If
Set rsChannel = Nothing
Set ChannelCmd = Nothing
Else
ChannelDir = EL_Channel.ChannelDir
ChannelModule = EL_Channel.ChannelModule
PageSizes = EL_Channel.ShowPageSize
ItemName = EL_Channel.ItemName
ItemUnit = EL_Channel.ItemUnit
Disabled = EL_Channel.Disabled
UploadDir = EL_Channel.UploadDir
End If
If ChannelModule <> 7 Then
ShopList = EL_Common.Lang("BaseConfig.ChannelModuleError", "·频道模块错误")
Exit Function
End If
If Disabled Then
ShopList = EL_Common.Lang("BaseConfig.Disabled", "·该频道已被禁用")
Exit Function
End If
ShopNum = EL_Common.ELClng(ShopNum)
TitleLen = EL_Common.ELClng(TitleLen)
ShowPoints = Eval(ShowPoints)
ShowBookButton = EL_Common.ELClng(ShowBookButton)
ShowClassName = Eval(ShowClassName)
IsCommend = Eval(IsCommend)
OrderType = EL_Common.ELClng(OrderType)
OpenType = EL_Common.ELClng(OpenType)
ColNum = EL_Common.ELClng(ColNum)
ListType = EL_Common.ELClng(ListType)
ShowIcon = EL_Common.ELClng(ShowIcon)
ShowHint = Eval(ShowHint)
ShowPage = Eval(ShowPage)
ListPicWidth = EL_Common.ELClng(ListPicWidth)
ListPicHeight = EL_Common.ELClng(ListPicHeight)
ClassA = Replace(ClassA, """", "")
Class1 = Replace(Class1, """", "")
Class2 = Replace(Class2, """", "")
If OpenType > 1 Then OpenType = 1
If ColNum < 1 Then ColNum = 1
SQLTables = "EL_Shop,EL_Class"
SQLFields = "EL_Shop.ProductID,EL_Shop.ProductName,EL_Shop.Points"
If ShowClassName Then SQLFields = SQLFields &",EL_Class.ClassID,EL_Class.ClassName"
If ListType = 5 Then SQLFields = SQLFields &",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.ClassID=EL_Class.ClassID 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 &" "
ReturnString = ""
If EL_Flag = False Then ShowPage = False '防止在特殊标签中设ShowPage=True
If ShowPage Then
Call EL_Common.InitCommand(ShopCmd, "EL_SP_SplitPage")
With ShopCmd
.Parameters.Append .CreateParameter("RETURN", 3, 4, 4)
.Parameters.Append .CreateParameter("@Tables", 200, 1, 50, SQLTables)
.Parameters.Append .CreateParameter("@PrimaryKey", 200, 1, 50, "EL_Shop.ProductID")
.Parameters.Append .CreateParameter("@Sort", 200, 1, 200, SQLOrder)
.Parameters.Append .CreateParameter("@CurrentPage", 3, 1, 4, CurrentPage)
.Parameters.Append .CreateParameter("@PageSize", 3, 1, 4, PageSizes)
.Parameters.Append .CreateParameter("@Fields", 200, 1, 1000, SQLFields)
.Parameters.Append .CreateParameter("@Filter", 200, 1, 1000, SQLCondition)
.Parameters.Append .CreateParameter("@Group", 200, 1, 1, "")
.Parameters.Append .CreateParameter("@TotalRowCount", 3, 2, 4)
.Parameters.Append .CreateParameter("@PageCount", 3, 2, 4)
Set rsShop = .Execute()
End With
rsShop.Close()
RowCount = ShopCmd(0)
TotalRowCount = ShopCmd(9)
PageCounts = ShopCmd(10)
Else
If ShopNum < 1 Then ShopNum = EL_Common.Lang("Shop.TopNum", 5)
Call EL_Common.InitCommonCmd(ShopCmd, rsShop, SQLTables, " TOP "& ShopNum &" "& SQLFields, SQLCondition &" ORDER BY "& SQLOrder)
rsShop.Close()
RowCount = ShopCmd(0)
End If
If RowCount = 0 Then
Set rsShop = Nothing
Set ShopCmd = Nothing
ShopList = EL_Common.RegExpStaticLabel(EL_Common.Lang("BaseConfig.NoList", "·没有任何{$ItemName}"), "{$ItemName}", ItemName)
Exit Function
Else
Dim Title_Name, Title_TPoint, ArrClass(2)
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()
Select Case ListType
Case 2: ReturnString = "<div class='list'>"
Case 3: ReturnString = "<ul class='list'>"
Case 4: ReturnString = "<ol class='list'>"
Case 5: ReturnString = "<table border='0' cellspacing='0' cellpadding='0' class='piclist'><tr>"
Case Else: ReturnString = "<table width='100%' border='0' cellspacing='0' cellpadding='0' class='list'><tr>"
End Select
If ClassA = "" Then ClassA = "lista"
If Class1 = "" Then Class1 = "list1"
If Class2 = "" Then Class2 = "list2"
ArrClass(1) = Class1
ArrClass(2) = Class2
For i = 1 To RowCount
Select Case ListType
Case 2:
ReturnString = ReturnString &"<div class='"& ArrClass(2-((i+2) Mod 2)) &"'>"
ReturnString = ReturnString &"<span class='listn'>"
If ShowIcon > 0 Then ReturnString = ReturnString &"<img border='0' src='"& InstallDir & ChannelDir &"/Images/icon"& ShowIcon &".gif' /> "
If ShowClassName = True Then ReturnString = ReturnString &"[<a href='"& InstallDir & ChannelDir &"/ShowClass.asp?ClassID="& rsShop("ClassID") &"' class='"& ClassA &"'>"& EL_Common.ServerHTMLEncode(rsShop("ClassName")) &"</a>]"
ReturnString = ReturnString &"<a href='"& InstallDir & ChannelDir &"/ShowProduct.asp?ProductID="& rsShop("ProductID") &"' class='"& ClassA &"' "
If ShowHint = True Then ReturnString = ReturnString &"title='"& Title_Name &"："& EL_Common.HTMLEncode(rsShop("ProductName")) & VBCRLF & Title_TPoint &"："& rsShop("Points") &"' "
ReturnString = ReturnString & EL_Common.ArrOpenType(OpenType) &">"& EL_Common.HTMLEncode(EL_Common.GetTopic(rsShop(1), TitleLen))
ReturnString = ReturnString &"</a></span>"
If ShowPoints = True Then ReturnString = ReturnString &"<span class='listpt'>"& rsShop("Points") & PointItemUnit &"</span>"
If ShowBookButton > 0 Then ReturnString = ReturnString &"<span class='listbt'><a href='"& InstallDir & ChannelDir &"/ShowProduct.asp?ProductID="& rsShop("ProductID") &"' class='"& ClassA &"'><img src='"& InstallDir & ChannelDir &"/Images/bookbutton"& ShowBookButton &".gif' border='0'></a></span>"
ReturnString = ReturnString &"</div>"
Case 3, 4:
ReturnString = ReturnString &"<li class='"& ArrClass(2-((i+2) Mod 2)) &"'>"
ReturnString = ReturnString &"<span class='listn'>"
If ShowIcon > 0 Then ReturnString = ReturnString &"<img border='0' src='"& InstallDir & ChannelDir &"/Images/icon"& ShowIcon &".gif' /> "
If ShowClassName = True Then ReturnString = ReturnString &"[<a href='"& InstallDir & ChannelDir &"/ShowClass.asp?ClassID="& rsShop("ClassID") &"' class='"& ClassA &"'>"& EL_Common.ServerHTMLEncode(rsShop("ClassName")) &"</a>]"
ReturnString = ReturnString &"<a href='"& InstallDir & ChannelDir &"/ShowProduct.asp?ProductID="& rsShop("ProductID") &"' class='"& ClassA &"' "
If ShowHint = True Then ReturnString = ReturnString &"title='"& Title_Name &"："& EL_Common.HTMLEncode(rsShop("ProductName")) & VBCRLF & Title_TPoint &"："& rsShop("Points") &"' "
ReturnString = ReturnString & EL_Common.ArrOpenType(OpenType) &">"& EL_Common.HTMLEncode(EL_Common.GetTopic(rsShop(1), TitleLen))
ReturnString = ReturnString &"</a></span>"
If ShowPoints = True Then ReturnString = ReturnString &"<span class='listpt'>"& rsShop("Points") & PointItemUnit &"</span>"
If ShowBookButton > 0 Then ReturnString = ReturnString &"<span class='listbt'><a href='"& InstallDir & ChannelDir &"/ShowProduct.asp?ProductID="& rsShop("ProductID") &"' class='"& ClassA &"'><img src='"& InstallDir & ChannelDir &"/Images/bookbutton"& ShowBookButton &".gif' border='0'></a></span>"
ReturnString = ReturnString &"</li>"
Case 5:
ReturnString = ReturnString &"<td class='piclisttd'>"
ReturnString = ReturnString &"<a href='"& InstallDir & ChannelDir &"/ShowProduct.asp?ProductID="& rsShop(0) &"' "
If ShowHint = True Then ReturnString = ReturnString &"title='"& Title_Name &"："& EL_Common.HTMLEncode(rsShop(1)) & VBCRLF & Title_TPoint &"："& rsShop(2) &"' class='"& ClassA &"'"& EL_Common.ArrOpenType(OpenType) &">"
ReturnString = ReturnString &"<img class='piclisti' src='"& EL_Common.PictrueURL(rsShop("DefaultPictrue"), EL_Channel.FilePath) &"' width='"& ListPicWidth &"' height='"& ListPicHeight &"' border='0'>"
ReturnString = ReturnString &"<br><span class='piclistn'>"& EL_Common.HTMLEncode(EL_Common.GetTopic(rsShop(1), TitleLen)) &"</span>"
If ShowPoints = True Then ReturnString = ReturnString &"<br><span class='listpt'>"& PointItemName &"："& rsShop(2) & PointItemUnit &"</span>"
ReturnString = ReturnString &"</a>"
If ShowBookButton>0 Then ReturnString = ReturnString &"<br><span class='listbt'><a href='"& InstallDir & ChannelDir &"/ShowProduct.asp?ProductID="& rsShop("ProductID") &"' class='"& ClassA &"'><img src='"& InstallDir & ChannelDir &"/Images/bookbutton"& ShowBookButton &".gif' border='0'></a></span>"
ReturnString = ReturnString &"</td>"
Case Else:
ReturnString = ReturnString &"<td width='"& 100/ColNum &"%' class='"& ArrClass(2-((i+2) Mod 2)) &"'>"
ReturnString = ReturnString &"<span class='listn'>"
If ShowIcon > 0 Then ReturnString = ReturnString &"<img border='0' src='"& InstallDir & ChannelDir &"/Images/icon"& ShowIcon &".gif' /> "
If ShowClassName = True Then ReturnString = ReturnString &"[<a href='"& InstallDir & ChannelDir &"/ShowClass.asp?ClassID="& rsShop("ClassID") &"' class='"& ClassA &"'>"& EL_Common.ServerHTMLEncode(rsShop("ClassName")) &"</a>]"
ReturnString = ReturnString &"<a href='"& InstallDir & ChannelDir &"/ShowProduct.asp?ProductID="& rsShop("ProductID") &"' class='"& ClassA &"' "
If ShowHint = True Then ReturnString = ReturnString &"title='"& Title_Name &"："& EL_Common.HTMLEncode(rsShop("ProductName")) & VBCRLF & Title_TPoint &"："& rsShop("Points") &"' "
ReturnString = ReturnString & EL_Common.ArrOpenType(OpenType) &">"& EL_Common.HTMLEncode(EL_Common.GetTopic(rsShop(1), TitleLen))
ReturnString = ReturnString &"</a></span></td>"
If ShowPoints = True Then ReturnString = ReturnString &"<td class='"& ArrClass(2-((i+2) Mod 2)) &"'><span class='listpt'>"& rsShop("Points") & PointItemUnit &"</span></td>"
If ShowBookButton > 0 Then ReturnString = ReturnString &"<td class='"& ArrClass(2-((i+2) Mod 2)) &"'><span class='listbt'><a href='"& InstallDir & ChannelDir &"/ShowProduct.asp?ProductID="& rsShop("ProductID") &"' class='"& ClassA &"'><img src='"& InstallDir & ChannelDir &"/Images/bookbutton"& ShowBookButton &".gif' border='0'></a></span></td>"
End Select
If (i Mod ColNum) = 0 And i<RowCount Then
Select Case ListType
Case 2, 3, 4:
Case Else: ReturnString = ReturnString &"</tr><tr>"
End Select
End If
If i<RowCount Then rsShop.MoveNext
Next
Select Case ListType
Case 2: ReturnString = ReturnString &"</div>"
Case 3: ReturnString = ReturnString &"</ul>"
Case 4: ReturnString = ReturnString &"</ol>"
Case Else: ReturnString = ReturnString &"</tr></table>"
End Select
rsShop.Close()
End If
Set rsShop = Nothing
Set ShopCmd = Nothing
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -