📄 ks.rcls.asp
字号:
'*********************************************************************************************************
'函数名：ReplaceRA
'作 用：自动判断系统是否用相对路径或绝对路径并转换
'参 数：FileContent原文件,FolderDomain 是否有绑定二级域名
'*********************************************************************************************************
Function ReplaceRA(F_C, FolderDomain)
If CStr(KS.Setting(97)) = "0" Then
If FolderDomain <> "" Then
F_C = Replace(F_C, FolderDomain, "/")
Else
If Trim(KS.Setting(3)) = "/" Then
F_C = Replace(F_C, DomainStr, "/")
Else
F_C = Replace(F_C, Replace(DomainStr, Trim(KS.Setting(3)), ""), "")
End If
End If
End If
ReplaceRA = F_C
End Function
'-----------------------------------------------------------------------------------------------------------------------------
'过程名：GetPageStr
'作 用：取得分页的通用函数
'参 数：PageContent--分页内容,LinkUrl--链接地址,Index-首页名称
' F_C--待保存的文件内容,FilePath---待保存路径,SecondDomain --二级域名 ,ShowTurnToFlag ---是否显示转到下拉框
'------------------------------------------------------------------------------------------------------------------------------
Sub GetPageStr(PageContent, LinkUrl, Index, F_C, FilePath, SecondDomain, ShowTurnToFlag)
Dim CurrPage, PageStr, TempFileContent, I, PageContentArr, J, SelectStr
Dim TotalPage
Dim HomeLink '构造首页链接
Dim LinkUrlFname '构造其它页链接
Dim Fname '文件名
Dim FExt '扩展名
HomeLink = LinkUrl & Index
FExt = Mid(Trim(Index), InStrRev(Trim(Index), ".")) '分离出扩展名
Fname = Replace(Trim(Index), FExt, "") '分离出文件名 如 1254ddd
LinkUrlFname = LinkUrl & Fname
PageContentArr = Split(PageContent, "{$PageList}")
TotalPage = UBound(PageContentArr)
For I = LBound(PageContentArr) To TotalPage - 1
CurrPage = I + 1
Select Case Application(KS.SiteSN & "PageStyle")
Case 1
If CurrPage = 1 And CurrPage <> TotalPage Then
PageStr = "首页 上一页 <a href=""" & LinkUrlFname & "_" & CurrPage + 1 & FExt & """>下一页</a> <a href= """ & LinkUrlFname & "_" & TotalPage & FExt & """>尾页</a>"
ElseIf CurrPage = 1 And CurrPage = TotalPage Then
PageStr = "首页 上一页 下一页 尾页"
ElseIf CurrPage = TotalPage And CurrPage <> 2 Then '对于最后一页刚好是第二页的要做特殊处理
PageStr = "<a href=""" & HomeLink & """>首页</a> <a href=""" & LinkUrlFname & "_" & CurrPage - 1 & FExt & """>上一页</a> 下一页 尾页"
ElseIf CurrPage = TotalPage And CurrPage = 2 Then
PageStr = "<a href=""" & HomeLink & """>首页</a> <a href=""" & HomeLink & """>上一页</a> 下一页 尾页"
ElseIf CurrPage = 2 Then
PageStr = "<a href=""" & HomeLink & """>首页</a> <a href=""" & HomeLink & """>上一页</a> <a href=""" & LinkUrlFname & "_" & CurrPage + 1 & FExt & """>下一页</a> <a href= """ & LinkUrlFname & "_" & (TotalPage & FExt) & """>尾页</a>"
Else
PageStr = "<a href=""" & HomeLink & """>首页</a> <a href=""" & LinkUrlFname & "_" & CurrPage - 1 & FExt & """>上一页</a> <a href=""" & LinkUrlFname & "_" & CurrPage + 1 & FExt & """>下一页</a> <a href= """ & LinkUrlFname & "_" & (TotalPage & FExt) & """>尾页</a>"
End If
Case 2
If CurrPage=1 Then
PageStr="<font face=webdings>9</font> <font face=webdings>7</font>"
ElseIf CurrPage=2 Then
PageStr="<a href=""" & HomeLink & """ title=""首页""><font face=webdings>9</font></a> <a href=""" & HomeLink & """ title=""上一页""><font face=webdings>7</font></a>"
Else
PageStr="<a href=""" & HomeLink & """ title=""首页""><font face=webdings>9</font></a> <a href=""" & LinkUrlFname & "_" & CurrPage - 1 & FExt & """ title=""上一页""><font face=webdings>7</font></a> "
End If
For J=CurrPage To CurrPage+9
If J>TotalPage Then Exit For
If J= CurrPage Then
PageStr=PageStr & " <font color=red>[" & J &"]</font>"
Else
PageStr=PageStr & " <a href=""" & LinkUrlFname & "_" & J & FExt & """>[" & J &"]</a>"
End If
Next
If CurrPage=TotalPage Then
PageStr=PageStr & " <font face=webdings>8</font> <font face=webdings>:</font>"
Else
PageStr=PageStr & " <a href=""" & LinkUrlFname & "_" & CurrPage + 1 & FExt & """ title=""上一页""><font face=webdings>8</font></a> <a href=""" & LinkUrlFname & "_" & TotalPage & FExt & """><font face=webdings>:</font></a> "
End If
Case 3
If CurrPage=1 Then
PageStr="<font face=webdings>9</font> <font face=webdings>7</font>"
ElseIf CurrPage=2 Then
PageStr="<a href=""" & HomeLink & """ title=""首页""><font face=webdings>9</font></a> <a href=""" & HomeLink & """ title=""上一页""><font face=webdings>7</font></a>"
Else
PageStr="<a href=""" & HomeLink & """ title=""首页""><font face=webdings>9</font></a> <a href=""" & LinkUrlFname & "_" & CurrPage - 1 & FExt & """ title=""上一页""><font face=webdings>7</font></a> "
End If
If CurrPage=TotalPage Then
PageStr=PageStr & " <font face=webdings>8</font> <font face=webdings>:</font>"
Else
PageStr=PageStr & " <a href=""" & LinkUrlFname & "_" & CurrPage + 1 & FExt & """ title=""上一页""><font face=webdings>8</font></a> <a href=""" & LinkUrlFname & "_" & TotalPage & FExt & """><font face=webdings>:</font></a> "
End If
End Select
If CBool(ShowTurnToFlag) = True Then
PageStr = PageStr & " 转到：<select name=""page"" size=""1"" onchange=""javascript:window.location=this.options[this.selectedIndex].value;"">"
For J = 1 To TotalPage
If J = CurrPage Then
SelectStr = " selected"
Else
SelectStr = ""
End If
If J = 1 Then
PageStr = PageStr & "<option value=""" & HomeLink & """" & SelectStr & ">第" & J & "页</option>"
Else
PageStr = PageStr & "<option value=""" & LinkUrlFname & "_" & J & FExt & """" & SelectStr & ">第" & J & "页</option>"
End If
Next
PageStr = PageStr & "</select>"
End If
TempFileContent = Replace(F_C, "{PageListStr}", PageContentArr(I) & PageStr & "</div>")
TempFileContent = ReplaceRA(TempFileContent, SecondDomain)
Dim TempFilePath
If CurrPage = 1 Then
TempFilePath = FilePath & Index
Else
TempFilePath = FilePath & Fname & "_" & CurrPage & FExt
End If
Call FSOSaveFile(TempFileContent, TempFilePath)
Next
End Sub
'*********************************************************************************************************
'函数名：ReplaceGeneralLabelContent
'作 用：替换通用标签为内容
'参 数：FileContent原文件
'*********************************************************************************************************
Function ReplaceGeneralLabelContent(F_C)
Dim HtmlLabel,HtmlLabelArr, Param,LabelTotal,I
'替换通用JS
F_C=ReplaceCommonJS(F_C)
'替换搜索标签
Dim KSCSH:Set KSCSH=New RefreshSearchCls
F_C=KSCSH.ReplaceAllSearch(F_C)
Set KSCSH=Nothing
F_C=ReplaceChannelLabel(F_C)
F_C=ReplaceRssLabel(F_C)
F_C = Replace(F_C, "{$GetSiteName}", KS.Setting(0))
F_C = Replace(F_C, "{$GetSiteTitle}", KS.Setting(1))
F_C = Replace(F_C, "{$GetSiteLogo}", "<Img src=""" & KS.Setting(4) & """ border=""0"" align=""absmiddle"">")
'替换网站Logo(带参数)
If InStr(F_C, "{=GetLogo") <> 0 Then
HtmlLabel = KSLabel.GetFunctionLabel(F_C, "{=GetLogo")
HtmlLabelArr=Split(HtmlLabel,"@@@")
For I=0 To Ubound(HtmlLabelArr)
Param = Split(KSLabel.GetFunctionLabelParam(HtmlLabelArr(I), "{=GetLogo"),",")
F_C = Replace(F_C, HtmlLabelArr(I), "<Img src=""" & KS.Setting(4) & """ border=""0"" width=""" & Param(0) & """ height=""" & Param(1) & """ align=""absmiddle"">")
Next
End If
If InStr(F_C, "{=GetTopUser") <> 0 Then
HtmlLabel = KSLabel.GetFunctionLabel(F_C, "{=GetTopUser")
HtmlLabelArr=Split(HtmlLabel,"@@@")
For I=0 To Ubound(HtmlLabelArr)
Param = Split(KSLabel.GetFunctionLabelParam(HtmlLabelArr(I), "{=GetTopUser"),",")
F_C = Replace(F_C, HtmlLabelArr(I), GetTopUser(Param(0),Param(1)))
Next
End If
'替换网站广告位
If InStr(F_C, "{=GetAdvertise") <> 0 Then
HtmlLabel = KSLabel.GetFunctionLabel(F_C, "{=GetAdvertise")
HtmlLabelArr=Split(HtmlLabel,"@@@")
For I=0 To Ubound(HtmlLabelArr)
Param = KSLabel.GetFunctionLabelParam(HtmlLabelArr(I), "{=GetAdvertise")
F_C = Replace(F_C, HtmlLabelArr(I), "<Script src=""" & DomainStr & "plus/Advertise.asp?I="& Param & """ language=""javascript""></script>")
Next
End If
If InStr(F_C, "{=GetVote") <> 0 Then
HtmlLabel = KSLabel.GetFunctionLabel(F_C, "{=GetVote")
HtmlLabelArr=Split(HtmlLabel,"@@@")
For I=0 To Ubound(HtmlLabelArr)
Param = split(KSLabel.GetFunctionLabelParam(HtmlLabelArr(I), "{=GetVote"),",")(0)
F_C = Replace(F_C, HtmlLabelArr(I), GetVote(Param))
Next
End If
If InStr(F_C, "{=GetTags") <> 0 Then
HtmlLabel = KSLabel.GetFunctionLabel(F_C, "{=GetTags")
HtmlLabelArr=Split(HtmlLabel,"@@@")
For I=0 To Ubound(HtmlLabelArr)
Param = Split(KSLabel.GetFunctionLabelParam(HtmlLabelArr(I), "{=GetTags"),",")
F_C = Replace(F_C, HtmlLabelArr(I), GetTags(Param(0),Param(1)))
Next
End If
'站点统计
F_C = Replace(F_C, "{$GetSiteCountAll}", GetSiteCountAll())
F_C = Replace(F_C, "{$GetSiteOnline}", "<Script Src=""" & DomainStr & "KS_Inc/online.asp?Referer=""+escape(document.referrer) language=""javascript""></script>")
F_C = Replace(F_C, "{$GetTopUserLogin}", "<iframe width=""520"" height=""22"" id=""toplogin"" name=""toplogin"" src=""" & DomainStr & "user/userlogin.asp?action=Top"" frameBorder=""0"" scrolling=""no"" allowtransparency=""true""></iframe>")
F_C = Replace(F_C, "{$GetUserLogin}", "<iframe width=""180"" height=""122"" id=""loginframe"" name=""loginframe"" src=""" & DomainStr & "user/userlogin.asp"" frameBorder=""0"" scrolling=""no"" allowtransparency=""true""></iframe>")
If InStr(F_C, "{$GetSpecial}") <> 0 Then
Dim SpecialIndexUrl,SpecialDir:SpecialDir = KS.Setting(95)
If Split(KS.Setting(5),".")(1)<>"asp" Then SpecialIndexUrl=DomainStr & SpecialDir Else SpecialIndexUrl=DomainStr & "SpecialIndex.asp"
F_C = Replace(F_C, "{$GetSpecial}", "<a href=""" & SpecialIndexUrl & """ target=""_blank"">专题首页</a>")
End If
F_C = Replace(F_C, "{$GetFriendLink}", "<a href=""" & DomainStr & "FriendLink/"" target=""_blank"">友情链接</a>")
F_C = Replace(F_C, "{$GetSiteUrl}", DomainStr)
F_C = Replace(F_C, "{$GetInstallDir}", KS.Setting(3))
F_C = Replace(F_C, "{$GetManageLogin}", "<a href=""" & DomainStr & KS.Setting(89) & "Login.asp"" target=""_blank"">管理登录</a>")
F_C = Replace(F_C, "{$GetCopyRight}", KS.Setting(18))
F_C = Replace(F_C, "{$GetMetaKeyWord}", KS.Setting(19))
F_C = Replace(F_C, "{$GetMetaDescript}", KS.Setting(20))
F_C = Replace(F_C, "{$GetWebmaster}", "<a href=""mailto:" & KS.Setting(11) & """>" & KS.Setting(10) & "</a>")
F_C = Replace(F_C, "{$GetWebmasterEmail}", KS.Setting(11))
ReplaceGeneralLabelContent = F_C
End Function
Function GetTags(TagType,Num)
if not isnumeric(num) then exit function
dim sqlstr,sql,i,n,str
select case cint(tagtype)
case 1:sqlstr="select top 500 keytext,channelid,hits from ks_keywords order by hits desc"
case 2:sqlstr="select top 500 keytext,channelid,hits from ks_keywords order by lastusetime desc,id desc"
case 3:sqlstr="select top 500 keytext,channelid,hits from ks_keywords order by Adddate desc,id desc"
case else
GetTags="":exit function
end select
dim rs:set rs=conn.execute(sqlstr)
if rs.eof then rs.close:set rs=nothing:exit function
sql=rs.getrows(-1)
rs.close:set rs=nothing
for i=0 to ubound(sql,2)
if KS.FoundInArr(str,sql(0,i),",")=false then
n=n+1
str=str & "," & sql(0,i)
gettags=gettags & "<a href=""" & domainstr & "plus/search.asp?searchtype=5&channelid=" & sql(1,i) & "&tags=" & sql(0,i)& """ target=""_blank"" title=""TAG:" & sql(0,i) & " 被使用了" & SQL(2,I) &"次"">" & sql(0,i) & "</a> "
end if
if n>=cint(num) then exit for
next
End Function
'*********************************************************************************************************
'函数名：GetSiteCountAll
'作 用：替换网站统计标签为内容
'参 数：Flag-0总统计，1-文章统计 2-图片统计
'*********************************************************************************************************
Function GetSiteCountAll()
Dim ChannelTotal: ChannelTotal = Conn.Execute("Select Count(*) From KS_Class Where TN='0'")(0)
Dim MemberTotal:MemberTotal=Conn.Execute("Select Count(*) From KS_User")(0)
Dim CommentTotal: CommentTotal = Conn.Execute("Select Count(*) From KS_Comment")(0)
Dim GuestBookTotal:GuestBookTotal=Conn.Execute("Select Count(ID) From KS_GuestBook")(0)
GetSiteCountAll="<div class=""sitetotal"">" & vbcrlf
GetSiteCountAll = GetSiteCountAll & "<li>频道总数： " & ChannelTotal & " 个</li>" & vbcrlf
dim rsc:set rsc=conn.execute("select channelid,ItemName,Itemunit,channeltable from ks_channel where channelstatus=1 and channelid<>6 And ChannelID<>9")
dim k,sql:sql=rsc.getrows(-1)
rsc.close:set rsc=nothing
for k=0 to ubound(sql,2)
GetSiteCountAll = GetSiteCountAll & "<li>" & sql(1,k) & "总数： " & Conn.Execute("Select Count(id) From " & sql(3,k))(0) & " " & sql(2,k)&"</li>" & vbcrlf
next
GetSiteCountAll = GetSiteCountAll & "<li>注册会员： " & MemberTotal & " 位</li>" & vbcrlf
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -