📄 cl_function_public.asp
字号:
sTemp=sTemp&" | "
end if
Next
end if
ShowRootSpecial=sTemp
sqlSpecial=Empty : sTemp=Empty
rsSpecial.Close : Set rsSpecial=Nothing
End Function
Function ShowSpecial_Option(Byval sChannelID,Byval sSpecialID,Byval ShowType)
dim sqlSpecial,rsSpecial,sTemp,i
ShowType = Clng(ShowType)
sChannelID = Clng(sChannelID)
sTemp = "<option value=""0"""
if sSpecialID="0" then sTemp = sTemp & " selected"
sTemp = sTemp & ">不指定专题</option>"
sqlSpecial = "select SpecialID,SpecialName,AddGroup from Cl_Special where ChannelID=-1 "
if sChannelID > 0 then sqlSpecial = sqlSpecial & " or ChannelID="&sChannelID&""
sqlSpecial = sqlSpecial & " order by OrderID"
set rsSpecial=Cl.Execute(sqlSpecial)
if Not (rsSpecial.bof and rsSpecial.eof) then
sqlSpecial=rsSpecial.GetRows(-1)
for i=0 to Ubound(sqlSpecial,2)
if Cl.ChkUserGroupID(sqlSpecial(2,i),Cl.UserGroupID) or ShowType=1 then
if Instr(","&sSpecialID&",",","&sqlSpecial(0,i)&",")>0 then
sTemp = sTemp & "<option value=""" & sqlSpecial(0,i) & """ selected>" & sqlSpecial(1,i) & "</option>"
else
sTemp = sTemp & "<option value=""" & sqlSpecial(0,i) & """>" & sqlSpecial(1,i) & "</option>"
end if
end if
Next
end if
Set rsSpecial = Nothing
ShowSpecial_Option = sTemp
sqlSpecial=Empty
End Function
'=================================================
'显示专题名称:ShowSpecial(sChannelID,TopNum)
'sChannelID ----- (频道ID，为区分链接)
'TopNum ----- (最多显示多少个专题名称)
'=================================================
Function ShowSpecial(Byval sChannelID,Byval TopNum)
Dim Sql, Rs, i, sTemp
TopNum = Cl.GetClng(TopNum)
sChannelID = Cl.GetClng(sChannelID)
if TopNum = 0 then TopNum = 10
' if sChannelID = 0 then sChannelID = 1
Sql="Select Top "&TopNum&" SpecialID,SpecialName,ChannelID from Cl_Special "
if sChannelID > 0 then Sql = Sql & " where ChannelID=-1 or ChannelID="&sChannelID&""
Sql = Sql & " Order by OrderID"
Set Rs = Cl.Execute(sql)
if Rs.bof and Rs.eof then
ShowSpecial= " 没有任何专题"
else
If ChannelID=0 then
Cl.Load_ChannelSetting(1)
Do While Not Rs.Eof
sTemp = sTemp & "<li><a href=""" & Cl.WebDir & Cl.Channel.selectSingleNode("@channeldir").text & "/ShowSpecial.asp?SpecialID=" & Rs(0) & """>" & Rs(1) & "</a></li><br />"
Rs.MoveNext
Loop
Else
Cl.Load_ChannelSetting(sChannelID)
Do While Not Rs.Eof
sTemp = sTemp & "<li><a href=""" & Cl.WebDir & Cl.Channel.selectSingleNode("@channeldir").text & "/ShowSpecial.asp?SpecialID=" & Rs(0) & """>" & Rs(1) & "</a></li><br />"
Rs.MoveNext
Loop
End if
ShowSpecial=sTemp & "<p align=""right""><a href=""" & Cl.WebDir & "SpecialList.asp?ChannelID="&sChannelID&""">更多专题</a></p>"
end If
Rs.Close : Set Rs = Nothing
End Function
Sub Special_Setting()
SpecialID = Cl.GetClng(request("SpecialID"))
if SpecialID>0 Then
Dim Rs,SQL
SQL="select SpecialID,SpecialName From Cl_Special where SpecialID=" & SpecialID
set Rs=Cl.Execute(SQL)
if Rs.bof and Rs.eof Then
Set Rs=Nothing
Call Cl.OutErr(0,Cl.Language.selectSingleNode("//ClassNoFind").text)
End if
SpecialName = Rs(1)
Set Rs=Nothing
end if
End Sub
'==============================================
Sub RefreshJs(Byval sChannelID)
Dim RsRe,sTr,sID,sModuleID,TempData
sID=Cl.GetClng(sChannelID)
if sID>0 then
Set RsRe=Cl.Execute("Select ChannelID,JsName,JsReadme,JsType,JsFileName,Config From Cl_Js where ChannelID="&sID&"")
else
Set RsRe=Cl.Execute("Select ChannelID,JsName,JsReadme,JsType,JsFileName,Config From Cl_Js")
end if
Do while Not Rsre.eof
Cl.Load_ChannelSetting(RsRe(0))
sModuleID=Clng(Cl.Channel.selectSingleNode("@moduleid").text)
if sModuleID=0 then Exit do
if Rsre("JsType")=0 then
TempData=Template.ReplaceAllFlag(Rsre("Config"))
else
sTr=Split(Rsre("Config"),"@@")
sTr(0)=Split(sTr(0),"||")
sTr(1)=Split(sTr(1),"||")
Select Case sModuleID
Case 1
TempData=GetArticle(sTr(0)(0),sTr(0)(1),sTr(0)(2),sTr(0)(3),sTr(0)(4),sTr(0)(5),sTr(0)(6),sTr(0)(7),sTr(0)(8),sTr(0)(9),sTr(0)(10),sTr(1)(0),sTr(1)(1),sTr(1)(2))
Case 2
TempData=GetSoft(sTr(0)(0),sTr(0)(1),sTr(0)(2),sTr(0)(3),sTr(0)(4),sTr(0)(5),sTr(0)(6),sTr(0)(7),sTr(0)(8),sTr(0)(9),sTr(0)(10),sTr(1)(0),sTr(1)(1),sTr(1)(2))
Case 3
TempData=GetPhoto(sTr(0)(0),sTr(0)(1),sTr(0)(2),sTr(0)(3),sTr(0)(4),sTr(0)(5),sTr(0)(6),sTr(0)(7),sTr(0)(8),sTr(0)(9),sTr(0)(10),sTr(1)(0),sTr(1)(1),sTr(1)(2))
Case 4
TempData=GetMovie(sTr(0)(0),sTr(0)(1),sTr(0)(2),sTr(0)(3),sTr(0)(4),sTr(0)(5),sTr(0)(6),sTr(0)(7),sTr(0)(8),sTr(0)(9),sTr(0)(10),sTr(1)(0),sTr(1)(1),sTr(1)(2))
Case 5
TempData=GetProduct(sTr(0)(0),sTr(0)(1),sTr(0)(2),sTr(0)(3),sTr(0)(4),sTr(0)(5),sTr(0)(6),sTr(0)(7),sTr(0)(8),sTr(0)(9),sTr(0)(10),sTr(1)(0),sTr(1)(1),sTr(1)(2))
Case Else
Exit do
End Select
end if
TempData=replace(TempData,chr(34),"\"&chr(34))
TempData=replace(replace(TempData,chr(10),"\n"),chr(13),"\n")
TempData=Replace(TempData,Vbcrlf,"")
TempData="document.write (""" & Replace(TempData,",","\,") & """);"
Cl.MakeHtml TempData,Cl.WebDir & Cl.Channel.selectSingleNode("@channeldir").text & "/Js/"&Rsre("JsFileName")&".Js"
Rsre.Movenext
Loop
RsRe.Close:Set RsRe=Nothing
End Sub
Sub RefreshClassMenuJs()
Dim Node
For Each Node In Application(Cl.CacheName & "_channellist").DocumentElement.SelectNodes("channel[@channeltype<2][@channelid!=0][@channelid!=6]")
ChannelID = Node.SelectSingleNode("@channelid").text
Cl.MakeHtml Template.GetClassMenu(ChannelID),Cl.WebDir&"Js/ClassMenu/ClassMenu_" & ChannelID & ".Js"
Next
End Sub
Sub CreateClassJs(sChannelID)
Cl.Load_ChannelSetting(sChannelID)
'Cl.LoadTemplates("")
Cl.MakeHtml Template.GetClassMenu(sChannelID),Cl.WebDir&"Js/ClassMenu/ClassMenu_" & sChannelID & ".Js"
dim strSearchDate,i
for i=3 to 5
strSearchDate=Replace(Cl.ReplaceDir(ShowSearchForm(sChannelID,i)),chr(34),"\"&chr(34))
strSearchDate="document.write (""" & Replace(strSearchDate,vbcrlf,"\n") & """);"
Cl.MakeHtml strSearchDate,Cl.WebDir&"Js/Search/Search" & sChannelID & "_" & i & ".Js"
next
End Sub
'==================================================================
'过程：Wap(sChannelID,sClassID)
'参数：
' sChannelID ------ 频道ID
' sClassID ------ 栏目ID
'==================================================================
Function Wap(sChannelID,sClassID)
Dim sUrl
If sChannelID<>"0" Then
If sClassID=0 Then
sUrl="&ChannelID="&sChannelID&""
Else
sUrl="&ChannelID="&sChannelID&"&ClassID="&sClassID&""
End if
Else
sUrl=""
End if
Wap = "<a href=""" &InstallDir& "Help.asp?Action=wap"& sUrl &""" title=""欢迎使用本站Wap"">"
Wap = Wap & "<img src="""&InstallDir&"Images/Wap.gif"" width=""31"" height=""11"" border=""0"" alt="""" />"
Wap = Wap & "</a>"
End Function
'==================================================================
'过程：Rss(sChannelID,sClassID)
'参数：
' sChannelID ------ 频道ID
' sClassID ------ 栏目ID
'==================================================================
Function Rss(sChannelID,sClassID)
Dim sUrl
If sChannelID<>0 Then
If sClassID=0 Then
sUrl="?ChannelID="&sChannelID&""
Else
sUrl="?ChannelID="&sChannelID&"&ClassID="&sClassID&""
End if
Else
sUrl=""
End if
Rss = "<a href=""" &InstallDir& "Rssfeed.asp"& sUrl &""" title=""欢迎使用本站Rss"">"
Rss = Rss & "<img src="""&InstallDir&"Images/Rss.gif"" width=""31"" height=""11"" border=""0"" alt="""" />"
Rss = Rss & "</a>"
End Function
'显示自定义字段
Function ShowField(AddType,ItemID,ModuleID)
Dim TempStr,RsField,FieldValue,Options,Item
If AddType<>"Add" Then
Dim RsContent
Select Case ModuleID
Case 1
Set RsContent=Cl.execute("Select * From Cl_Article Where InfoID="&ItemID&"")
Case 2
Set RsContent=Cl.execute("Select * From Cl_Soft Where InfoID="&ItemID&"")
Case 3
Set RsContent=Cl.execute("Select * From Cl_Photo Where InfoID="&ItemID&"")
Case 4
Set RsContent=Cl.execute("Select * From Cl_Movie Where InfoID="&ItemID&"")
Case 5
Set RsContent=Cl.execute("Select * From Cl_Product Where InfoID="&ItemID&"")
Case else
Exit Function
End Select
End if
Set RsField=Cl.Execute("Select * From Cl_Field Where IsShow=1 And ModuleID="&ModuleID)
Do While Not RsField.eof
If Instr(","& RsField("arrChannelID") &",",","& ChannelID &",") > 0 Then
TempStr=TempStr&"<tr class='tdbg'>"
TempStr=TempStr&"<td width='100' align='right'><strong>"& RsField("FieldTitle") &"：</strong></td><td colspan='2'>"
If AddType="Add" Then
FieldValue= RsField("DefaultValue")
Else
FieldValue= RsContent(trim(RsField("FieldName")))
End If
Select Case RsField("FieldType")
Case 1
TempStr=TempStr&"<input name='"& RsField("FieldName") &"' type='text' size='100' maxlength='255' Value='"& FieldValue &"'>"
Case 2
TempStr=TempStr&"<textarea name='"& RsField("FieldName") &"' cols='40' rows='3' id='"& RsField("FieldName") &"'>"& FieldValue &"</textarea><a href=""javascript:admin_Size(-3,'"& RsField("FieldName") &"')""><img src=""images/minus.gif"" unselectable=""on"" border='0'></a> <a href=""javascript:admin_Size(3,'"& RsField("FieldName") &"')""><img src=""images/plus.gif"" unselectable=""on"" border='0'></a>"
Case 3
Options=Split(RsField("Options"),VbCrlf)
TempStr=TempStr&"<select name="""& RsField("FieldName") &""" id="""& RsField("FieldName") &""">"
for each Item in Options
If Item=FieldValue Then
TempStr=TempStr&"<option value="""& Item &""" selected>"& Item &"</option>"
Else
TempStr=TempStr&"<option value="""& Item &""">"& Item &"</option>"
End If
next
TempStr=TempStr&"</select>"
Case 4
TempStr=TempStr&"<input name='"& RsField("FieldName") &"' type='text' size='40' maxlength='50' Value='"& FieldValue &"'>"
Case 5
TempStr=TempStr&"<input name='"& RsField("FieldName") &"' type='text' size='40' maxlength='50' Value='"& FieldValue &"' onfocus=""show_cele_date("& RsField("FieldName") &",'','',"& RsField("FieldName") &")"">"
End Select
TempStr=TempStr&"<br /><Font color='blue'>"& RsField("FieldIntro") &"</font></td></tr>"
End If
RsField.movenext
Loop
ShowField=TempStr
End Function
'保存自定义字段
Sub SaveField(sChannelID,sModuleID)
'Response.write sChannelID & "<br>"
'Response.write sModuleID & "<br>"
'Response.write Request("Cl_Test") & "<br>"
' Response.end
dim Sql,RsTemp,TempStr
Sql = "Select arrChannelID,FieldType,FieldName,FieldTitle,IsNull From [Cl_Field] Where IsShow=1 And ModuleID = "& Clng(sModuleID) &" Order by FieldID"
Set RsTemp = Cl.Execute(Sql)
Do While Not RsTemp.eof
If Instr(","& RsTemp(0) &",",","& ChannelID &",") > 0 then
If RsTemp(1)=4 then
TempStr = Cl.GetClng(Request(""& RsTemp(2) &""))
If trim(Request(""& RsTemp(2) &""))="" and RsTemp(4)=0 Then Cl.OutMsg 0,"该项目“"& RsTemp(3) &"”不允许为空！","-1"
Else
TempStr = Trim(Request(""& RsTemp(2) &""))
If Trim(Request(""& RsTemp(2) &""))="" and RsTemp(4)=0 Then Cl.OutMsg 0,"该项目“"& RsTemp(3) &"”不允许为空！","-1"
End If
Rs(""& RsTemp(2) &"") = TempStr
end If
RsTemp.MoveNext
Loop
RsTemp.Close:Set RsTemp = Nothing
End Sub
Function CheckUse(ItemID,ArrItemID)
If Instr(","&ArrItemID&",",","&ItemID&",")>0 Then CheckUse=" style=""display:'none';"""
End Function
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -