content.asp

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

<%
Class ImplMocomWAPmoWAPContent
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 intPageId
    Dim lngFollow
    Dim lngTime
    Dim MyAPI, MyCore
    Dim strName
    Dim blnParse
    lngID = atol(MyIO.QueryString("ContentId"))
    intPageId = atoi(MyIO.QueryString("PageId"))
    lngFollow = atol(MyIO.QueryString("StapleId"))
    lngTime = atol(MyIO.QueryString("Intime"))
    If intPageId <= 0 Then intPageId = 1
    If lngID < 1 Then
        MyRedirect "index.asp"
    ElseIf Not ExportCache(lngID, lngTime, lngFollow, intPageId) Then
        Set MyAPI = New ImplFactory
        Set MyCore = vbsre.mocom.WAPmo.WAP.Core
        Set MyXML = MyKernel.XMLParser
        blnParse = False
        If Not MyCore.CheckContent() Then
            MyRedirect "index.asp"
        ElseIf MyCore.Content("Category") = wmContentLinking Then
            Call doLog("content", MyCore.Content("SeqId"), MyIO.Env("REQUEST_URI"))
            MyRedirect MyCore.Content("Content")
        Else
            MyXML.Printf MyXML.CreateC("UserStatus_" & MyCore.Staple("UserStatus"))
            MyXML.Printf MyXML.CreateC("Mark_" & MyCore.Staple("Mark"))
            strName = MyCore.Content("Templet")
            If strName = "" Then strName = MyCore.Staple("ContentTemplet")
            If strName = "" Then strName = GetIndexTemplet(4)
            If strName <> "" Then blnParse = MyAPI.Parse(strName)
            If Not blnParse Then
                blnParse = MyAPI.ParseString(GetFileString(GetMapPath("templet/4.tpl"), "gb2312"))
            End If
            If blnParse Then
                Call SetLog("content", MyCore.Content("SeqId"))
                If MyKernel.Config("CheckXHTML") = "1" Then
                    MyXML.TransformToObject "xhtml", GetContentPath(lngID, MyCore.Content("Intime"), lngFollow, MyCore.PageId, "xml")
                    MyXML.TransformToObject "wml", GetContentPath(lngID, MyCore.Content("Intime"), lngFollow, MyCore.PageId, "wml")
                    MyXML.TransformToObject "html", GetContentPath(lngID, MyCore.Content("Intime"), lngFollow, MyCore.PageId, "html")
                Else
                    MyXML.TransformToObject "wml", GetContentPath(lngID, MyCore.Content("Intime"), lngFollow, MyCore.PageId, "wml")
                End If
                Call ExportCache(lngID, MyCore.Content("Intime"), lngFollow, MyCore.PageId)
            Else
                MyXML.Println "模板解析错误，请稍后访问"
                Call MyKernel.OutputXML(Empty)
            End If
        End If
        Set MyCore = Nothing
        Set MyAPI = Nothing
    End If
End Sub

Private Function GetContentPath(ByVal lngID, ByVal lngTime, ByVal lngFollow, ByVal intPageId, ByVal strExt)
    Dim tmp
    tmp = str_format("cache/staple$0/$1/index_$2_$3.$4", Array(lngFollow, FormatTime(lngTime, "Ymd"), lngID, intPageId, strExt))
    DetectFile GetMapPath(""), tmp
    GetContentPath = GetMapPath(tmp)
End Function

Private Function ExportCache(ByVal lngID, ByVal lngTime, ByVal lngFollow, ByVal intPageId)
    Dim strPath
    Dim strTemp
    Select Case MyKernel.NetType
    Case "wap20"
        strPath = GetContentPath(lngID, lngTime, lngFollow, intPageId, "xml")
    Case "wap12"
        strPath = GetContentPath(lngID, lngTime, lngFollow, intPageId, "wml")
    Case "web"
        strPath = GetContentPath(lngID, lngTime, lngFollow, intPageId, "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()
            strTemp = FormatRemark(strTemp)
            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

Private Function FormatRemark(ByVal strData)
    Dim arr, ret, intType
    arr = reg_match("<\!--RemarkType_(\d+)-->", "", strData)
    ret = strData
    If IsArray(arr) Then
        If Not IsGuest() Then
            ret = ReplaceC(ret, "UserName", "")
        ElseIf atoi(arr(0)) = 0 Then
            ret = ReplaceC(ret, "RemarkForm", "")
        End IF
    End If
    FormatRemark = ret
End Function

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