📄 ks.rcls.asp
字号:
<!--#include file="KS.LabelCls.asp"-->
<!--#include file="KS.ManageCls.asp"-->
<!--#include file="KS.R.LCls.asp"-->
<!--#include file="KS.R.SCls.asp"-->
<!--#include file="KS.DIYCls.asp"-->
<%
Class Refresh
Private KS,KSLabel,KSCls ,DomainStr
Private Sub Class_Initialize()
Set KS=New PublicCls
Set KSCls=New ManageCls
Set KSLabel =New RefreshFunction
DomainStr=KS.GetDomain
End Sub
Private Sub Class_Terminate()
Set KS=Nothing
Set KSCls=Nothing
Set KSLabel=Nothing
End Sub
'替换所有标签
Public Function KSLabelReplaceAll(F_C)
F_C = ReplaceGeneralLabelContent(F_C) '替换通用标签 如{$GetWebmaster}
F_C = ReplaceLableFlag(ReplaceAllLabel(F_C)) '替换函数标签
F_C = ReplaceRA(F_C, "")
KSLabelReplaceAll=F_C
End Function
'*******************************************************************************************************
'函数名：LoadTemplate
'作 用：取出模板内容
'参 数：TemplateFname模板地址
'返回值：模板内容
'********************************************************************************************************
Function LoadTemplate(TemplateFname)
on error resume next
' If Application(KS.SiteSN & TemplateFname)="" Then
Dim FSO, FileObj, FileStreamObj
Set FSO = CreateObject(KS.Setting(99))
TemplateFname = Server.MapPath(Replace(TemplateFname, "//", "/"))
If FSO.FileExists(TemplateFname) = False Then
LoadTemplate = "模板不存在,请先绑定!"
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
LoadTemplate=LoadTemplate & Published
' Application(KS.SiteSN &TemplateFname)=LoadTemplate
' End If
' LoadTemplate=Application(KS.SiteSN &TemplateFname)
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)
Content=ReplaceLabel(Content)
Dim DCls:Set Dcls=New DIYCls
Content=DCls.ReplaceUserFunctionLabel(Content) '替换自定义函数标签
Set DCls=nothing
ReplaceAllLabel =Content
End Function
'替换标签
Public Function ReplaceLabel(Byval sTrC)
dim sRow,sCol,i
KS.Name="ReplaceLabel"
if KS.ObjIsEmpty() then
Dim RS:Set RS = Server.CreateObject("ADODB.Recordset")
RS.Open "Select LabelType,LabelName,LabelContent,ID from KS_Label Where LabelType<>5", Conn, 1, 1
if RS.bof or RS.eof then
KS.Value=""
else
KS.Value=RS.GetString(,,"^||^","^%%%^","")
end if
RS.Close:Set RS = Nothing
end if
if KS.Value<>"" then
sRow=Split(KS.Value,"^%%%^")
for i=0 to Ubound(sRow)-1
sCol=Split(sRow(i),"^||^")
If sCol(0) = 1 Then
sTrC = Replace(sTrC, sCol(1), ReplaceFreeLabel(sCol(2))) '此处影响生成速度
Else
' If Instr(sCol(2),"Last")>0 Then
sTrC = Replace(sTrC,trim(sCol(1)),Replace(sCol(2),")}","," & sCol(3) &")}"))
' Else
' sTrC = Replace(sTrC,trim(sCol(1)),sCol(2))
' End If
End IF
next
end if
KS.Name="ReplaceJS"
if KS.ObjIsEmpty() then
Dim RSJ:Set RSJ = Server.CreateObject("ADODB.Recordset")
RSJ.Open "Select JSName FROM KS_JSFile", Conn, 1, 1
if RSJ.bof or RSJ.eof then
KS.Value=""
else
KS.Value=RSJ.GetString(,,"","^%%%^","")
end if
Set RSJ = Nothing
end if
if KS.Value<>"" then
sRow=Split(KS.Value,"^%%%^")
for i=0 to Ubound(sRow)-1
sTrC = Replace(sTrC,sRow(i),ReplaceAllJS(sRow(i)))
next
end if
ReplaceLabel=sTrC
End Function
Function ReplaceAllJS(JSName)
Dim JSRS:Set JSRS = Server.CreateObject("ADODB.Recordset")
JSRS.Open "Select * from KS_JSFile Where JSName='" & JSName & "'", Conn, 1, 1
If Not JSRS.EOF Then
ReplaceAllJS = "<script language=""javascript"" src=""" & Replace(KS.Setting(3) & KS.Setting(93),"//","/") & Trim(JSRS("JSFileName")) & """></script>"
Else
ReplaceAllJS = "":JSRS.Close:Set JSRS = Nothing
End If
End Function
'替换自由标签为内容,仅替换一级
Function ReplaceFreeLabel(sTrC)
dim sRow,sCol,i
KS.Name="ReplaceFreeLabel"
if KS.ObjIsEmpty() then
Dim RS:Set RS = Server.CreateObject("ADODB.Recordset")
RS.Open "Select LabelName,LabelContent,ID from KS_Label", Conn, 1, 1
if RS.bof or RS.eof then
KS.Value=""
else
KS.Value=RS.GetString(,,"^||^","^%%%^","")
end if
RS.Close:Set RS = Nothing
end if
if KS.Value<>"" then
sRow=Split(KS.Value,"^%%%^")
for i=0 to Ubound(sRow)-1
sCol=Split(sRow(i),"^||^")
sTrC = Replace(sTrC,trim(sCol(0)),Replace(sCol(1),")}","," & sCol(2) &")}"))
next
end if
ReplaceFreeLabel = ReplaceGeneralLabelContent(sTrC)
End Function
'*********************************************************************************************************
'函数名：FSOSaveFile
'作 用：生成文件
'参 数： Content内容,路径 注意虚拟目录
'*********************************************************************************************************
Sub FSOSaveFile(Content, LocalFileName)
Dim FSO, FileObj
Set FSO = Server.CreateObject(KS.Setting(99))
Set FileObj = FSO.CreateTextFile(Server.MapPath(LocalFileName), True) '创建文件
FileObj.Write Content
FileObj.Close '释放对象
Set FileObj = Nothing:Set FSO = Nothing
End Sub
'*********************************************************************************************************
'函数名：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(KS.Setting(93))
JSType = Trim(JSRS("JSType"))
If Left(JSDir, 1) = "/" Or Left(JSDir, 1) = "\" Then JSDir = Right(JSDir, Len(JSDir) - 1)
SaveFilePath = KS.Setting(3) & JSDir
Call KS.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)
JSRS.Close:Set JSRS = Nothing
End Sub
Function ReplaceJsBr(Content)
Dim i
Dim JsArr:JSArr=Split(Content,Chr(13) & Chr(10))
For I=0 To Ubound(JsArr)
ReplaceJsBr=ReplaceJsBr & "document.writeln('" & JsArr(I) &"')" & vbcrlf
Next
End Function
'*********************************************************************************************************
'函数名：RefreshWordJS
'作 用：发布文字JS
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -