📄 cls_public.asp
字号:
End If
Next
End If
strContent = strContent & "</tr>" & vbCrLf
If slide>0 Then Rs.MoveNext
Loop
strContent = strContent & "</table>" & vbCrLf
If slide>0 Then
Set xmlNode = XMLDom.cloneNode(True)
Set XSLT = Server.CreateObject("Msxml2.XSLTemplate" & MsxmlVersion)
Set XMLStyle = Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
If XMLStyle.load(Server.MapPath(Newasp.InstallDir & "inc/xslt/NC_slide.xslt")) Then
XSLT.stylesheet = XMLStyle
Set proc = XSLT.createProcessor()
proc.input = xmlNode
proc.transform()
strContent = proc.output
Set proc = Nothing
Else
strContent = vbNullString
End If
Set XMLStyle = Nothing
Set XSLT = Nothing:Set xmlNode = Nothing
Set Node = Nothing:Set XMLDom = Nothing
End If
End If
Rs.Close: Set Rs = Nothing
LoadSoftPic = strContent
End Function
'================================================
'函数名：ReadSoftPic
'作 用：读取软件图片列表
'参 数：str ----原字符串
'================================================
Public Function ReadSoftPic(ByVal str)
Dim strTemp, i
Dim sTempContent, nTempContent, ArrayList
Dim arrTempContent, arrTempContents
On Error Resume Next
strTemp = str
If InStr(strTemp, "{$ReadSoftPic(") > 0 Then
sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadSoftPic(", ")}", 1)
nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadSoftPic(", ")}", 0)
arrTempContents = Split(sTempContent, "|||")
arrTempContent = Split(nTempContent, "|||")
For i = 0 To UBound(arrTempContents)
ArrayList = Split(arrTempContent(i) & ",0", ",")
strTemp = Replace(strTemp, arrTempContents(i), LoadSoftPic(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3), ArrayList(4), ArrayList(5), ArrayList(6), ArrayList(7), ArrayList(8), ArrayList(9), ArrayList(10), ArrayList(11)))
Next
End If
ReadSoftPic = strTemp
End Function
'================================================
'函数名：LoadShopPic
'作 用：装载商品图片列表
'参 数：ClassID ----分类ID
' ChannelID ----频道ID
' sType ----调用商品类型,0=所有最新商品，1=推荐商品，2=热门商品
' TopNum ----显示商品列表数
' strlen ----显示标题长度
' newindow ----新窗口打开
'================================================
Public Function LoadShopPic(ChannelID, ClassID, SpecialID, stype, TopNum, PerRowNum, strLen, newindow, width, height, showtopic)
Dim Rs, SQL, i, strContent, foundstr
Dim strTradeName, ChildStr, ProductImage, HtmlFileName
Dim HtmlFileUrl, addTime, LinkTarget,ShopTime
ChannelID = Newasp.ChkNumeric(ChannelID)
ClassID = Newasp.ChkNumeric(ClassID)
SpecialID = Newasp.ChkNumeric(SpecialID)
stype = Newasp.ChkNumeric(stype)
On Error Resume Next
Newasp.LoadChannel(ChannelID)
If CInt(stype) >= 3 And CLng(ClassID) > 0 Then
SQL = "SELECT ChildStr FROM [NC_Classify] WHERE ChannelID=" & ChannelID & " And ClassID=" & ClassID
Set Rs = Newasp.Execute(SQL)
If Rs.BOF And Rs.EOF Then
Set Rs = Nothing
LoadShopPic = ""
Exit Function
Else
ChildStr = Rs("ChildStr")
End If
Rs.Close
Else
ChildStr = 0
End If
Select Case CInt(stype)
Case 0: foundstr = "ORDER BY A.addTime DESC ,A.ShopID DESC"
Case 1: foundstr = "And A.isBest > 0 ORDER BY A.addTime DESC ,A.ShopID DESC"
Case 2: foundstr = "ORDER BY A.AllHits DESC ,A.ShopID DESC"
Case 3: foundstr = "And A.ClassID in (" & ChildStr & ") ORDER BY A.addTime DESC ,A.ShopID DESC"
Case 4: foundstr = "And A.ClassID in (" & ChildStr & ") And A.isBest > 0 ORDER BY A.addTime DESC ,A.ShopID DESC"
Case 5: foundstr = "And A.ClassID in (" & ChildStr & ") ORDER BY A.AllHits DESC ,A.ShopID DESC"
Case Else
foundstr = "Order By A.addTime Desc ,A.ShopID Desc"
End Select
If CInt(stype) >= 3 And CLng(ClassID) = 0 Then
foundstr = "Order By A.addTime Desc ,A.ShopID Desc"
End If
If CLng(SpecialID) <> 0 Then
foundstr = "And A.SpecialID =" & CLng(SpecialID) & " " & foundstr
End If
SQL = " A.ShopID,A.ClassID,A.TradeName,A.PastPrice,A.NowPrice,A.AllHits,A.addTime,A.HtmlFileDate,A.isBest,A.ProductImage,A.Star,"
If CInt(showtopic) = 1 Then
SQL = "SELECT TOP " & CInt(TopNum) & SQL & " C.ClassName,C.HtmlFileDir,C.UseHtml FROM [NC_ShopList] A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID WHERE A.isAccept>0 And A.ChannelID=" & ChannelID & " " & foundstr
Else
SQL = "SELECT TOP " & CInt(TopNum) & SQL & " C.ClassName,C.HtmlFileDir,C.UseHtml FROM [NC_ShopList] A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID WHERE A.isAccept>0 And A.ProductImage<>'' And A.ChannelID=" & ChannelID & " " & foundstr
End If
Set Rs = Newasp.Execute(SQL)
If Rs.BOF And Rs.EOF Then
strContent = "<img src='" & Newasp.InstallDir & "images/no_pic.gif' width=" & width & " height=" & height & " border=0>"
Else
strContent = "<table width=""100%"" border=0 cellpadding=1 cellspacing=3>" & vbCrLf
Do While Not Rs.EOF
strContent = strContent & "<tr>" & vbCrLf
For i = 1 To CInt(PerRowNum)
strContent = strContent & "<td align=center class=shopimagelist>"
If Not Rs.EOF Then
strTradeName = Newasp.GotTopic(Rs("TradeName"), CInt(strLen))
ProductImage = Newasp.GetImageUrl(Rs("ProductImage"), Newasp.ChannelData(1))
ProductImage = Newasp.GetFlashAndPic(ProductImage, height, width)
HtmlFileName = Newasp.ReadFileName(Rs("HtmlFileDate"), Rs("ShopID"), Newasp.ChannelHtmlExt, Newasp.ChannelPrefix, Newasp.ChannelHtmlForm, "")
If CInt(Newasp.ChannelUseHtml) <> 0 Then
HtmlFileUrl = Newasp.ChannelPath & Rs("HtmlFileDir") & Newasp.ShowDatePath(Rs("HtmlFileDate"), Newasp.ChannelHtmlPath) & HtmlFileName
Else
HtmlFileUrl = Newasp.ChannelPath & "show.asp?id=" & Rs("ShopID")
End If
If CInt(newindow) <> 0 Then
LinkTarget = " target=""_blank"""
Else
LinkTarget = ""
End If
ShopTime = Newasp.ShowDateTime(Rs("addTime"), 2)
strContent = strContent & Newasp.MainSetting(20)
strContent = Replace(strContent, "{$ShopID}", Rs("shopid"))
strContent = Replace(strContent, "{$ShopUrl}", HtmlFileUrl)
strContent = Replace(strContent, "{$ChannelRootDir}", Newasp.ChannelPath)
strContent = Replace(strContent, "{$SkinPath}", Newasp.SkinPath)
strContent = Replace(strContent, "{$InstallDir}", Newasp.InstallDir)
strContent = Replace(strContent, "{$ShopHits}", Rs("AllHits"))
strContent = Replace(strContent, "{$Star}", Rs("star"))
strContent = Replace(strContent, "{$ShopDateTime}", ShopTime)
strContent = Replace(strContent, "{$PastPrice}", FormatNumber(Rs("PastPrice"),2,-1))
strContent = Replace(strContent, "{$NowPrice}", FormatNumber(Rs("NowPrice"),2,-1))
strContent = Replace(strContent, "{$ProductImage}", "<a href='" & HtmlFileUrl & "' title='" & Rs("TradeName") & "'" & LinkTarget & ">" & ProductImage & "</a>")
strContent = Replace(strContent, "{$TradeName}", "<a href='" & HtmlFileUrl & "' title='" & Rs("TradeName") & "'" & LinkTarget & ">" & strTradeName & "</a>")
strContent = strContent & "</td>" & vbCrLf
Rs.MoveNext
End If
Next
strContent = strContent & "</tr>" & vbCrLf
Loop
strContent = strContent & "</table>" & vbCrLf
End If
Rs.Close: Set Rs = Nothing
LoadShopPic = strContent
End Function
'================================================
'函数名：ReadShopPic
'作 用：读取商品图片列表
'参 数：str ----原字符串
'================================================
Public Function ReadShopPic(ByVal str)
Dim strTemp, i
Dim sTempContent, nTempContent, ArrayList
Dim arrTempContent, arrTempContents
On Error Resume Next
strTemp = str
If InStr(strTemp, "{$ReadShopPic(") > 0 Then
sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadShopPic(", ")}", 1)
nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadShopPic(", ")}", 0)
arrTempContents = Split(sTempContent, "|||")
arrTempContent = Split(nTempContent, "|||")
For i = 0 To UBound(arrTempContents)
ArrayList = Split(arrTempContent(i), ",")
strTemp = Replace(strTemp, arrTempContents(i), LoadShopPic(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3), ArrayList(4), ArrayList(5), ArrayList(6), ArrayList(7), ArrayList(8), ArrayList(9), ArrayList(10)))
Next
End If
ReadShopPic = strTemp
End Function
'================================================
'函数名：LoadFlashPic
'作 用：装载动画图片列表
'参 数：ClassID ----分类ID
' ChannelID ----频道ID
' sType ----调用动画类型,0=所有最新动画，1=推荐动画，2=热门动画
' TopNum ----显示动画列表数
' strlen ----显示标题长度
' newindow ----新窗口打开
'================================================
Public Function LoadFlashPic(ByVal ChannelID, ByVal ClassID, ByVal SpecialID, _
ByVal stype, ByVal TopNum, ByVal PerRowNum, ByVal strLen, ByVal newindow, _
ByVal width, ByVal height, ByVal showtopic, ByVal slide)
Dim Rs, SQL, i, strContent, foundstr, n
Dim strtitle, ChildStr, miniature, HtmlFileName
Dim HtmlFileUrl, addTime, LinkTarget
Dim XMLDom,xmlNode,Node,XSLT,XMLStyle,proc
ChannelID = Newasp.ChkNumeric(ChannelID)
ClassID = Newasp.ChkNumeric(ClassID)
SpecialID = Newasp.ChkNumeric(SpecialID)
stype = Newasp.ChkNumeric(stype)
height = Newasp.ChkNumeric(height)
width = Newasp.ChkNumeric(width)
slide = Newasp.ChkNumeric(slide)
On Error Resume Next
Newasp.LoadChannel(ChannelID)
If CInt(stype) >= 3 And CLng(ClassID) <> 0 Then
SQL = "SELECT ChildStr FROM [NC_Classify] WHERE ChannelID = " & ChannelID & " And ClassID = " & ClassID
Set Rs = Newasp.Execute(SQL)
If Rs.BOF And Rs.EOF Then
Set Rs = Nothing
LoadFlashPic = ""
Exit Function
Else
ChildStr = Rs("ChildStr")
End If
Rs.Close
Else
ChildStr = 0
End If
Select Case CInt(stype)
Case 0: foundstr = "ORDER BY A.addTime DESC ,A.flashid DESC"
Case 1: foundstr = "And A.isBest > 0 ORDER BY A.addTime DESC ,A.flashid DESC"
Case 2: foundstr = "ORDER BY A.AllHits DESC ,A.flashid DESC"
Case 3: foundstr = "And A.ClassID in (" & ChildStr & ") ORDER BY A.addTime DESC ,A.flashid DESC"
Case 4: foundstr = "And A.ClassID in (" & ChildStr & ") And A.isBest > 0 ORDER BY A.addTime DESC ,A.flashid DESC"
Case 5: foundstr = "And A.ClassID in (" & ChildStr & ") ORDER BY A.AllHits DESC ,A.flashid DESC"
Case 9
If IsSqlDataBase = 1 Then
foundstr = "ORDER BY newid()"
Else
foundstr = "ORDER BY rnd(A.flashid)"
End If
Case Else
foundstr = "ORDER BY A.addTime DESC ,A.flashid DESC"
End Select
If CInt(stype) >= 3 And CLng(ClassID) = 0 Then
foundstr = "ORDER BY A.addTime DESC ,A.flashid DESC"
End If
If CLng(SpecialID) <> 0 Then
foundstr = "And A.SpecialID =" & CLng(SpecialID) & " " & foundstr
End If
SQL = " A.flashid,A.ClassID,A.title,A.AllHits,A.addTime,A.HtmlFileDate,A.isBest,A.miniature,"
SQL = "SELECT TOP " & CInt(TopNum) & SQL & " C.ClassName,C.HtmlFileDir,C.UseHtml FROM [NC_FlashList] A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID WHERE A.isAccept>0 And A.miniature<>'' And A.ChannelID=" & ChannelID & " " & foundstr & ""
Set Rs = Newasp.Execute(SQL)
If Rs.BOF And Rs.EOF Then
strContent = "<img src='" & Newasp.InstallDir & "images/no_pic.gif' width=" & width & " height=" & height & " border=0>"
Else
strContent = "<table width=""100%"" border=""0"" cellpadding=""0"" cellspacing=""3"">" & vbCrLf
n = 0
'-- 是否启用幻灯片效果
If slide>0 Then
Set XMLDom=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
XMLDom.appendChild(XMLDom.createElement("xml"))
'-- 幻灯片效果基本设置
Set Node=XMLDom.createNode(1,"setting","")
Node.attributes.setNamedItem(XMLDom.createNode(2,"ChannelID","")).text = ChannelID
Node.attributes.setNamedItem(XMLDom.createNode(2,"width","")).text = width
Node.attributes.setNamedItem(XMLDom.createNode(2,"height","")).text = height
If showtopic=1 Then
Node.attributes.setNamedItem(XMLDom.createNode(2,"text_height","")).text = 20
Else
Node.attributes.setNamedItem(XMLDom.createNode(2,"text_height","")).text = 0
End If
Node.attributes.setNamedItem(XMLDom.createNode(2,"maxpic","")).text = TopNum
Node.attributes.setNamedItem(XMLDom.createNode(2,"maxlen","")).text = strLen
Node.attributes.setNamedItem(XMLDom.createNode(2,"path","")).text = Newasp.InstallDir
Node.attributes.setNamedItem(XMLDom.createNode(2,"slidetype","")).text = slide
XMLDom.documentElement.appendChild(Node)
End If
Do While Not Rs.EOF
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -