📄 cl_function_public.asp
字号:
Do While Not rsComment.Eof
sTemp=sTemp & "<li>"&Cl.GetUserGroupName(rsComment("UserGroupID"))&"『"
sTemp=sTemp & "<a href=""" & Cl.WebDir & "User/Info.asp?UserName=" & rsComment("UserName") & """><font color=""blue"">" & rsComment("UserName") & "</font></a>"
sTemp=sTemp & "』于" & rsComment("CommentTime") & "发表评论："
'if Cl.UserGroupID=1 then
' if rsComment("Status")=1 then
' sTemp=sTemp & " [<a href="""&Cl.WebDir&"Comment/Property.asp?Action=Check&Type=N&CommentID="&rsComment("CommentID")&""">取消</a>]"
' else
' sTemp=sTemp & " [<a href="""&Cl.WebDir&"Comment/Property.asp?Action=Check&Type=P&CommentID="&rsComment("CommentID")&"""><font color=""#FF0033"">审核</font></a>]"
' end if
'sTemp=sTemp & " [<a href="""&Cl.WebDir&"Comment/Property.asp?Action=Check&Type=M&CommentID="&rsComment("CommentID")&""">修改</a>]"
' sTemp=sTemp & " [<a href="""&Cl.WebDir&"Comment/Property.asp?Action=Check&Type=D&CommentID="&rsComment("CommentID")&""">删除</a>]"
'end if
sTemp=sTemp & "<br />"
sTemp=sTemp & " " & ClUbb.UbbCode(rsComment("CommentContent")) & "<br />"
sTemp=sTemp & "</li>"
rsComment.MoveNext
Loop
rsComment.close:set rsComment=Nothing
Set ClUbb=Nothing
sTemp=sTemp & "</ul><ul><li style=""text-align:right;"">"
'if NoPassedNum>0 then
'sTemp=sTemp & "待审评论 <b><font color=""red"">"&NoPassedNum&"</font></b> 条，请管理员 <a href="""&Cl.WebDir&"User/Login.asp""><font color=""#FF0033"">登录</font></a> 后操作！"
'end if
sTemp=sTemp & " <a href="""&Cl.WebDir&"Comment/List.asp?ChannelID="&sChannelID&"&InfoID=" & InfoID & """>查看所有评论</a></li>"
sTemp=sTemp & "</ul></div>"
ShowComment=sTemp
end if
sqlComment=Empty
End Function
'=======================================================================
'显示相关信息
'ShowCorrelative(sChannelID,sInfoID,TopNum,TitleLen,ShowHits)
' sChannelID
' sInfoID
' TopNum ------ (文章数量)
' TitleLen ------ (标题字符数)
' ShowHits ------ (是否显示点击数，True为是)
'=======================================================================
Function ShowCorrelative(Byval sChannelID,ByVal sInfoID,Byval TopNum,Byval TitleLen,Byval ShowHits)
Dim Rs,SQL,SQLC,LinkUrl,sTemp
Dim KeywordStr,arrKey,i
'On Error Resume Next
sChannelID = CLng(sChannelID)
sInfoID = CLng(sInfoID) : ShowHits = CBool(ShowHits)
TopNum = CLng(TopNum) : TitleLen = CLng(TitleLen)
if Err then Err.Clear : ShowCorrelative = "ShowCorrelative参数错误。" : Exit Function
On Error GoTo 0
Cl.Load_ChannelSetting(ChannelID)
Select Case Cint(Cl.Channel.selectSingleNode("@moduleid").text)
Case 1
SQL = "Select Keyword from Cl_Article Where InfoID=" & InfoID
SQLC = "InfoID,ChannelID,ChannelDir,Title,UpdateTime,Hits,IsHtml,HtmlFileUrl From Cl_Article"
Case 2
SQL = "Select Keyword from Cl_Soft Where InfoID=" & InfoID
SQLC = "InfoID,ChannelID,ChannelDir,SoftName,UpdateTime,Hits,IsHtml,HtmlFileUrl From Cl_Soft"
Case 3
SQL = "Select Keyword from Cl_Photo Where InfoID=" & InfoID
SQLC = "InfoID,ChannelID,ChannelDir,PhotoName,UpdateTime,Hits,IsHtml,HtmlFileUrl From Cl_Photo"
Case 4
SQL = "Select Keyword from Cl_Movie Where InfoID=" & InfoID
SQLC = "InfoID,ChannelID,ChannelDir,MovieName,UpdateTime,Hits,IsHtml,HtmlFileUrl From Cl_Movie"
Case 5
SQL = "Select Keyword from Cl_Product Where InfoID=" & InfoID
SQLC = "InfoID,ChannelID,ChannelDir,ProductName,UpdateTime,Hits,IsHtml,HtmlFileUrl From Cl_Product"
Case Else
Exit Function
End Select
Set Rs = Cl.Execute(SQL)
If Rs.Eof Then
Set Rs = Nothing : Exit Function
End If
KeywordStr = rs(0)
Set Rs = Nothing
if TopNum>0 then
SQL = "select top " & TopNum & " "
else
SQL = "Select Top 5 "
end if
if InStr(KeywordStr,"|")>1 then
arrKey = Split(KeywordStr,"|")
KeywordStr="((Keyword like '%" & arrKey(0) & "%')"
for i=1 to ubound(arrKey)
KeywordStr=KeywordStr & " or (Keyword like '%" & arrKey(i) & "%')"
next
KeywordStr=KeywordStr & ")"
else
KeywordStr="(Keyword like '%" & KeywordStr & "%')"
end if
SQL=SQL & SQLC & " Where ChannelID="&sChannelID&" and Deleted="&FalseType&" and Status=1 and " & KeywordStr & " and InfoID<>" & InfoID & " Order by UpdateTime desc,InfoID desc"
Set Rs = Cl.Execute(SQL)
sTemp = "<ul>"
if Rs.bof and Rs.Eof then
sTemp = sTemp & "<li>当前没有记录！</li>"
else
do while not Rs.eof
if Rs(6)=True then
LinkUrl=Cl.WebDir & Rs(7)
else
LinkUrl=Cl.WebDir & Rs(2) & "/ShowInfo.asp?InfoID="&Rs(0)
end if
sTemp = sTemp & "<li><span class='title'><a href='" & LinkUrl & "' title='"&Rs(3)&"' target='_blank'>" & Cl.GotTopic(Rs(3),TitleLen) & "</a></span>"
if ShowHits=True then
sTemp = sTemp & "(<span class='hits'>" & Rs(5) & "</span>)"
end if
sTemp = sTemp & "</li>"
Rs.movenext
loop
end if
Rs.close:set Rs=Nothing
ShowCorrelative = sTemp & "</ul>"
End Function
'显示所有栏目（树形目录效果）(预留)
Function ShowClass_Tree(Byval sChannelID)
dim rsClass,sqlClass,tmpDepth,i,j
sqlClass="select ClassID,ClassName,ParentPath,ClassDir,ParentDir,Depth,NextID,IsOuter,LinkUrl,Child From Cl_Class where ChannelID="&Cint(sChannelID)&" and order by RootID,OrderID"
set rsClass=Cl.Execute(sqlClass)
if rsClass.bof and rsClass.eof then
ShowClass_Tree="没有任何栏目"
rsClass.close:set rsClass=Nothing : Exit Function
End if
dim arrShowLine(20),strClassTree
for i=0 to ubound(arrShowLine)
arrShowLine(i)=False
next
sqlClass = rsClass.GetRows(-1)
rsClass.close:set rsClass=Nothing
For i=0 to Ubound(sqlClass,2)
tmpDepth=sqlClass(5,i)
if sqlClass(6,i)>0 then
arrShowLine(tmpDepth)=True
else
arrShowLine(tmpDepth)=False
end if
if tmpDepth>0 then
for j=1 to tmpDepth
if j=tmpDepth then
if sqlClass(6,i)>0 then
strClassTree=strClassTree & "<img src="""&Cl.WebDir&"images/Tree/line1.gif"" width=""17"" height=""16"" valign=""abvmiddle"" alt="""" />"
else
strClassTree=strClassTree & "<img src="""&Cl.WebDir&"images/Tree/line2.gif"" width=""17"" height=""16"" valign=""abvmiddle"" alt="""" />"
end if
else
if arrShowLine(j)=True then
strClassTree=strClassTree & "<img src="""&Cl.WebDir&"images/Tree/line3.gif"" width=""17"" height=""16"" valign=""abvmiddle"" alt="""" />"
else
strClassTree=strClassTree & "<img src="""&Cl.WebDir&"images/Tree/line4.gif"" width=""17"" height=""16"" valign=""abvmiddle"" alt="""" />"
end if
end if
next
end if
if sqlClass(9,i)>0 then
strClassTree=strClassTree & "<img src="""&Cl.WebDir&"images/Tree/folder4.gif"" width=""15"" height=""15"" valign=""abvmiddle"" alt="""" />"
else
strClassTree=strClassTree & "<img src="""&Cl.WebDir&"images/Tree/folder3.gif"" width=""15"" height=""15"" valign=""abvmiddle"" alt="""" />"
end if
if sqlClass(7)=1 then
strClassTree=strClassTree & "<a href=""" & sqlClass(8,i) & """ target=""_blank"">"
else
strClassTree=strClassTree & "<a href=""" & Cl.WebDir & Cl.GetClassUrl(Cl.Channel.selectSingleNode("@createpathtype").text,Cl.HtmlDir,Cl.Channel.selectSingleNode("@channeldir").text,sqlClass(2,i),sqlClass(0,i),sqlClass(4,i),sqlClass(3,i),Cl.Channel.selectSingleNode("@iscreatehtml").text,Cl.Channel.selectSingleNode("@createfileext").text) & """>"
end if
if sqlClass(5,i)=0 then
strClassTree=strClassTree & "<b>" & sqlClass(1,i) & "</b>"
else
strClassTree=strClassTree & sqlClass(1,i)
end if
strClassTree=strClassTree & "</a>"
if sqlClass(9,i)>0 then
strClassTree=strClassTree & "（" & sqlClass(9,i) & "）"
end if
strClassTree=strClassTree & "<br />"
Next
ShowClass_Tree=strClassTree
sqlClass=Empty
End Function
'===============================================================
'显示当前栏目的下一级子栏目
'过程：ShowChildClass(sChannelID,sClassID,sCol,ShowType)
'参数：
' sChannelID ----- 频道ID
' sClassID-----------栏目ID
' sTopNum ------ 几列换行(当ShowType大于1时生效)
' ShowType ------ 显示方式(0,<li>每个栏目一行)
'===============================================================
Function ShowChildClass(Byval sChannelID,Byval sClassID,Byval sTopNum,Byval ShowType)
Dim Node,Rs,n,sTemp
sChannelID = Cl.GetClng(sChannelID)
sClassID = Cl.GetClng(sClassID)
sTopNum = Cl.GetClng(sTopNum)
Set Rs = Application(Cl.CacheName & "_classlist").DocumentElement.selectNodes("class[@channelid="&sChannelID&"][@parentid="&sClassID&"]")
if Rs Is Nothing then
ShowChildClass="<li>没有子栏目</li>" : Exit Function
End if
n=0 : sTemp="<ul>"
For Each Node In Rs
n=n+1
sTemp=sTemp & "<li><a href=""" & Node.selectSingleNode("@linkurl").text & """>" & Node.selectSingleNode("@classname").text & "</a>"
if CLng(Node.selectSingleNode("@child").text)>0 then sTemp=sTemp & "(" & Node.selectSingleNode("@child").text & ")"
sTemp=sTemp & "</li>"
If n>=sTopNum Then Exit For
Next
sTemp=sTemp & "</ul>"
ShowChildClass=sTemp
End Function
'===============================================================
'显示栏目导航
'过程：ShowClassNavigation(sChannelID,sClassID,sCol)
'参数：
' sChannelID ----- 频道ID
' sClassID-----------栏目ID
' sCol ------ 几列换行
'===============================================================
Function ShowClassNavigation(Byval sChannelID,Byval sClassID,Byval sCol)
Dim SQL,Rs,sTemp,PrevRootID,i,n
sChannelID=Cl.GetClng(sChannelID)
sClassID=Cl.GetClng(sClassID)
sCol=Cl.GetClng(sCol)
if sClassID>0 then
Set Rs = Application(Cl.CacheName & "_classlist").DocumentElement.selectNodes("class[@channelid="&sChannelID&"][@classid="&sClassID&"]")
Else
Set Rs = Application(Cl.CacheName & "_classlist").DocumentElement.selectNodes("class[@channelid="&sChannelID&"][@depth=0]")
End if
if Rs Is Nothing then
ShowChildClass="<li>没有任何栏目</li>" : Exit Function
End If
if sCol=0 then sCol=6
Dim Node, tNode
sTemp="<ul>"
For Each Node In Rs
sTemp=sTemp & "<li><span class=""parentclass"">【<a href=""" & Node.selectSingleNode("@linkurl").text & """>" & Node.selectSingleNode("@classname").text & "</a>】</span>"
sTemp=sTemp & "<span class=""childclass"">"
n=1
For Each tNode In Application(Cl.CacheName & "_classlist").DocumentElement.selectNodes("class[@parentid="&Node.selectSingleNode("@classid").text&"]")
sTemp=sTemp & "<a href=""" & tNode.selectSingleNode("@linkurl").text & """>" & tNode.selectSingleNode("@classname").text & "</a> "
if n>=sCol then
n=1 : sTemp=sTemp & "</span></li><li><span class=""parentclass""> </span><span class=""childclass"">"
else
n=n+1
end if
Next
sTemp=sTemp & "</span></li>"
Next
ShowClassNavigation = sTemp & "</ul>"
End Function
'===============================================================
'过程名：ShowSearchForm(sChannelID,ShowType)
'参 数：
' sChannelID ---- 频道ID
' ShowType ---- 显示方式 1简,2标,3(带栏目),4(带专题),5(带栏目+专题)
'===============================================================
Function ShowSearchForm(Byval sChannelID,Byval ShowType)
sChannelID = Cl.GetClng(sChannelID)
ShowType = Cl.GetClng(ShowType)
Cl.Load_ChannelSetting(sChannelID)
Dim sTemp
'sTemp="<div class=""searchform"">"
sTemp=sTemp & "<form action=""" & Cl.WebDir & Cl.Channel.selectSingleNode("@channeldir").text & "/ShowSearch.asp"" method=""post"" name=""SearchForm"" id=""SearchForm"">"
'sTemp=sTemp & "<ul><li>"
Select Case ShowType
Case 0, 1
sTemp=sTemp & "<input type=""hidden"" name=""field"" value=""Title"" />"
Case 2
sTemp=sTemp & ShowSearchField(Cl.Channel.selectSingleNode("@moduleid").text,Cl.Channel.selectSingleNode("@channelitemname").text)
Case 3
sTemp=sTemp & ShowSearchField(Cl.Channel.selectSingleNode("@moduleid").text,Cl.Channel.selectSingleNode("@channelitemname").text)
sTemp=sTemp & " <select name=""ClassID""><option value="""">所有栏目</option>"
sTemp=sTemp & ShowClass_Option(sChannelID,0,2,3) & "</select>"
Case 4
sTemp=sTemp & ShowSearchField(Cl.Channel.selectSingleNode("@moduleid").text,Cl.Channel.selectSingleNode("@channelitemname").text)
sTemp=sTemp & " <select name=""SpecialID"">"
sTemp=sTemp & ShowSpecial_Option(sChannelID,0,1) & "</select>"
Case 5
sTemp=sTemp & ShowSearchField(Cl.Channel.selectSingleNode("@moduleid").text,Cl.Channel.selectSingleNode("@channelitemname").text)
sTemp=sTemp & " <select name=""ClassID""><option value="""">所有栏目</option>"
sTemp=sTemp & ShowClass_Option(sChannelID,0,2,3) & "</select>"
sTemp=sTemp & " <select name=""SpecialID"">"
sTemp=sTemp & ShowSpecial_Option(sChannelID,0,1) & "</select>"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -