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
%>