📄 ks_refreshcls.asp
字号:
<!--#include file="KS_RefreshFunctionCls.asp"-->
<!--#include file="KS_LabelCls.asp"-->
<!--#include file="KS_RefreshCommonJSCls.asp"-->
<%
'===================================================================================================================
'软件名称：科汛网站管理系统
'当前版本：科汛网站管理系统 V 2.2 Free
'Copyright (C) 2006-2008 Kesion.Com All rights reserved.
'产品咨询QQ：9537636,41904294
'技术支持QQ：111394
'程序版权： 科汛网络
'E-Mail :kesioncms@hotmail.com webmaster@kesion.com
'官方网站：http://www.kesion.com
'演示站点：http://test.kesion.com
'郑重声明:
' ①、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
' ②、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
' ③、科汛网络保留此软件的法律追究权利
'====================================================================================================================
'-----------------------------------------------------------------------------------------------
'科汛网站管理系统,通用刷新类
'开发:林文仲 版本 V 2.2
'-----------------------------------------------------------------------------------------------
Class Refresh
Private KSCMS,KSLabel
Private KMRFObj,DomainStr
Private Sub Class_Initialize()
Set KSCMS=New CommonCls
Set KSLabel =New LabelCls
Set KMRFObj=New RefreshFunction
DomainStr=KSCMS.GetDomain
End Sub
Private Sub Class_Terminate()
Set KSCMS=Nothing
Set KMRFObj=Nothing
Set KSLabel=Nothing
End Sub
'替换所有标签
Public Function KSLabelReplaceAll(FileContent)
FileContent = ReplaceGeneralLabelContent(FileContent) '替换通用标签 如{$GetWebmaster}
FileContent = ReplaceLableFlag(ReplaceAllLabel(FileContent)) '替换函数标签
FileContent = ReplaceRA(FileContent, "")
KSLabelReplaceAll=FileContent
End Function
'*******************************************************************************************************
'函数名：LoadTemplate
'作 用：取出模板内容
'参 数：TemplateID模板ID
'返回值：模板内容
'********************************************************************************************************
Function LoadTemplate(TemplateID)
Dim TemplateRS, TemplateSql
Dim FSO, FileObj, FileStreamObj, TemplateFname
Set FSO = CreateObject(KSCMS.GetConfig("FsoObjName"))
'TemplateID 取9999代表首页模板
Select Case TemplateID
Case 9999, 9998, 9997, 9996, 9995, 9994,9993,9992,9991,8999,8998,8997, 8996,4, 5
TemplateSql = "Select TemplateFileName,TemplateContent From KS_Template Where TemplateType=" & TemplateID & " And IsDefault=1"
Case Else
TemplateSql = "Select TemplateFileName,TemplateContent From KS_Template Where TemplateID=" & TemplateID & ""
End Select
Set TemplateRS = Server.CreateObject("Adodb.Recordset")
TemplateRS.Open TemplateSql, Conn, 1, 1
If Not TemplateRS.EOF Then
TemplateFname = Server.MapPath(Replace(KSCMS.GetConfig("InstallDir") & TemplateRS(0), "//", "/"))
If FSO.FileExists(TemplateFname) = False Then
LoadTemplate = TemplateRS(1)
Else
Set FileObj = FSO.GetFile(TemplateFname)
Set FileStreamObj = FileObj.OpenAsTextStream(1)
If Not FileStreamObj.AtEndOfStream Then
LoadTemplate = FileStreamObj.ReadAll
Else
LoadTemplate = "模板内容为空"
End If
End If
Set FSO = Nothing
Set FileObj = Nothing
Set FileStreamObj = Nothing
Else
LoadTemplate = ""
End If
TemplateRS.Close:Set TemplateRS = Nothing
End Function
'**************************************************
'函数名：ReplaceLableFlag
'作 用：去除标签{$},并分组以将标签参数用","隔开
' 示例: km=ReplaceLableFlag("{$Test("par1","par2","par3")}")
' 结果 km=Test,Par1,Par2,Par3
'参 数： Content ----待替换内容
'返回值：返回用","隔开的字符串
'**************************************************
Function ReplaceLableFlag(Content)
Dim regEx, Matches, Match, TempStr
Set regEx = New RegExp
regEx.Pattern = "{\$[^{\$}]*}"
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(Content)
ReplaceLableFlag = Content
For Each Match In Matches
On Error Resume Next
TempStr = Match.Value
TempStr = Replace(TempStr, Chr(13) & Chr(10), "")
TempStr = Replace(TempStr, "{$", "")
TempStr = Replace(TempStr, "}", "")
TempStr = Left(TempStr, InStr(TempStr, "(") - 1) & "," & Mid(TempStr, InStr(TempStr, "(") + 1)
TempStr = Left(TempStr, InStrRev(TempStr, ")") - 1)
TempStr = Replace(TempStr, """", "")
If Err.Number = 0 Then
ReplaceLableFlag = Replace(ReplaceLableFlag, Match.Value, KSLabel.ChangeLableToFunction(TempStr))
End If
Next
End Function
'*********************************************************************************************************
'函数名：ReplaceAllLabel
'作 用：将标签名称转换成对应标签内容
'参 数： Content需转换的内容
'*********************************************************************************************************
Function ReplaceAllLabel(Content)
Dim LabelRS, LabelSql
Set LabelRS = Server.CreateObject("ADODB.Recordset")
LabelSql = "Select LabelType,LabelName,LabelContent from KS_Label"
LabelRS.Open LabelSql, Conn, 1, 1
Do While Not LabelRS.EOF
If LabelRS(0) = 1 Then
Content = Replace(Content, LabelRS(1), ReplaceFreeLabel(LabelRS(2)))
Else
Content = Replace(Content, LabelRS(1), LabelRS(2))
End If
LabelRS.MoveNext
Loop
LabelRS.Close
'开始替换JS
LabelRS.Open "Select JSName FROM KS_JSFile", Conn, 1, 1
Do While Not LabelRS.EOF
Content = Replace(Content, LabelRS(0), ReplaceAllJS(LabelRS(0)))
LabelRS.MoveNext
Loop
LabelRS.Close:Set LabelRS = Nothing
ReplaceAllLabel = Content
End Function
'替换自由标签为内容,仅替换一级
Function ReplaceFreeLabel(Content)
Dim LabelRS,LabelSql
Set LabelRS=Server.CreateObject("ADODB.Recordset")
LabelSql = "Select LabelName,LabelContent from KS_Label"
LabelRS.Open LabelSql, Conn, 1, 1
Do While Not LabelRS.EOF
Content = Replace(Content, LabelRS(0), LabelRS(1))
LabelRS.MoveNext
Loop
ReplaceFreeLabel = ReplaceGeneralLabelContent(Content)
LabelRS.Close:Set LabelRS = Nothing
End Function
'*********************************************************************************************************
'函数名：FSOSaveFile
'作 用：生成文件
'参 数： Content内容,路径 注意虚拟目录
'*********************************************************************************************************
Sub FSOSaveFile(Content, LocalFileName)
Dim FSO, FileObj
Set FSO = Server.CreateObject(KSCMS.GetConfig("FsoObjName"))
Set FileObj = FSO.CreateTextFile(Server.MapPath(LocalFileName), True) '创建文件
FileObj.Write Content
FileObj.Close '释放对象
Set FileObj = Nothing:Set FSO = Nothing
End Sub
'*********************************************************************************************************
'函数名：ReplaceAllJS
'作 用：将JS标签名称转换成对应JS内容 如<script src=1.js><//script>
'参 数： JSNameJS标签名称
'*********************************************************************************************************
Function ReplaceAllJS(JSName)
Dim JSRS, SqlStr, JSDir
Set JSRS = Server.CreateObject("ADODB.Recordset")
SqlStr = "Select * from KS_JSFile Where JSName='" & Trim(JSName) & "'"
JSRS.Open SqlStr, Conn, 1, 1
If Not JSRS.EOF Then
JSDir = KSCMS.GetConfig("JSdir")
If Left(JSDir, 1) = "/" Or Left(JSDir, 1) = "\" Then JSDir = Right(JSDir, Len(JSDir) - 1)
ReplaceAllJS = "<script language=""javascript"" src=""" & KSCMS.GetDomain & JSDir & Trim(JSRS("JSFileName")) & """></script>"
Else
ReplaceAllJS = "":JSRS.Close:Set JSRS = Nothing
End If
End Function
'*********************************************************************************************************
'函数名：RefreshJS
'作 用：发布JS
'参 数：JSName JS名称
'*********************************************************************************************************
Sub RefreshJS(JSName)
Dim JSRS, SqlStr, JSContent
Set JSRS = Server.CreateObject("ADODB.Recordset")
SqlStr = "Select * From KS_JSFile Where JSName='" & Trim(JSName) & "'"
JSRS.Open SqlStr, Conn, 1, 1
If JSRS.EOF And JSRS.BOF Then
JSRS.Close:Set JSRS = Nothing:Exit Sub
End If
Dim JSConfig, JSFileName, SaveFilePath, JSDir, JSType
JSFileName = Trim(JSRS("JSFileName"))
JSDir = Trim(KSCMS.GetConfig("JSDir"))
JSType = Trim(JSRS("JSType"))
If Left(JSDir, 1) = "/" Or Left(JSDir, 1) = "\" Then JSDir = Right(JSDir, Len(JSDir) - 1)
SaveFilePath = KSCMS.GetConfig("InstallDir") & JSDir
Call KSCMS.CreateListFolder(SaveFilePath)
JSConfig = Trim(JSRS("JSConfig"))
If JSType = "0" Then
JSConfig = Replace(Trim(JSRS("JSConfig")), """", "") '替换原参数的双引号为空
JSContent=Replace(Replace(Replace(KSLabel.ChangeLableToFunction(JSConfig), Chr(13) & Chr(10), ""),"'","\'"),"""","\""")
JSContent = "document.write('" & JSContent & "');"
Else
Dim FreeType
FreeType = Left(JSConfig, InStr(JSConfig, ",") - 1) '取出自由JS的类型
JSConfig = Replace(JSConfig, FreeType & ",", "")
Select Case FreeType '根据函数做相应的操作
Case "GetExtJS" '扩展JS
JSConfig = Replace(JSConfig, "'", """")
JSConfig = ReplaceLableFlag(ReplaceAllLabel(JSConfig))
JSConfig = ReplaceGeneralLabelContent(JSConfig)
JSConfig = Replace(Replace(Replace(JSConfig, Published, ""),"'","\'"),"""","\""")
JSContent = ReplaceJsBr(JSConfig)
'JSContent = "document.write('" & JSConfig & "');"
Case "GetWordJS"
JSConfig = Replace(Trim(JSConfig), """", "") '替换原参数的双引号为空
JSContent = RefreshWordJS(Trim(JSRS("JSID")), JSConfig) '替换文字JS
Case "GetPicJS"
JSConfig = Replace(Trim(JSConfig), """", "") '替换原参数的双引号为空
JSContent = RefreshPicJS(Trim(JSRS("JSID")), JSConfig) '替换图像JS
Case Else
JSContent = ""
End Select
End If
'JSConfig = ReplaceRA(JSConfig, "") '相对路径与绝对路径的替换
Call FSOSaveFile(JSContent, SaveFilePath & JSFileName)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -