staple.asp

来自「WAPmo手机网站管理平台是一款创建与管理维护WAP网站的的软件产品」· ASP 代码 · 共 132 行

<%
Class ImplMocomWAPmoWAPStaple
Public Sub main()
    If MyIO.Env("REQUEST_METHOD") = "post" Then
        Call doPost
    Else
        Call doGet
    End If
End Sub

Private Sub doGet()
    Dim lngID
    Dim intPage
    Dim MyAPI
    Dim MyCore
    Dim strName
    Dim blnParse
    lngID = atol(MyIO.QueryString("StapleId"))
    intPage = atoi(MyIO.QueryString("PageNo"))
    If intPage < 1 Then intPage = 1
    If lngID < 1 Then
        MyRedirect "index.asp"
    ElseIf Not ExportCache(lngID, intPage) Then
        Set MyAPI = New ImplFactory
        Set MyCore = vbsre.mocom.WAPmo.WAP.Core
        Set MyXML = MyKernel.XMLParser
        blnParse = False
        If Not MyCore.CheckStaple() Then
            MyRedirect "index.asp"
        ElseIf MyCore.Staple("Category") = wmStapleLinking Then
            Call doLog("staple", MyCore.Staple("SeqId"), MyIO.Env("REQUEST_URI"))
            MyRedirect MyCore.Staple("Content")
        Else
            MyXML.Printf MyXML.CreateC("UserStatus_" & MyCore.Staple("UserStatus"))
            MyXML.Printf MyXML.CreateC("Mark_" & MyCore.Staple("Mark"))
            strName = MyCore.Staple("Templet")
            If strName = "" Then strName = GetIndexTemplet(IIf(MyCore.Staple("Follow") = 0, 2, 3))
            If strName <> "" Then blnParse = MyAPI.Parse(strName)
            If Not blnParse Then
                blnParse = MyAPI.ParseString(GetFileString(GetMapPath("templet/" & IIf(MyCore.Staple("Follow") = 0, 2, 3) & ".tpl"), "gb2312"))
            End If
            If blnParse Then
                Call SetLog("staple", MyCore.Staple("SeqId"))
                If MyKernel.Config("CheckXHTML") = "1" Then
                    MyXML.TransformToObject "xhtml", GetStaplePath(lngID, MyCore.PageNo, "xml")
                    MyXML.TransformToObject "wml", GetStaplePath(lngID, MyCore.PageNo, "wml")
                    MyXML.TransformToObject "html", GetStaplePath(lngID, MyCore.PageNo, "html")
                Else
                    MyXML.TransformToObject "wml", GetStaplePath(lngID, MyCore.PageNo, "wml")
                End If
                Call ExportCache(lngID, MyCore.PageNo)
            Else
                MyXML.Println "模板解析错误，请稍后访问"
                Call MyKernel.OutputXML(Empty)
            End If
        End If
        Set MyCore = Nothing
        Set MyAPI = Nothing
    End If
End Sub

Private Sub doPost()
End Sub

Private Function GetStaplePath(ByVal lngID, ByVal intPageNo, ByVal strExt)
    Dim tmp
    tmp = str_format("cache/staple$0/index_$1.$2", Array(lngID , intPageNo, strExt))
    DetectFile GetMapPath(""), tmp
    GetStaplePath = GetMapPath(tmp)
End Function

Private Function ExportCache(ByVal lngID, ByVal intPageNo)
    Dim strPath
    Dim strTemp
    Select Case MyKernel.NetType
    Case "wap20"
        strPath = GetStaplePath(lngID, intPageNo, "xml")
    Case "wap12"
        strPath = GetStaplePath(lngID, intPageNo, "wml")
    Case "web"
        strPath = GetStaplePath(lngID, intPageNo, "html")
    End Select
    If Not fso.FileExists(strPath) Then
        ExportCache = False
    Else
        strTemp = GetFileString(strPath, "UTF-8")
        If strTemp = "" Then
            ExportCache = False
        ElseIf ValidVisit(strTemp) Then
            ExportCache = True
            Response.Charset = "utf-8"
            Response.ContentType = GetContentType()
            Call FormatXML(strTemp)
        End If
    End If
End Function

Private Function GetContentType()
    Select Case MyKernel.NetType
    Case "wap20"
        GetContentType = "application/vnd.wap.xhtml+xml"
    Case "wap12"
        GetContentType = "text/vnd.wap.wml"
    Case "web"
        GetContentType = "text/html"
    End Select
End Function

Private Function ValidVisit(ByVal strData)
    Dim arr, intStatus
    arr = reg_match("<\!\-\-UserStatus_([\d]+)\-\->", "", strData)
    If IsArray(arr) Then
        intStatus = atol(arr(0))
        ValidVisit = CBool(atol(MyKernel.Memory("Status")) >= intStatus)
        If Not ValidVisit Then
            If intStatus = wmUserRegister Then
                ExportError 403.3
            Else
                ExportError 403.4
            End If
        End If
    Else
        ValidVisit = True
    End If
End Function

Public Function newInstance()
    Set newInstance = New ImplMocomWAPmoWAPStaple
End Function
End Class
%>