sdcms的模板解析引擎,一个非常简单和实用的CMS

代码

<%
' ==============================
' SDCMS模板解析引擎
' Author:IT平民
' Date:2009年4-5月
' ==============================
Class Templates
Private Rs,Reg,LabelData
Private Sub Class_Initialize
Set Reg = New Regexp
Reg.Ignorecase = True
Reg.Global = True
Set LabelData = Server.CreateObject( " Scripting.Dictionary " )
End Sub

Private Sub Class_Terminate
Set LabelData = Nothing
Set Reg = Nothing
End Sub

Public Function Sql_Err(t0)
Sql_Err = " SQL语句：""<b> " & t0 & " </b>""执行失败 "
End Function

Public Function IF_Err(t0)
IF_Err = " IF标签：""<b> " & t0 & " </b>""执行失败 "
End Function

' ==============================
' 模板解析和处理
' ==============================
Public Function SDCMS_Templates(t0)
t1 = LoadFile(t0) ' 读取模板
t1 = SDCMS_Include(t1) ' 解析包含文件
t1 = SDCMS_Lable(t1) ' 解析静态变量
Labeltag = LabelData.keys
Labelval = LabelData.items
IF LabelData.Count >= 1 Then
For i = 0 To LabelData.Count - 1
t1 = Re(t1,Labeltag(i),Labelval(i))
Next
End IF
t1 = SDCMS_allclassid(t1) ' 解析常用函数
t1 = SDCMS_category(t1) ' 解析常用函数
t1 = SDCMS_Page(t1)
t1 = SDCMS_Loop(t1, True ) ' 解析循环语句
t1 = SDCMS_Loop(t1, False )
IF Instr (t1, " {sdcms:runtime} " ) > 0 Then t1 = Re(t1, " {sdcms:runtime} " ,Runtime)
SDCMS_Templates = t1
End Function

Public Function Label(t0,t1)
IF len (t0) <= 0 Then Exit Function
IF LabelData.Exists(t0) Then LabelData.Item(t0) = t1 Else LabelData.Add t0,t1
End Function

' ==============================
' 包含文件解析,不支持嵌套
' ==============================
Public Function SDCMS_Include(t0)
Reg.Pattern = " {sdcms:include\(['""](.+?)['""]\)} "
Set Matches = Reg.Execute(t0)
For Each Match In Matches
t0 = Re(t0,Match.value,LoadFile(Load_temp_dir & Match.SubMatches( 0 )))
Next
SDCMS_Include = t0
End Function

' ==============================
' 静态标签解析
' ==============================
Public Function SDCMS_Lable(t0)
SDCMS_Lable = t0
' 先解析自定义标签
t1 = Load_Freelabel
IF Isarray (t1) Then
For I = 0 To UBound (t1, 2 )
IF Instr (SDCMS_Lable, " {sdcms_ " & t1( 0 ,I) & " } " ) > 0 Then
SDCMS_Lable = Re(SDCMS_Lable, " {sdcms_ " & t1( 0 ,I) & " } " ,t1( 1 ,I))
End IF
Next
End IF
SDCMS_Lable = Re(SDCMS_Lable, " {date()} " ,SDCMS_date())
SDCMS_Lable = Re(SDCMS_Lable, " {now()} " , Now ())
SDCMS_Lable = Re(SDCMS_Lable, " {sdcms:webname} " ,sdcms_webname)
SDCMS_Lable = Re(SDCMS_Lable, " {sdcms:weburl} " ,sdcms_weburl)
SDCMS_Lable = Re(SDCMS_Lable, " {sdcms:webkey} " ,LoadRecord( " webkey " , " sd_const " , " 1 " ))
SDCMS_Lable = Re(SDCMS_Lable, " {sdcms:webdec} " ,LoadRecord( " webdec " , " sd_const " , " 1 " ))
SDCMS_Lable = Re(SDCMS_Lable, " {sdcms:root} " ,sdcms_root)
SDCMS_Lable = Re(SDCMS_Lable, " {sdcms:htmdir} " ,sdcms_htmdir)
SDCMS_Lable = Re(SDCMS_Lable, " {sdcms:filetxt} " ,sdcms_filetxt)
SDCMS_Lable = Re(SDCMS_Lable, " {sdcms:length} " ,Sdcms_length)
SDCMS_Lable = Re(SDCMS_Lable, " {sdcms:skins} " ,Sdcms_skin_author)
SDCMS_Lable = Re(SDCMS_Lable, " {sdcms:version} " ,sdcms_version)
SDCMS_Lable = Re(SDCMS_Lable, " {sdcms:Spider} " , " <script language=""javascript"">Get_Spider();</script> " )
End Function

' ==============================
' 循环标签解析
' ==============================
Public Function SDCMS_Loop(t0,t1)
t0 = Re(t0, chr ( 10 ), "" )
IF t1 then Reg.Pattern = " \{@sdcms:loop(.+?)\}(.+?)\{/@sdcms:loop\} " else Reg.Pattern = " \{sdcms:loop(.+?)\}(.+?)\{/sdcms:loop\} "
Set Matches = Reg.Execute(t0)
For Each Match In Matches
t2 = Match.SubMatches( 0 )
t3 = Getloop(Match.SubMatches( 1 ), 0 ,t1)
t4 = Getloop(Match.SubMatches( 1 ), 1 ,t1)
tag_field = Getlable(t2, " field " )
tag_table = Getlable(t2, " table " )
tag_top = Getlable(t2, " top " )
tag_where = Getlable(t2, " where " )
tag_order = Getlable(t2, " order " )
IF Len (tag_field) = 0 Then tag_field = " * "
IF len (tag_top) = 0 Then tag_top = 10
IF tag_order = "" then tag_order = " id desc "
IF t1 Then
t0 = Re(t0,match.value,Get_Table(t3,t4,tag_top,tag_where,tag_order,tag_table, True ,tag_field))
Else
t0 = Re(t0,match.value,Get_Table(t3,t4,tag_top,tag_where,tag_order,tag_table, False ,tag_field))
End If
Next
SDCMS_Loop = t0
End Function

' ==============================
' 分页循环标签解析
' ==============================
Public Function SDCMS_Page(t0)
t0 = Re(t0, chr ( 10 ), "" )
Reg.Pattern = " \{sdcms:page(.+?)\}(.+?)\{/sdcms:page\} "
Set Matches = Reg.Execute(t0)
For Each Match In Matches
t1 = Match.SubMatches( 0 )
t2 = Getloop(Match.SubMatches( 1 ), 0 , false )
t3 = Getloop(Match.SubMatches( 1 ), 1 , false )
tag_field = Getlable(t2, " field " )
tag_table = Getlable(t1, " table " )
tag_where = Getlable(t1, " where " )
tag_order = Getlable(t1, " order " )
tag_page = Getlable(t1, " pages " ) ' 当前第几页
IF Len (tag_field) = 0 Then tag_field = " * "
IF tag_order = "" Then tag_order = " id desc "
IF tag_page = "" Or Not isnumeric (tag_page) Then tag_page = 1
t0 = Re(t0,match.value,Get_Page(t2,t3,tag_table,tag_where,tag_order,tag_page,tag_field))
Next
SDCMS_Page = t0
End Function

' ==============================
' 循环标签参数解析
' ==============================
Public Function Getlable(t0,t1)
t0 = Lcase (t0)
IF Len (t0) <= 3 or Instr (t0, " = " ) = 0 then Getlable = "" : Exit Function
Reg.Pattern = "" & t1 & " =[""](.+?)[""] "
Set Matches = Reg.Execute(t0)
For Each Match In Matches
Getlable = Lcase (Match.SubMatches( 0 ))
Next
End Function

' ==============================
' 循环标签主体解析
' ==============================
Public Function Getloop(t0,t1,t2)
If t2 Then Reg.Pattern = " <@eof>(.+?)</@eof> " Else Reg.Pattern = " <eof>(.+?)</eof> "
Set Matches = Reg.Execute(t0)
IF Matches.Count > 0 Then
For Each Match In Matches
Select Case t1
Case " 0 " :Getloop = Match.SubMatches( 0 )
Case Else :Getloop = Reg.Replace(t0, "" )
End Select
Next
Else
Select Case t1
Case " 0 " :Getloop = ""
Case Else :Getloop = t0
End Select
End IF
End Function

' ==============================
' 一维单标签属性解析
' ==============================
Public Function Single_tag(t0,t1)
On Error Resume Next
IF t1 Then Reg.Pattern = " {@(.+?)} " Else Reg.Pattern = " {(.+?)} "
Set Matches = Reg.Execute(t0)
For Each Match In Matches
t2 = Match.SubMatches( 0 )
Tag_len = Getlable(t2, " len " )
Tag_date = Getlable(t2, " date " )
Tag_function = Getlable(t2, " function " )
t3 = Split (t2, " " )( 0 )
t3 = rs(t3)

IF Len (Tag_function) > 0 Then
Tag_functions = Split (Tag_function, " , " )
Select Case Lcase (Tag_functions( 0 ))
Case " nohtml " :t3 = NoHtml(t3)
Case " ubound " :t3 = Ubound ( Split (t3, " | " ))
Case " len " : IF IsNull (t3) Then t3 = 0 Else t3 = Len (t3)
Case " urlencode " :t3 = Server.URLEncode(t3)
Case " urldecode " :t3 = URLDecode(t3)
Case " total " :t3 = Eval (Re( Left (t3, Len (t3) - 1 ), " | " , " + " ))
Case " keyword " :t3 = Highlight(t3,Tag_functions( 1 ))
End Select
End IF

IF Len (Tag_Len) > 0 Then
IF IsNumeric (Tag_Len) Then
t3 = GotTopic(t3, Clng (Tag_Len))
End IF
End IF

IF Len (Tag_date) > 0 Then
t4 = Tag_date
IF InStr (t4, " week " ) > 0 Then t4 = Re(t4, " week " , WeekDayName ( weekday (t3)))
IF InStr (t4, " yyyy " ) > 0 Then t4 = Re(t4, " yyyy " , Year (t3))
IF InStr (t4, " yy " ) > 0 Then t4 = Re(t4, " yy " , Right ( Year (t3), 2 ))
IF InStr (t4, " mm " ) > 0 Then t4 = Re(t4, " mm " , Right ( " 0 " & Month (t3), 2 ))
IF InStr (t4, " dd " ) > 0 Then t4 = Re(t4, " dd " , Right ( " 0 " & Day (t3), 2 ))
IF InStr (t4, " hh " ) > 0 Then t4 = Re(t4, " hh " , Right ( " 0 " & Hour (t3), 2 ))
IF InStr (t4, " ff " ) > 0 Then t4 = Re(t4, " ff " , Right ( " 0 " & Minute (t3), 2 ))
IF InStr (t4, " ss " ) > 0 Then t4 = Re(t4, " ss " , Right ( " 0 " & Second (t3), 2 ))
IF InStr (t4, " m " ) > 0 Then t4 = Re(t4, " m " , Month (t3))
IF InStr (t4, " d " ) > 0 Then t4 = Re(t4, " d " , Day (t3))
IF InStr (t4, " h " ) > 0 Then t4 = Re(t4, " h " , Hour (t3))
IF InStr (t4, " f " ) > 0 Then t4 = Re(t4, " f " , Minute (t3))
IF InStr (t4, " s " ) > 0 Then t4 = Re(t4, " s " , Second (t3))
t3 = t4
End IF

t0 = Re(t0,Match.Value,t3)
Next
IF Instr (t0, " [for k=0 " ) > 0 Then Single_tag = Loop_For(Loop_IF(t0,t1)) Else Single_tag = Loop_IF(t0,t1)
End Function

' ==============================
' Loop里的IF解析
' ==============================
Public Function Loop_IF(t0,t1)
On Error Resume Next
IF t1 Then Reg.Pattern = " \[@IF(.+?)\](.+?)\[@End IF\] " Else Reg.Pattern = " \[IF(.+?)\](.+?)\[End IF\] "
Set Matches = Reg.Execute(t0)
For Each Match In Matches
IF t1 Then t3 = Split (Match.SubMatches( 1 ), " [@else] " ) Else t3 = Split (Match.SubMatches( 1 ), " [else] " )
IF Ubound (t3) Then t4 = t3( 1 ):t5 = t3( 0 ) Else t4 = "" :t5 = Match.SubMatches( 1 )
Execute ( " IF " & Match.SubMatches( 0 ) & " Then t2 = True Else t2 = False " )
IF t2 Then t0 = Re(t0,Match.Value,t5) Else t0 = Re(t0, Match.Value,t4)
IF Err Then Echo "" & IF_Err(Match.SubMatches( 0 ) & " 错误提示： " & Err.Description) & " ] " : Err.Clear:Died
Next
Loop_IF = t0
End Function

' ==============================
' Loop里的For Next解析,只用于投票
' ==============================
Public Function Loop_For(t0)
On Error Resume Next
Reg.Pattern = " \[for k=(.+?)to(.+?)\](.+?)\[vote=(.+?)\]\[result=(.+?)\]\[Next\] "
Set Matches = Reg.Execute(t0)
For Each Match In Matches
t1 = Trim (Match.SubMatches( 0 ))
t2 = Trim (Match.SubMatches( 1 ))
t3 = Trim (Match.SubMatches( 2 ))
t4 = Trim (Match.SubMatches( 3 ))
t5 = Trim (Match.SubMatches( 4 ))
t4 = split (t4, " | " ):t7 = eval (Re( left (t5, len (t5) - 1 ), " | " , " + " )):t5 = split (t5, " | " )
t6 = ""
For k = t1 To t2 - 1
t6 = t6 & Re(t3, " [k] " ,k):t6 = Re(t6, " [vote] " ,t4(k))
IF t5(k) > 0 Then
t6 = Re(t6, " [Percent] " , Formatpercent (t5(k) / t7, 0 ))
Else
t6 = Re(t6, " [Percent] " , " 0% " )
End IF
Next
t0 = Re(t0,Match.Value,t6)
Next
Loop_For = t0
End Function

' ==============================
' 子类别信息解析
' ==============================
Public Function SDCMS_allclassid(t0)
Reg.Pattern = " {sdcms:allclassid\((.+?)\)} "
Set Matches = Reg.Execute(t0)
For Each Match In Matches
t0 = Re(t0,Match.value,get_son_classid(Match.SubMatches( 0 )))
Next
SDCMS_allclassid = t0
End Function

' ==============================
' 类别连接解析
' ==============================
Public Function SDCMS_category(t0)
Reg.Pattern = " {sdcms:category\((.+?)\)} "
Set Matches = Reg.Execute(t0)
For Each Match In Matches
t0 = Re(t0,Match.value,get_category(Match.SubMatches( 0 )))
Next
SDCMS_category = t0
End Function


Public Function Get_Table(t0,t1,t2,t3,t4,t5,t6,t7)
On Error Resume Next
Get_Table = ""
IF t2 > 0 Then t8 = " top " & t2 & ""
Sql = " select " & t8 & " " & t7 & " from " & t5 & " " & t3 & ""
IF t4 = " rnd " Then
IF Is_sql Then
Randomize
Sql = Sql & " order by rnd(-(id + " & rnd () & " )) "
Else
Sql = Sql & " order by newid() "
End IF
Else
IF t4 <> " 0 " Then
Sql = Sql & " order by " & t4
End IF
End IF
Set Rs = Conn.Execute(Sql)
If Err Then Err.Clear:Get_Table = Sql_Err(sql): Exit Function
If Rs.Eof Then
Get_Table = t0
End if
i = 1 :j = 0
While Not Rs.Eof
get_loops = t1

IF t6 Then
IF Instr (get_loops, " {@i} " ) > 0 Then get_loops = Re(get_loops, " {@i} " ,i)
IF Instr (get_loops, " {@j} " ) > 0 Then get_loops = Re(get_loops, " {@j} " ,j)
IF t5 = " sd_info " Then
IF Instr (get_loops, " {@link} " ) > 0 Then
get_loops = Re(get_loops, " {@link} " ,sdcms_root & sdcms_htmdir & LoadRecord( " classdir " , " sd_class " ,rs( " classid " )) & rs( " htmlname " ) & sdcms_filetxt)
End IF
IF Instr (get_loops, " {@tags} " ) > 0 Then
get_loops = Re(get_loops, " {@tags} " ,get_tags(rs( " tags " )))
End IF
IF Instr (get_loops, " {@classurl} " ) > 0 Then
get_loops = Re(get_loops, " {@classurl} " ,sdcms_root & sdcms_htmdir & LoadRecord( " classdir " , " sd_class " ,rs( " classid " )))
End IF
IF Instr (get_loops, " {@classname} " ) > 0 Then
get_loops = Re(get_loops, " {@classname} " ,LoadRecord( " title " , " sd_class " ,rs( " classid " )))
End IF
End IF
IF Lcase (t5) = " sd_comment " Then
IF Instr (get_loops, " {@link} " ) > 0 Then
classid = LoadRecord( " classid " , " sd_info " ,rs( " infoid " ))
htmlname = LoadRecord( " htmlname " , " sd_info " ,rs( " infoid " ))
get_loops = Re(get_loops, " {@link} " ,sdcms_root & sdcms_htmdir & LoadRecord( " classdir " , " sd_class " ,classid) & htmlname & sdcms_filetxt)
End IF
End IF
Else
IF Instr (get_loops, " {i} " ) > 0 Then get_loops = Re(get_loops, " {i} " ,i)
IF Instr (get_loops, " {j} " ) > 0 Then get_loops = Re(get_loops, " {j} " ,j)
IF t5 = " sd_info " Then
IF Instr (get_loops, " {link} " ) > 0 Then
get_loops = Re(get_loops, " {link} " ,sdcms_root & sdcms_htmdir & LoadRecord( " classdir " , " sd_class " ,rs( " classid " )) & rs( " htmlname " ) & sdcms_filetxt)
End IF
IF Instr (get_loops, " {tags} " ) > 0 Then
get_loops = Re(get_loops, " {tags} " ,get_tags(rs( " tags " )))
End IF
IF Instr (get_loops, " {classurl} " ) > 0 Then
get_loops = Re(get_loops, " {classurl} " ,sdcms_root & sdcms_htmdir & LoadRecord( " classdir " , " sd_class " ,rs( " classid " )))
End IF
IF Instr (get_loops, " {classname} " ) > 0 Then
get_loops = Re(get_loops, " {classname} " ,LoadRecord( " title " , " sd_class " ,rs( " classid " )))
End IF
End IF
IF Lcase (t5) = " sd_comment " Then
IF Instr (get_loops, " {link} " ) > 0 Then
classid = LoadRecord( " classid " , " sd_info " ,rs( " infoid " ))
htmlname = LoadRecord( " htmlname " , " sd_info " ,rs( " infoid " ))
get_loops = Re(get_loops, " {link} " ,sdcms_root & sdcms_htmdir & LoadRecord( " classdir " , " sd_class " ,classid) & htmlname & sdcms_filetxt)
End IF
End IF
End if
Get_Table = Get_Table & Single_tag(get_loops,t6)
i = i + 1 :j = j + 1
Rs.Movenext
Wend
End Function

Public Function Get_Page(t0,t1,t2,t3,t4,t5,t6)
Get_Page = Empty
Set Rs = Server.CreateObject( " adodb.recordset " )
sql = " select " & t6 & " from " & t2 & " " & t3 & " order by " & t4 & ""
rs.Open sql,conn, 1 , 1
IF rs.Eof And rs.bof Then
Get_Page = t0
Else
rs.PageSize = classpage
rs.Absolutepage = t5
rcount1 = 0
While Not Rs.Eof And rcount1 < rs.Pagesize
get_loops = t1
IF t2 = " sd_info " Then
IF Instr (get_loops, " {link} " ) > 0 Then
get_loops = Re(get_loops, " {link} " ,sdcms_root & sdcms_htmdir & LoadRecord( " classdir " , " sd_class " ,rs( " classid " )) & rs( " htmlname " ) & sdcms_filetxt)
End IF
IF Instr (get_loops, " {tags} " ) > 0 Then
get_loops = Re(get_loops, " {tags} " ,get_tags(rs( " tags " )))
End IF
IF Instr (get_loops, " {classurl} " ) > 0 Then
get_loops = Re(get_loops, " {classurl} " ,sdcms_root & sdcms_htmdir & LoadRecord( " classdir " , " sd_class " ,rs( " classid " )))
End IF
IF Instr (get_loops, " {classname} " ) > 0 Then
get_loops = Re(get_loops, " {classname} " ,LoadRecord( " title " , " sd_class " ,rs( " classid " )))
End IF
End IF
Get_Page = Get_Page & Single_tag(get_loops, False )
rs.Movenext
rcount1 = rcount1 + 1
Wend
End IF

End Function
End Class
%>

 

转载于:https://www.cnblogs.com/netlove/archive/2010/07/03/1770460.html