www.gusucode.com > 艺术签名文章资讯网源代码 > 艺术签名文章资讯网源代码/624/inc/classmenu.asp
<%
Const Pagesmode = True
'================================================
'函数名：LoadClassMenu
'作 用：装载分类菜单
'参 数：ChannelID ----频道ID
'================================================
Function LoadClassMenu(ByVal ChannelID, ByVal ClassID, ByVal TopNum, _
ByVal PerRowNum, ByVal Compart, ByVal styles, ByVal rootid, ByVal intDefault, ByVal MaxDepth)
Dim Rs, SQL, i, strContent, foundsql
Dim rsClass, ParentID, Child, TotalNumber
Dim LinkTarget, HtmlFileUrl, ClassName, strClass
Dim m_strFileUrl,strwidth,w,stylesheet
LoadClassMenu = ""
ChannelID = Newasp.ChkNumeric(ChannelID)
intDefault = Newasp.ChkNumeric(intDefault)
MaxDepth = Newasp.ChkNumeric(MaxDepth)
If intDefault = 0 Then intDefault = 1
If ChannelID = 0 Or ChannelID = 4 Or ChannelID = 9999 Then ChannelID = intDefault
ClassID = Newasp.ChkNumeric(ClassID)
rootid = Newasp.ChkNumeric(rootid)
TopNum = Newasp.ChkNumeric(TopNum)
PerRowNum = Newasp.ChkNumeric(PerRowNum)
If PerRowNum < 2 Then
strwidth = "width:100%;"
w = 100
Else
w = 100\PerRowNum
If w = 0 Then w = 20
strwidth = "float:left;width:"&w&"%;"
End If
If TopNum = 0 Then TopNum = 10
strContent = vbNullString
If styles <> "0" And styles <> "" Then
strClass = " class=""" & Trim(styles) & """"
Else
strClass = ""
End If
If rootid > 0 Then
Set Rs = Newasp.Execute("SELECT classid,rootid FROM [NC_Classify] WHERE classid="&rootid)
If Rs.BOF And Rs.EOF Then
rootid = 0
Else
rootid = Rs("rootid")
End If
Set Rs = Nothing
Else
rootid = 0
End If
Newasp.LoadChannel(ChannelID)
foundsql = "SELECT TOP " & TopNum & " C.ClassID,C.rootid,C.depth,C.ClassName,C.ColorModes,C.FontModes,C.Readme,C.Child,C.LinkTarget,C.TurnLink,C.TurnLinkUrl,C.HtmlFileDir,C.UseHtml,B.ChannelDir,B.StopChannel,B.IsCreateHtml,B.HtmlExtName,B.SortDestination FROM [NC_Classify] C inner join [NC_Channel] B On C.ChannelID=B.ChannelID WHERE C.ChannelID = " & CLng(ChannelID)
If CLng(ClassID) > 0 Then
Set rsClass = Newasp.Execute("SELECT parentid,Child FROM [NC_Classify] WHERE ChannelID = " & CLng(ChannelID) & " And ClassID = " & CLng(ClassID))
If rsClass.BOF And rsClass.EOF Then
Exit Function
Else
ParentID = rsClass("parentid")
Child = rsClass("Child")
End If
Set rsClass = Nothing
If Child <> 0 Then
SQL = foundsql & " And C.Parentid = " & CLng(ClassID) & " ORDER BY C.orders,C.ClassID"
Else
SQL = foundsql & " And C.Parentid = " & CLng(ParentID) & " ORDER BY C.orders,C.rootid"
End If
Else
If MaxDepth = 0 Then
SQL = foundsql & " ORDER BY C.depth,C.rootid,C.ClassID"
Else
SQL = foundsql & " And C.depth=0 ORDER BY C.rootid,C.ClassID"
End If
End If
Set Rs = Server.CreateObject("ADODB.Recordset")
Rs.Open SQL, Conn, 1, 1
Newasp.SqlQueryNum = Newasp.SqlQueryNum + 1
If Rs.BOF And Rs.EOF Then
Exit Function
Else
If Rs("StopChannel") <> 0 Then
LoadClassMenu = ""
Exit Function
End If
i = 0
TotalNumber = Rs.RecordCount
Do While Not Rs.EOF
i = i + 1
If Rs("LinkTarget") <> 0 Then
LinkTarget = " target=""_blank"""
Else
LinkTarget = ""
End If
If rootid = Rs("rootid") Then
stylesheet = " class=""selmenulinks"""
Else
stylesheet = strClass
End If
ClassName = Newasp.ReadFontMode(Rs("ClassName"), Rs("ColorModes"), Rs("FontModes"))
If Rs("TurnLink") <> 0 Then
ClassName = "<a href=""" & Rs("TurnLinkUrl") & """" & LinkTarget & stylesheet & LoadRemark(Rs("Readme")) & ">" & ClassName & "</a>"
Else
If Rs("IsCreateHtml") <> 0 Then
m_strFileUrl = Newasp.ChannelDomain & Newasp.ReadDestination(Rs("SortDestination"), Rs("ChannelDir"), "",Rs("HtmlFileDir"),Rs("ClassID"),0,1,"")
ClassName = "<a href=""" & m_strFileUrl & """" & LinkTarget & stylesheet & LoadRemark(Rs("Readme")) & ">" & ClassName & "</a>"
Else
If IsURLRewrite Then
m_strFileUrl = Newasp.ChannelPath & "list_1_" & Rs("ClassID") & Newasp.ChannelHtmlExt
Else
m_strFileUrl = Newasp.ChannelPath & "list.asp?classid=" & Rs("ClassID")
End If
ClassName = "<a href=""" & m_strFileUrl & """" & LinkTarget & stylesheet & LoadRemark(Rs("Readme")) & ">" & ClassName & "</a>"
End If
End If
If Compart <> "0" Then
strContent = strContent & ClassName
If i Mod CInt(PerRowNum) = 0 Or i = TotalNumber Then
If i = TotalNumber Then
strContent = strContent
Else
strContent = strContent & "<br/>"
End If
Else
strContent = strContent & " " & Compart & " "
End If
Else
strContent = strContent & Newasp.MainSetting(12)
strContent = Replace(strContent, "{$ClassMenu}", ClassName)
strContent = Replace(strContent, "{$i}", i)
strContent = Replace(strContent, "{$strwidth}", strwidth)
If i = TotalNumber Then
strContent = Replace(strContent, "{$w}", w)
Else
strContent = Replace(strContent, "{$w}", w) & vbCrLf
End If
End If
Rs.MoveNext
Loop
End If
Rs.Close: Set Rs = Nothing
LoadClassMenu = strContent
End Function
'================================================
'函数名：ReadClassMenu
'作 用：读取分类菜单
'参 数：str ----原字符串
'================================================
Function ReadClassMenu(ByVal str)
Dim strTemp, i
Dim sTempContent, nTempContent, ArrayList
Dim arrTempContent, arrTempContents
'--增加专题菜单
str = ReadSpecialMenu(str)
str = ReadCatalog(str)
strTemp = str
If InStr(strTemp, "{$ReadClassMenu(") > 0 Then
sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadClassMenu(", ")}", 1)
nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadClassMenu(", ")}", 0)
arrTempContents = Split(sTempContent, "|||")
arrTempContent = Split(nTempContent, "|||")
For i = 0 To UBound(arrTempContents)
ArrayList = Split(arrTempContent(i) & ",0,0,0", ",")
strTemp = Replace(strTemp, arrTempContents(i), LoadClassMenu(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3), ArrayList(4), ArrayList(5), ArrayList(6), ArrayList(7), ArrayList(8)))
Next
End If
ReadClassMenu = strTemp
End Function
'================================================
'函数名：LoadClassMenubar
'作 用：装载分类菜单栏
'参 数：ChannelID ----频道
'================================================
Function LoadClassMenubar(ByVal ChannelID, ByVal ClassID, _
ByVal TopNum, ByVal PerRowNum, ByVal frontstr, ByVal intDefault)
Dim Rs, SQL, i, strContent, foundsql
Dim rsClass, ParentID, Child, n
Dim LinkTarget, HtmlFileUrl, ClassName, strClass
Dim m_strFileUrl
LoadClassMenubar = ""
ChannelID = Newasp.ChkNumeric(ChannelID)
intDefault = Newasp.ChkNumeric(intDefault)
If intDefault = 0 Then intDefault = 1
If ChannelID = 0 Or ChannelID = 4 Or ChannelID = 9999 Then ChannelID = intDefault
ClassID = Newasp.ChkNumeric(ClassID)
If Not IsNumeric(TopNum) Then Exit Function
If Not IsNumeric(PerRowNum) Then Exit Function
If frontstr <> "0" And frontstr <> "" Then
frontstr = frontstr
Else
frontstr = ""
End If
Newasp.LoadChannel(ChannelID)
foundsql = "SELECT TOP " & TopNum & " C.ClassID,C.depth,C.ClassName,C.ColorModes,C.FontModes,C.Readme,C.Child,C.LinkTarget,C.TurnLink,C.TurnLinkUrl,C.HtmlFileDir,C.UseHtml,C.ShowCount,B.ChannelDir,B.StopChannel,B.ModuleName,B.IsCreateHtml,B.HtmlExtName,B.SortDestination FROM [NC_Classify] C INNER JOIN [NC_Channel] B On C.ChannelID=B.ChannelID WHERE C.ChannelID=" & CInt(ChannelID)
If CLng(ClassID) > 0 Then
Set rsClass = Newasp.Execute("SELECT parentid,Child FROM [NC_Classify] WHERE ChannelID = " & CInt(ChannelID) & " And ClassID = " & CLng(ClassID))
If rsClass.BOF And rsClass.EOF Then
Exit Function
Else
ParentID = rsClass("parentid")
Child = rsClass("Child")
End If
rsClass.Close: Set rsClass = Nothing
If Child <> 0 Then
SQL = foundsql & " And C.Parentid = " & CLng(ClassID) & " ORDER BY C.orders,C.ClassID"
Else
SQL = foundsql & " And C.Parentid = " & CLng(ParentID) & " ORDER BY C.orders,C.rootid"
End If
Else
SQL = foundsql & " And C.depth=0 ORDER BY C.rootid,C.ClassID"
End If
Set Rs = Newasp.Execute(SQL)
If Rs.BOF And Rs.EOF Then
Exit Function
Else
If Rs("StopChannel") <> 0 Then
LoadClassMenubar = ""
Exit Function
End If
n = 0
Do While Not Rs.EOF
For i = 1 To CInt(PerRowNum)
n = n + 1
strContent = strContent & "<li>"
If Not Rs.EOF Then
If Rs("LinkTarget") <> 0 Then
LinkTarget = " target=""_blank"""
Else
LinkTarget = ""
End If
If Rs("ClassID") = CLng(ClassID) Then
strClass = " class=""distinct"""
Else
strClass = " class=""menubar"""
End If
ClassName = Newasp.ReadFontMode(Replace(Rs("ClassName"), " ", " "), Rs("ColorModes"), Rs("FontModes"))
If Rs("TurnLink") <> 0 Then
ClassName = "<a href=""" & Rs("TurnLinkUrl") & """" & LinkTarget & strClass & LoadRemark(Rs("Readme")) & ">" & ClassName & "</a>"
Else
If Rs("IsCreateHtml") <> 0 Then
m_strFileUrl = Newasp.ChannelDomain & Newasp.ReadDestination(Rs("SortDestination"), Rs("ChannelDir"), "",Rs("HtmlFileDir"),Rs("ClassID"),0,1,"")
ClassName = "<a href=""" & m_strFileUrl & """" & LinkTarget & strClass & LoadRemark(Rs("Readme")) & ">" & ClassName & "</a>"
Else
If IsURLRewrite Then
m_strFileUrl = Newasp.ChannelPath & "list_1_" & Rs("ClassID") & Newasp.ChannelHtmlExt
Else
m_strFileUrl = Newasp.ChannelPath & "list.asp?classid=" & Rs("ClassID")
End If
ClassName = "<a href=""" & m_strFileUrl & """" & LinkTarget & strClass & LoadRemark(Rs("Readme")) & ">" & ClassName & "</a>"
End If
End If
strContent = strContent & Replace(frontstr, "*", n) & ClassName
strContent = strContent & "</li>" & vbCrLf
Rs.MoveNext
Else
strContent = strContent & Replace(frontstr, "*", n) & "<a href=""" & Newasp.SiteUrl & Newasp.InstallDir & "support/sitemap.asp"" class=""menubar"">更多分类</a></li>" & vbCrLf
Exit Do
End If
Next
Loop
End If
Set Rs = Nothing
LoadClassMenubar = strContent
End Function
'================================================
'函数名：ReadClassMenubar
'作 用：读取分类菜单栏
'参 数：str ----原字符串
'================================================
Function ReadClassMenubar(str)
Dim strTemp, i
Dim sTempContent, nTempContent, ArrayList
Dim arrTempContent, arrTempContents
strTemp = str
If InStr(strTemp, "{$ReadClassMenubar(") > 0 Then
sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadClassMenubar(", ")}", 1)
nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadClassMenubar(", ")}", 0)
arrTempContents = Split(sTempContent, "|||")
arrTempContent = Split(nTempContent, "|||")
For i = 0 To UBound(arrTempContents)
ArrayList = Split(arrTempContent(i) & ",0,0", ",")
strTemp = Replace(strTemp, arrTempContents(i), LoadClassMenubar(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3), ArrayList(4), ArrayList(5)))
Next
End If
ReadClassMenubar = strTemp
End Function
'================================================
'函数名：LoadCatalog
'作 用：频道目录
'================================================
Function LoadCatalog(ByVal ChannelID, ByVal MaxParent, ByVal MaxChild, ByVal IsChild, ByVal intDefault)
Dim Rs, oRs, SQL, i, strContent, foundsql
Dim m_strMaxParent,m_strMaxChild
Dim m_strTarget,m_strClassName,m_strLinks
ChannelID = Newasp.ChkNumeric(ChannelID)
intDefault = Newasp.ChkNumeric(intDefault)
If intDefault = 0 Then intDefault = 1
If ChannelID = 0 Or ChannelID = 4 Or ChannelID = 9999 Then ChannelID = intDefault
MaxParent = Newasp.ChkNumeric(MaxParent)
If MaxParent > 0 Then m_strMaxParent = "TOP " & MaxParent
MaxChild = Newasp.ChkNumeric(MaxChild)
If MaxChild > 0 Then m_strMaxChild = "TOP " & MaxChild
IsChild = Newasp.ChkNumeric(IsChild)
Newasp.LoadChannel(ChannelID)
SQL = "SELECT " & m_strMaxParent & " C.ClassID,C.rootid,C.depth,C.ClassName,C.ColorModes,C.FontModes,C.Readme,C.Child,C.LinkTarget,C.TurnLink,C.TurnLinkUrl,C.HtmlFileDir,C.UseHtml,B.ChannelDir,B.StopChannel,B.IsCreateHtml,B.HtmlExtName,B.SortDestination FROM [NC_Classify] C inner join [NC_Channel] B On C.ChannelID=B.ChannelID WHERE C.ChannelID = " & CLng(ChannelID) & " And C.depth=0 ORDER BY C.rootid"
Set Rs = Newasp.Execute(SQL)
If Rs.BOF And Rs.EOF Then
Set Rs = Nothing
Exit Function
Else
strContent = ""
Do While Not Rs.EOF
If Rs("LinkTarget") <> 0 Then
m_strTarget = " target=""_blank"""
Else
m_strTarget = ""
End If
m_strClassName = Replace(Rs("ClassName"), " ", " ")
If Rs("TurnLink") <> 0 Then
m_strClassName = "<a href=""" & Rs("TurnLinkUrl") & """" & m_strTarget & LoadRemark(Rs("Readme")) & ">" & m_strClassName & "</a>"
Else
If Rs("IsCreateHtml") <> 0 Then
m_strLinks = Newasp.ChannelDomain & Newasp.ReadDestination(Rs("SortDestination"), Rs("ChannelDir"), "",Rs("HtmlFileDir"),Rs("ClassID"),0,1,"")
m_strClassName = "<a href=""" & m_strLinks & """" & m_strTarget & LoadRemark(Rs("Readme")) & ">" & m_strClassName & "</a>"
Else
If IsURLRewrite Then
m_strLinks = Newasp.ChannelPath & "list_1_" & Rs("ClassID") & Newasp.ChannelHtmlExt
Else
m_strLinks = Newasp.ChannelPath & "list.asp?classid=" & Rs("ClassID")
End If
m_strClassName = "<a href=""" & m_strLinks & """" & m_strTarget & LoadRemark(Rs("Readme")) & ">" & m_strClassName & "</a>"
End If
End If
If IsChild = 0 Then
strContent = strContent & "<li>" & m_strClassName & "</li>" & vbCrLf
Else
strContent = strContent & "<dl>" & vbCrLf
strContent = strContent & "<dt>" & m_strClassName & "</dt>" & vbCrLf
If IsChild = 1 Then
SQL = "And C.rootid=" & Rs("rootid") & " ORDER BY C.orders,C.ClassID"
Else
SQL = "And C.Parentid=" & Rs("classid") & " ORDER BY C.orders,C.ClassID"
End If
SQL = "SELECT " & m_strMaxChild & " C.ClassID,C.rootid,C.depth,C.ClassName,C.ColorModes,C.FontModes,C.Readme,C.Child,C.LinkTarget,C.TurnLink,C.TurnLinkUrl,C.HtmlFileDir,C.UseHtml,B.ChannelDir,B.StopChannel,B.IsCreateHtml,B.HtmlExtName,B.SortDestination FROM [NC_Classify] C inner join [NC_Channel] B On C.ChannelID=B.ChannelID WHERE C.ChannelID = " & CLng(ChannelID) & " And C.depth>0 " & SQL
Set oRs = Newasp.Execute(SQL)
If Not (oRs.BOF And oRs.EOF) Then
Do While Not oRs.EOF
If oRs("LinkTarget") <> 0 Then
m_strTarget = " target=""_blank"""
Else
m_strTarget = ""
End If
m_strClassName = Replace(oRs("ClassName"), " ", " ")
If oRs("TurnLink") <> 0 Then
m_strClassName = "<a href=""" & oRs("TurnLinkUrl") & """" & m_strTarget & LoadRemark(oRs("Readme")) & ">" & m_strClassName & "</a>"
Else
If oRs("IsCreateHtml") <> 0 Then
m_strLinks = Newasp.ChannelDomain & Newasp.ReadDestination(oRs("SortDestination"), oRs("ChannelDir"), "",oRs("HtmlFileDir"),oRs("ClassID"),0,1,"")
m_strClassName = "<a href=""" & m_strLinks & """" & m_strTarget & LoadRemark(Rs("Readme")) & ">" & m_strClassName & "</a>"
Else
If IsURLRewrite Then
m_strLinks = Newasp.ChannelPath & "list_1_" & oRs("ClassID") & Newasp.ChannelHtmlExt
Else
m_strLinks = Newasp.ChannelPath & "list.asp?classid=" & oRs("ClassID")
End If
m_strClassName = "<a href=""" & m_strLinks & """" & m_strTarget & LoadRemark(oRs("Readme")) & ">" & m_strClassName & "</a>"
End If
End If
strContent = strContent & "<dd>" & m_strClassName & "</dd>" & vbCrLf
oRs.MoveNext
Loop
End If
Set oRs = Nothing
strContent = strContent & "</dl>" & vbCrLf
End If
Rs.MoveNext
Loop
End If
Set Rs = Nothing
LoadCatalog = strContent
End Function
'================================================
'函数名：ReadClassMenu
'作 用：读取分类菜单
'参 数：str ----原字符串
'================================================
Function ReadCatalog(ByVal str)
Dim strTemp, i
Dim sTempContent, nTempContent, ArrayList
Dim arrTempContent, arrTempContents
strTemp = str
If InStr(strTemp, "{$ReadCatalog(") > 0 Then
sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadCatalog(", ")}", 1)
nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadCatalog(", ")}", 0)
arrTempContents = Split(sTempContent, "|||")
arrTempContent = Split(nTempContent, "|||")
For i = 0 To UBound(arrTempContents)
ArrayList = Split(arrTempContent(i) & ",0,0", ",")
strTemp = Replace(strTemp, arrTempContents(i), LoadCatalog(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3), ArrayList(4)))
Next
End If
ReadCatalog = strTemp
End Function
'================================================
'函数名：LoadSpecialMenu
'作 用：专题栏目菜单
'================================================
Function LoadSpecialMenu(ByVal ChannelID, ByVal showother, ByVal maxnum, ByVal frontstr)
Dim SQL, Rs
Dim strTemp, SpecialPath,strContext
Dim LinkTarget,ChannelPath,Topicformat,IsCreateHtml
Dim Modules,sModuleName,HtmlExtName,strMaxnum
Dim strChannelDir,strMoreDestination,strChannelDomain
ChannelID = Newasp.ChkNumeric(ChannelID)
showother = Newasp.ChkNumeric(showother)
maxnum = Newasp.ChkNumeric(maxnum)
If maxnum = 0 Then
strMaxnum = vbNullString
Else
strMaxnum = " TOP " & maxnum
End If
If frontstr = "0" Then
frontstr = vbNullString
End If
LoadSpecialMenu = vbNullString
If ChannelID < 1 Or ChannelID = 4 Then
Exit Function
End If
'On Error Resume Next
SQL = "SELECT ChannelID,ChannelDir,StopChannel,ModuleName,Modules,IsCreateHtml,HtmlExtName,MoreDestination,BindDomain,DomainName FROM [NC_Channel] WHERE ChannelID="& ChannelID
Set Rs = Newasp.Execute(SQL)
If Rs.BOF And Rs.EOF Then
Set Rs = Nothing
Exit Function
Else
IsCreateHtml = Rs("IsCreateHtml")
ChannelPath = Rs("ChannelDir")
strChannelDir = Rs("ChannelDir")
Modules = Rs("Modules")
sModuleName = Rs("ModuleName")
strMoreDestination = Rs("MoreDestination")
HtmlExtName = Rs("HtmlExtName")
If Newasp.IsBindDomain = 0 Then
If Rs("BindDomain") = "0" Then
ChannelPath = Trim(Newasp.SiteUrl) & Newasp.InstallDir & ChannelPath
strChannelDomain = Trim(Newasp.SiteUrl) & ""
Else
If Rs("ChannelID") = CLng(Newasp.m_intChannelID) Then
ChannelPath = "/"
strChannelDomain = "/"
Else
ChannelPath = Trim(Rs("DomainName")) & "/"
strChannelDomain = Trim(Rs("DomainName")) & ""
End If
End If
Else
If Rs("BindDomain") = "0" Then
ChannelPath = Trim(Newasp.SiteUrl) & Newasp.InstallDir & ChannelPath
strChannelDomain = Trim(Newasp.SiteUrl) & ""
Else
If Rs("ChannelID") = CLng(Newasp.m_intChannelID) Then
ChannelPath = "/"
strChannelDomain = ""
Else
ChannelPath = Trim(Rs("DomainName")) & "/"
strChannelDomain = Trim(Rs("DomainName")) & ""
End If
End If
End If
End If
Set Rs = Nothing
SQL = "SELECT" & strMaxnum & " SpecialID,SpecialName,Topicformat,Readme,Reopen,SpecialDir,ChangeLink,SpecialUrl FROM [NC_Special] WHERE ChannelID="& ChannelID &" ORDER BY orders,SpecialID"
Set Rs = Newasp.Execute(SQL)
Do While Not Rs.EOF
If Rs("Reopen") <> 0 Then
LinkTarget = " target=""_blank"""
Else
LinkTarget = ""
End If
If Rs("ChangeLink") <> 0 Then
'如果此专题是外部连接启用此连接URL
SpecialPath = Rs("SpecialUrl")
Else
If IsCreateHtml <> 0 Then
SpecialPath = strChannelDomain & Newasp.ReadDestination(strMoreDestination, strChannelDir, "",Rs("SpecialDir")&"/",Rs("SpecialID"),Rs("SpecialID"),1,"special")
'SpecialPath = Replace(SpecialPath, "//", "/")
Else
SpecialPath = ChannelPath & "special.asp?sid=" & Rs("SpecialID")
'SpecialPath = Replace(SpecialPath, "//", "/")
End If
End If
Topicformat = Rs("Topicformat") & ""
If Len(Topicformat) = 0 Then
Topicformat = Rs("SpecialName")
Else
Topicformat = "<span " & Topicformat & ">" & Rs("SpecialName") & "</span>"
End If
'显示JS文件的格式
strTemp = strTemp & "<li>" & frontstr & "<a href=""" & SpecialPath & """" & LinkTarget & LoadRemark(Rs("Readme")) & ">" & Topicformat & "</a></li>" & vbCrLf
Rs.movenext
Loop
Rs.Close
Set Rs = Nothing
'---------------------------------------------//Begin
'热门和推荐菜单连接开始,如果不需要请注释掉此段代码
Dim ArrayModuleName(3)
ArrayModuleName(0) = "推荐" & sModuleName
ArrayModuleName(1) = "热门" & sModuleName
ArrayModuleName(2) = "最新" & sModuleName
ArrayModuleName(3) = "全部更新"
If showother <> 0 Then
If IsCreateHtml <> 0 Then
Dim strPathArray(3)
strPathArray(0) = strChannelDomain & Newasp.ReadDestination(strMoreDestination, strChannelDir, "","best/",1,1,1,"best")
strPathArray(1) = strChannelDomain & Newasp.ReadDestination(strMoreDestination, strChannelDir, "","hot/",3,3,1,"hot")
strPathArray(2) = strChannelDomain & Newasp.ReadDestination(strMoreDestination, strChannelDir, "","new/",0,0,1,"new")
'strPathArray(0) = Replace(strChannelDomain & strPathArray(0), "//", "/")
'strPathArray(1) = Replace(strChannelDomain & strPathArray(1), "//", "/")
'strPathArray(2) = Replace(strChannelDomain & strPathArray(2), "//", "/")
strTemp = strTemp & "<li>" & frontstr & "<a href=""" & strPathArray(0) & """>" & ArrayModuleName(0) & "</a></li>" & vbCrLf
strTemp = strTemp & "<li>" & frontstr & "<a href=""" & strPathArray(1) & """>" & ArrayModuleName(1) & "</a></li>" & vbCrLf
strTemp = strTemp & "<li>" & frontstr & "<a href=""" & strPathArray(2) & """>" & ArrayModuleName(2) & "</a></li>" & vbCrLf
Else
strTemp = strTemp & "<li>" & frontstr & "<a href=""" & ChannelPath & "showbest.asp"">" & ArrayModuleName(0) & "</a></li>" & vbCrLf
strTemp = strTemp & "<li>" & frontstr & "<a href=""" & ChannelPath & "showhot.asp"">" & ArrayModuleName(1) & "</a></li>" & vbCrLf
strTemp = strTemp & "<li>" & frontstr & "<a href=""" & ChannelPath & "shownew.asp"">" & ArrayModuleName(2) & "</a></li>" & vbCrLf
End If
If Modules = 2 Then
strTemp = strTemp & "<li>" & frontstr & "<a href=""" & ChannelPath & "showtype.asp"">" & ArrayModuleName(3) & "</a></li>" & vbCrLf
End If
End If
LoadSpecialMenu = strTemp
End Function
'================================================
'函数名：ReadClassMenubar
'作 用：读取专题菜单
'参 数：str ----原字符串
'================================================
Function ReadSpecialMenu(str)
Dim strTemp, i
Dim sTempContent, nTempContent, ArrayList
Dim arrTempContent, arrTempContents
strTemp = str
If InStr(strTemp, "{$ReadSpecialMenu(") > 0 Then
sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadSpecialMenu(", ")}", 1)
nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadSpecialMenu(", ")}", 0)
arrTempContents = Split(sTempContent, "|||")
arrTempContent = Split(nTempContent, "|||")
For i = 0 To UBound(arrTempContents)
ArrayList = Split(arrTempContent(i) & ",0,0,0", ",")
strTemp = Replace(strTemp, arrTempContents(i), LoadSpecialMenu(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3)))
Next
End If
ReadSpecialMenu = strTemp
End Function
Sub isWeb_Query()
Dim keyword
keyword = Replace(Request("keyword"), "'", "")
Response.Write "<div id=""Seardata"" style=""height:500px;"">"
Response.Write "<iframe name=""WebSearch"" id=""WebSearch"" frameborder=""0"" width=""100%"" height=""100%"" scrolling=""auto"" src=""http://so.newasp.net/search.asp?word="&keyword&"""></iframe>"
Response.Write "</div>"
Response.Write "<script language=""JavaScript"">" & vbNewLine
Response.Write "<!--" & vbNewLine
Response.Write "var obj=parent.document.getElementById(""searchmain"");" & vbNewLine
Response.Write "var SearchData = document.getElementById(""Seardata"");" & vbNewLine
Response.Write "obj.style.height=(parent.document.getElementById(""searchmain"").offsetHeight)+'px';" & vbNewLine
Response.Write "obj.innerHTML = SearchData.innerHTML;" & vbNewLine
Response.Write "//-->" & vbNewLine
Response.Write "</script>" & vbNewLine
End Sub
Function SearchObj()
Dim strTemp,keyword
keyword = Replace(Request("keyword"), "'", "")
strTemp = "<script language=""JavaScript"">" & vbNewLine
strTemp = strTemp & "<!--" & vbNewLine
strTemp = strTemp & "var ToUrl=""search.asp?act=isweb&keyword=" & keyword & "&s=1"";" & vbNewLine
strTemp = strTemp & "var HFrame = document.getElementById(""hiddenquery"")" & vbNewLine
strTemp = strTemp & "var obj = document.getElementById(""searchmain"");" & vbNewLine
strTemp = strTemp & "if (HFrame){" & vbNewLine
strTemp = strTemp & " HFrame.src=ToUrl;" & vbNewLine
strTemp = strTemp & "}" & vbNewLine
strTemp = strTemp & "if (obj){" & vbNewLine
strTemp = strTemp & " obj.style.height=""1024"";" & vbNewLine
strTemp = strTemp & " obj.style.display=='none'" & vbNewLine
strTemp = strTemp & "}" & vbNewLine
strTemp = strTemp & "//-->" & vbNewLine
strTemp = strTemp & "</script>" & vbNewLine
SearchObj = strTemp
End Function
Function htmlmorepage(page,Pcount,totalnumber,maxperpage,strLink,ExtName,ListName)
Dim strTemp, b, e
Dim pagestart,pageend
Dim i, ii, n, p, s
b = 5 : e = 5 : s = "五"
pagestart = page - 50
pageend = page + 50
If pagestart < 1 Then
pagestart = 2
End If
If pageend > Pcount Then
pageend = Pcount
End If
If (page - 1) Mod b = 0 Then
p = (page-1) \ b
Else
p = ((page-1) - (page-1) Mod b) \ b
End If
If totalnumber Mod maxperpage = 0 Then
n = totalnumber \ maxperpage
Else
n = (totalnumber - totalnumber Mod maxperpage) \ maxperpage + 1
End If
strTemp = "<table border=""0"" cellpadding=""0"" cellspacing=""1"" class=""Tableborder5"">" & vbNewLine
strTemp = strTemp & " <form method=""post"">" & vbNewLine
strTemp = strTemp & " <tr align=""center"">" & vbNewLine
strTemp = strTemp & " <td class=""tabletitle1"" title=""" & ListName & """> " & ListName & " </td>" & vbNewLine
strTemp = strTemp & " <td class=""tabletitle1"" title=""总数""> " & totalnumber & " </td>" & vbNewLine
strTemp = strTemp & " <td class=""tabletitle1"" title=""每页""> " & maxperpage & " </td>" & vbNewLine
strTemp = strTemp & " <td class=""tabletitle1"" title=""页次""> " & page & "/" & Pcount & "页 </td>" & vbNewLine
If page = 1 Then
strTemp = strTemp & " <td class=""tablebody1""> 首页 </td>" & vbNewLine
Else
strTemp = strTemp & " <td class=""tablebody1""> <a href=""" & strLink & "001" & ExtName & """ title=""首页"">首页</a> </td>" & vbNewLine
End If
If p * b > 0 Then
strTemp = strTemp & " <td class=""tablebody1""> <a href=""" & strLink & Newasp.Supplemental(p*b,3) & ExtName & """ title=""上" & s & "页"">上" & s & "页</a> </td>" & vbNewLine
Else
'strTemp = strTemp & " <td class=""tablebody1""> 上一页 </td>" & vbNewLine
End If
For i = p * b + 1 To p * b + e
If i = page Then
strTemp = strTemp & " <td class=""tablebody2""> <font class=""normalTextSmall""><u><b>" & i & "</b></u></font> </td>" & vbNewLine
Else
strTemp = strTemp & " <td class=""tablebody1""> <a href=""" & strLink & Newasp.Supplemental(i,3) & ExtName & """ title=""第" & i & "页"">" & i & "</a> </td>" & vbNewLine
End if
If i = n Then Exit For
Next
If i < n Then
strTemp = strTemp & " <td class=""tablebody1""> <a href=""" & strLink & Newasp.Supplemental(i,3) & ExtName & """ title=""下" & s & "页"">下" & s & "页</a> <td>" & vbNewLine
Else
'strTemp = strTemp & " <td class=""tablebody1""> 下一页 <td>" & vbNewLine
End If
If page = n Then
strTemp = strTemp & " <td class=""tablebody1""> 尾页 </td>" & vbNewLine
Else
strTemp = strTemp & " <td class=""tablebody1""> <a href=""" & strLink & Newasp.Supplemental(n,3) & ExtName & """ title=""尾页"">尾页</a> </td>" & vbNewLine
End If
strTemp = strTemp & " <td class=""tabletitle1"" title=""转到""> GO </td>" & vbNewLine
strTemp = strTemp & " <td class=""tablebody1""><select class=""PageInput"" name=""page"" size=""1"" onchange=""javascript:window.location=this.options[this.selectedIndex].value;"">" & vbNewLine
If pagestart > 0 Then
For ii = pagestart To pageend'Pcount
If ii = page Then
strTemp = strTemp & "<option value=""" & strLink & Newasp.Supplemental(ii,3) & ExtName & """ selected>第" & ii & "页</option>"
Else
strTemp = strTemp & "<option value=""" & strLink & Newasp.Supplemental(ii,3) & ExtName & """>第" & ii & "页</option>"
End If
Next
End If
strTemp = strTemp & "</select></td>" & vbNewLine
strTemp = strTemp & " </tr>" & vbNewLine
strTemp = strTemp & " </form>" & vbNewLine
strTemp = strTemp & "</table>" & vbNewLine
htmlmorepage = strTemp
End Function
Function showlistpage(page, Pcount, totalnumber, maxperpage, strLink, ListName)
Dim strTemp, sName
Dim i, n, p, s, b, e
b = 5
e = 5
s = "五"
sName = ""
If (page - 1) Mod b = 0 Then
p = (page -1) \ b
Else
p = ((page -1) - (page -1) Mod b) \ b
End If
If totalnumber Mod maxperpage = 0 Then
n = totalnumber \ maxperpage
Else
n = (totalnumber - totalnumber Mod maxperpage) \ maxperpage + 1
End If
If IsURLRewrite Then
If InStr(strLink,"classid") > 0 And InStr(strLink,"word") = 0 Then
strLink = "_" & Trim(Request("classid")) & Newasp.HtmlExtName
sName = "list_"
Else
sName = "?page="
End If
Else
sName = "?page="
End If
strTemp = "<table border=""0"" cellpadding=""0"" cellspacing=""1"" class=""Tableborder5"">" & vbNewLine
If IsURLRewrite Then
strTemp = strTemp & " <form method=""post"" name=""formPages"">" & vbNewLine
Else
strTemp = strTemp & " <form method=""post"" action=""?pcount="& Pcount & strLink & """>" & vbNewLine
End If
strTemp = strTemp & " <tr align=""center"">" & vbNewLine
strTemp = strTemp & " <td class=""tabletitle1"" title=""" & ListName & """> " & ListName & " </td>" & vbNewLine
strTemp = strTemp & " <td class=""tabletitle1"" title=""总数""> " & totalnumber & " </td>" & vbNewLine
strTemp = strTemp & " <td class=""tabletitle1"" title=""每页""> " & maxperpage & " </td>" & vbNewLine
strTemp = strTemp & " <td class=""tabletitle1"" title=""页次""> " & page & "/" & Pcount & "页 </td>" & vbNewLine
If page = 1 Then
strTemp = strTemp & " <td class=""tablebody1""> <img border=""0"" src=""" & ImagePath & "First.gif"" alt=""首页"" /> </td>" & vbNewLine
Else
strTemp = strTemp & " <td class=""tablebody1""> <a href=""" & sName & "1" & strLink & """ title=""首页""><img border=""0"" src=""" & ImagePath & "First.gif"" /></a> </td>" & vbNewLine
End If
If p * b > 0 Then
strTemp = strTemp & " <td class=""tablebody1""> <a href=""" & sName & p * b & strLink & """ title=""上" & s & "页""><img border=""0"" src=""" & ImagePath & "Previous.gif"" /></a> </td>" & vbNewLine
Else
'strTemp = strTemp & " <td class=""tablebody1""> <img border=""0"" src=""" & ImagePath & "Previous.gif"" /> </td>" & vbNewLine
End If
For i = p * b + 1 To p * b + e
If i = page Then
strTemp = strTemp & " <td class=""tablebody2""> <font class=""normalTextSmall""><u><b>" & i & "</b></u></font> </td>" & vbNewLine
Else
strTemp = strTemp & " <td class=""tablebody1""> <a href=""" & sName & i & strLink & """ title=""第" & i & "页"">" & i & "</a> </td>" & vbNewLine
End If
If i = n Then Exit For
Next
If i < n Then
strTemp = strTemp & " <td class=""tablebody1""> <a href=""" & sName & i & strLink & """ title=""下" & s & "页""><img border=""0"" src=""" & ImagePath & "Next.gif"" /></a> <td>" & vbNewLine
Else
'strTemp = strTemp & " <td class=""tablebody1""> <img border=""0"" src=""" & ImagePath & "Next.gif"" /> <td>" & vbNewLine
End If
If page = n Then
strTemp = strTemp & " <td class=""tablebody1""> <img border=""0"" src=""" & ImagePath & "Last.gif"" alt=""尾页"" /> </td>" & vbNewLine
Else
strTemp = strTemp & " <td class=""tablebody1""> <a href=""" & sName & n & strLink & """ title=""尾页""><img border=""0"" src=""" & ImagePath & "Last.gif"" /></a> </td>" & vbNewLine
End If
strTemp = strTemp & " <td class=""tablebody1""><input class=""PageInput"" type=""text"" name=""page"" size=""1"" maxlength=""10"" value=""" & page & """></td>" & vbNewLine
If IsURLRewrite Then
strTemp = strTemp & " <td class=""tablebody1""><input type=""button"" value=""Go"" name=""B2"" class=""button"" onclick=""javascript:window.location='" & sName & "'+formPages.page.value+'"& strLink & "';"" /></td>" & vbNewLine
Else
strTemp = strTemp & " <td class=""tablebody1""><input type=""submit"" value=""Go"" name=""submit"" class=""button"" /></td>" & vbNewLine
End If
strTemp = strTemp & " </tr>" & vbNewLine
strTemp = strTemp & " </form>" & vbNewLine
strTemp = strTemp & "</table>" & vbNewLine
showlistpage = strTemp
End Function
Function CurrentNum(ByVal num)
If Len(num) = 1 Then
CurrentNum = CStr("00")
Exit Function
ElseIf Len(num) = 2 Then
CurrentNum = CStr("0")
Exit Function
Else
CurrentNum = ""
End If
End Function
Function AdsReplace(ByVal strHTML,ByVal strCode,ByVal istop)
Dim ArrayAdsCode
If istop = 0 Then
ArrayAdsCode = Split(strCode & "|||||||||", "|||")
strHTML = Replace(strHTML, "{$AdsCode1}", ArrayAdsCode(0))
strHTML = Replace(strHTML, "{$AdsCode2}", ArrayAdsCode(1))
strHTML = Replace(strHTML, "{$AdsCode3}", ArrayAdsCode(2))
strHTML = Replace(strHTML, "{$AdsCode4}", ArrayAdsCode(3))
strHTML = Replace(strHTML, "{$AdsCode5}", ArrayAdsCode(4))
Else
strHTML = Replace(strHTML, "{$AdsCode1}", "")
strHTML = Replace(strHTML, "{$AdsCode2}", "")
strHTML = Replace(strHTML, "{$AdsCode3}", "")
strHTML = Replace(strHTML, "{$AdsCode4}", "")
strHTML = Replace(strHTML, "{$AdsCode5}", "")
End If
strHTML = Replace(strHTML, "{$AdsCode}", vbNullString)
AdsReplace = strHTML
End Function
Function showhtmlpage(page,Pcount,totalnumber,maxperpage,strFilename,ListName)
Dim strTemp, b, e
Dim pagestart,pageend
Dim i, ii, n, p, s
b = 5 : e = 5 : s = "五"
pagestart = page - 50
pageend = page + 50
If pagestart < 1 Then
pagestart = 2
End If
If pageend > Pcount Then
pageend = Pcount
End If
If (page - 1) Mod b = 0 Then
p = (page-1) \ b
Else
p = ((page-1) - (page-1) Mod b) \ b
End If
If totalnumber Mod maxperpage = 0 Then
n = totalnumber \ maxperpage
Else
n = (totalnumber - totalnumber Mod maxperpage) \ maxperpage + 1
End If
strTemp = "<table border=""0"" cellpadding=""0"" cellspacing=""1"" class=""Tableborder5"">" & vbNewLine
strTemp = strTemp & " <form method=""post"">" & vbNewLine
strTemp = strTemp & " <tr align=""center"">" & vbNewLine
strTemp = strTemp & " <td class=""tabletitle1"" title=""" & ListName & """> " & ListName & " </td>" & vbNewLine
strTemp = strTemp & " <td class=""tabletitle1"" title=""总数""> " & totalnumber & " </td>" & vbNewLine
strTemp = strTemp & " <td class=""tabletitle1"" title=""每页""> " & maxperpage & " </td>" & vbNewLine
strTemp = strTemp & " <td class=""tabletitle1"" title=""页次""> " & page & "/" & Pcount & "页 </td>" & vbNewLine
If page = 1 Then
strTemp = strTemp & " <td class=""tablebody1""> <img border=""0"" src=""" & ImagePath & "First.gif"" alt=""首页"" /> </td>" & vbNewLine
Else
strTemp = strTemp & " <td class=""tablebody1""> <a href=""" & Replace(strFilename, "[page]", "1", 1, -1, 1) & """ title=""首页""><img border=""0"" src=""" & ImagePath & "First.gif"" /></a> </td>" & vbNewLine
End If
If p * b > 0 Then
strTemp = strTemp & " <td class=""tablebody1""> <a href=""" & Replace(strFilename, "[page]", p*b, 1, -1, 1) & """ title=""上" & s & "页""><img border=""0"" src=""" & ImagePath & "Previous.gif"" /></a> </td>" & vbNewLine
Else
'strTemp = strTemp & " <td class=""tablebody1""> <img border=""0"" src=""" & ImagePath & "Previous.gif"" /> </td>" & vbNewLine
End If
For i = p * b + 1 To p * b + e
If i = page Then
strTemp = strTemp & " <td class=""tablebody2""> <font class=""normalTextSmall""><u><b>" & i & "</b></u></font> </td>" & vbNewLine
Else
strTemp = strTemp & " <td class=""tablebody1""> <a href=""" & Replace(strFilename, "[page]", i, 1, -1, 1) & """ title=""第" & i & "页"">" & i & "</a> </td>" & vbNewLine
End if
If i = n Then Exit For
Next
If i < n Then
strTemp = strTemp & " <td class=""tablebody1""> <a href=""" & Replace(strFilename, "[page]", i, 1, -1, 1) & """ title=""下" & s & "页""><img border=""0"" src=""" & ImagePath & "Next.gif"" /></a> <td>" & vbNewLine
Else
'strTemp = strTemp & " <td class=""tablebody1""> <img border=""0"" src=""" & ImagePath & "Next.gif"" /> <td>" & vbNewLine
End If
If page = n Then
strTemp = strTemp & " <td class=""tablebody1""> <img border=""0"" src=""" & ImagePath & "Last.gif"" alt=""尾页"" /> </td>" & vbNewLine
Else
strTemp = strTemp & " <td class=""tablebody1""> <a href=""" & Replace(strFilename, "[page]", n, 1, -1, 1) & """ title=""尾页""><img border=""0"" src=""" & ImagePath & "Last.gif"" /></a> </td>" & vbNewLine
End If
strTemp = strTemp & " <td class=""tabletitle1"" title=""转到""> GO </td>" & vbNewLine
strTemp = strTemp & " <td class=""tablebody1""><select class=""PageInput"" name=""page"" size=""1"" onchange=""javascript:window.location=this.options[this.selectedIndex].value;"">" & vbNewLine
strTemp = strTemp & " <option value=""" & Replace(strFilename, "[page]", "1", 1, -1, 1) & """>第1页</option>"
If pagestart > 1 Then
For ii = pagestart To pageend'Pcount
If ii = page Then
strTemp = strTemp & "<option value=""" & Replace(strFilename, "[page]", ii, 1, -1, 1) & """ selected>第" & ii & "页</option>"
Else
strTemp = strTemp & "<option value=""" & Replace(strFilename, "[page]", ii, 1, -1, 1) & """>第" & ii & "页</option>"
End If
Next
End If
strTemp = strTemp & "</select></td>" & vbNewLine
strTemp = strTemp & " </tr>" & vbNewLine
strTemp = strTemp & " </form>" & vbNewLine
strTemp = strTemp & "</table>" & vbNewLine
showhtmlpage = strTemp
End Function
%>