📄 ks_refreshcls.asp
字号:
If (InStr(FileContent, "{PageListStr}") <> 0) And (Application(Cstr(KSCMS.SiteSN & "PageArticleList")) <> "") Then
'调用分页处理过程
Call GetPageStr(Application(Cstr(KSCMS.SiteSN & "PageArticleList")), Trim(KSCMS.GetDomain & SpecialDir & RefreshRS("SpecialEname") & "/"), Index, FileContent, FilePath, "", True)
Application(Cstr(KSCMS.SiteSN & "PageArticleList")) = ""
Else
FileContent = Replace(FileContent, "{PageListStr}", "")
FileContent = ReplaceRA(FileContent, "")
'生成文件
Call FSOSaveFile(Published() & FileContent, FilePath & Index)
End If
End Function
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'函数名：RefreshChannelSpecials
'作 用：刷新频道专题汇总页
'参 数：RefreshRS Recordset数据集
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Function RefreshChannelSpecials(RefreshRS)
Dim FileContent, SpecialDir,FolderName, Index, FilePath
Application(Cstr(KSCMS.SiteSN & "RefreshType")) = "ChannelSpecial" '设置刷新类型,以取得当前导航位置
FolderName = Trim(RefreshRS("FolderName"))
Application("RefreshFolderName") = FolderName '此处存放频道名称,以取得导航位置
Application(Cstr(KSCMS.SiteSN & "RefreshFolderID")) = RefreshRS("ID")
'读出频道专题页对应的模板
FileContent = LoadTemplate(5)
If Trim(FileContent) = "" Then FileContent = "频道专题汇总页模板不存在!"
FileContent = ReplaceGeneralLabelContent(FileContent) '替换网站通用标签
FileContent = ReplaceAllLabel(FileContent)
'如果有发现专题分页列表标签,则进行{$GetLastChannelSpecialList(替换为{PageListStr}{$GetLastChannelSpecialList(
If InStr(FileContent, "{$GetLastChannelSpecialList(") <> 0 Then FileContent = Replace(FileContent, "{$GetLastChannelSpecialList(", "{PageListStr}{$GetLastChannelSpecialList(")
FileContent = ReplaceLableFlag(FileContent) '替换函数标签
SpecialDir = KSCMS.GetConfig("SpecialDir")
If Left(SpecialDir, 1) = "/" Or Left(SpecialDir, 1) = "\" Then SpecialDir = Right(SpecialDir, Len(SpecialDir) - 1)
Index = RefreshRS("FolderFsoIndex")
FilePath = KSCMS.GetConfig("InstallDir") & SpecialDir & RefreshRS("Folder")
Call KSCMS.CreateListFolder(FilePath)
If (InStr(FileContent, "{PageListStr}") <> 0) And (Application(Cstr(KSCMS.SiteSN & "PageArticleList")) <> "") Then
'调用通用分页处理过程
Call GetPageStr(Application(Cstr(KSCMS.SiteSN & "PageArticleList")), Trim(KSCMS.GetDomain & SpecialDir & RefreshRS("Folder")), Index, FileContent, FilePath, "", True)
Application.Contents.Remove (KSCMS.SiteSN & "PageArticleList")
Else
FileContent = ReplaceRA(FileContent, "")
Call FSOSaveFile(Published() & FileContent, FilePath & Index)
End If
End Function
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'函数名：RefreshCommonPage
'作 用：刷新通用页面
'参 数：RefreshRS Recordset数据集
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Function RefreshCommonPage(RefreshRS)
Dim FileContent, CommonDir, FilePath
'读出专题页对应的模板
FileContent = LoadTemplate(RefreshRS("TemplateID"))
If Trim(FileContent) = "" Then FileContent = "模板不存在!"
FileContent = ReplaceGeneralLabelContent(FileContent) '替换通用标签 如{$GetWebmaster}
FileContent = ReplaceLableFlag(ReplaceAllLabel(FileContent)) '替换函数标签
'如果采用根相对路径,则替换绝对路径为根相对路径
FileContent = ReplaceRA(FileContent, "")
CommonDir = Replace(KSCMS.GetConfig("CommonDir"), "\", "")
If Left(CommonDir, 1) = "/" Then CommonDir = Right(CommonDir, Len(CommonDir) - 1)
FilePath = KSCMS.GetConfig("InstallDir") & CommonDir
Call KSCMS.CreateListFolder(FilePath)
Call FSOSaveFile(Published() & FileContent, FilePath & RefreshRS("FsoFileName"))
End Function
'*********************************************************************************************************
'函数名：ReplaceRA
'作 用：自动判断系统是否用相对路径或绝对路径并转换
'参 数：FileContent原文件,FolderDomain 是否有绑定二级域名
'*********************************************************************************************************
Function ReplaceRA(FileContent, FolderDomain)
If CStr(KSCMS.GetConfig("FsoWay")) = "0" Then
If FolderDomain <> "" Then
FileContent = Replace(FileContent, FolderDomain, "/")
Else
If Trim(KSCMS.GetConfig("InstallDir")) = "/" Then
FileContent = Replace(FileContent, KSCMS.GetDomain, "/")
Else
FileContent = Replace(FileContent, Replace(KSCMS.GetDomain, Trim(KSCMS.GetConfig("InstallDir")), ""), "")
End If
End If
End If
ReplaceRA = FileContent
End Function
'-----------------------------------------------------------------------------------------------------------------------------
'过程名：GetPageStr
'作 用：取得分页的通用函数
'参 数：PageContent--分页内容,LinkUrl--链接地址,Index-首页名称
' FileContent--待保存的文件内容,FilePath---待保存路径,SecondDomain --二级域名 ,ShowTurnToFlag ---是否显示转到下拉框
'------------------------------------------------------------------------------------------------------------------------------
Sub GetPageStr(PageContent, LinkUrl, Index, FileContent, 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, "[NextPage]")
TotalPage = UBound(PageContentArr)
For I = LBound(PageContentArr) To TotalPage - 1
CurrPage = I + 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
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(FileContent, "{PageListStr}", PageContentArr(I) & PageStr & "</td></tr></table>")
TempFileContent = ReplaceRA(TempFileContent, SecondDomain)
Dim TempFilePath
If CurrPage = 1 Then
TempFilePath = FilePath & Index
Else
TempFilePath = FilePath & Fname & "_" & CurrPage & FExt
End If
'生成文件
Call FSOSaveFile(Published() & TempFileContent, TempFilePath)
Next
End Sub
'*********************************************************************************************************
'函数名：ReplaceGeneralLabelContent
'作 用：替换通用标签为内容
'参 数：FileContent原文件
'*********************************************************************************************************
Function ReplaceGeneralLabelContent(FileContent)
Dim HtmlLabel,HtmlLabelArr, Param,LabelTotal,I
'替换通用JS
Dim KSCJS:Set KSCJS=New RefreshCommonJSCls
FileContent=KSCJS.ReplaceAllJS(FileContent)
Set KSCJS=Nothing
FileContent=ReplaceRssLabel(FileContent)
If InStr(FileContent, "{$GetSiteName}") <> 0 Then
FileContent = Replace(FileContent, "{$GetSiteName}", KSCMS.GetConfig("WebName"))
End If
If InStr(FileContent, "{$GetSiteTitle}") <> 0 Then
FileContent = Replace(FileContent, "{$GetSiteTitle}", KSCMS.GetConfig("WebTitle"))
End If
'替换网站Logo（不带参数）
If InStr(FileContent, "{$GetSiteLogo}") <> 0 Then
FileContent = Replace(FileContent, "{$GetSiteLogo}", "<Img src=""" & KSCMS.GetConfig("WebLogo") & """ border=""0"" align=""absmiddle"">")
End If
'替换网站Logo(带参数)
If InStr(FileContent, "{=GetLogo") <> 0 Then
'若发现，则进行替换，先取得普通函数标签的参数
HtmlLabel = KSLabel.GetFunctionLabel(FileContent, "{=GetLogo")
HtmlLabelArr=Split(HtmlLabel,"@@@")
For I=0 To Ubound(HtmlLabelArr)
Param = KSLabel.GetFunctionLabelParam(HtmlLabelArr(I), "{=GetLogo")
Dim LogoWidth: LogoWidth = Split(Param, ",")(0)
Dim LogoHeight: LogoHeight = Split(Param, ",")(1)
FileContent = Replace(FileContent, HtmlLabelArr(I), "<Img src=""" & KSCMS.GetConfig("WebLogo") & """ border=""0"" width=""" & LogoWidth & """ height=""" & LogoHeight & """ align=""absmiddle"">")
Next
End If
If InStr(FileContent, "{=GetTopUser") <> 0 Then
'若发现，则进行替换，先取得普通函数标签的参数
HtmlLabel = KSLabel.GetFunctionLabel(FileContent, "{=GetTopUser")
HtmlLabelArr=Split(HtmlLabel,"@@@")
For I=0 To Ubound(HtmlLabelArr)
Param = KSLabel.GetFunctionLabelParam(HtmlLabelArr(I), "{=GetTopUser")
Dim UserNum: UserNum = Split(Param, ",")(0)
Dim UserMoreStr:UserMoreStr = Split(Param, ",")(1)
FileContent = Replace(FileContent, HtmlLabelArr(I), GetTopUser(UserNum,UserMoreStr))
Next
End If
'替换网站广告位
If InStr(FileContent, "{=GetAdvertise") <> 0 Then
'若发现，则进行替换，先取得普通函数标签的参数
HtmlLabel = KSLabel.GetFunctionLabel(FileContent, "{=GetAdvertise")
HtmlLabelArr=Split(HtmlLabel,"@@@")
For I=0 To Ubound(HtmlLabelArr)
Param = KSLabel.GetFunctionLabelParam(HtmlLabelArr(I), "{=GetAdvertise")
Dim PlaceID:PlaceID = Split(Param, ",")(0)
FileContent = Replace(FileContent, HtmlLabelArr(I), "<Script src=""" & DomainStr & "Advertise.asp?I="& PlaceID & """ language=""javascript""></script>")
Next
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -