content

WAP手机网页XXXXX WAP手机网页XXXXX

Public Sub main()
    If Request.ServerVariables("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
    Dim MyCore
    Dim strName
    Dim blnParse
    lngId = atol(Request.QueryString("ContentId"))
    intPageId = atoi(Request.QueryString("PageId"))
    lngFollow = atol(Request.QueryString("StapleId"))
    lngTime = atol(Request.QueryString("Intime"))
    If intPageId <= 0 Then intPageId = 1
    If lngId < 1 Then
        MyRedirect "index.asp"
    ElseIf Not ExportCache(lngId, lngTime, lngFollow, intPageId) Then
        Set MyXML = MyKernel.XMLParser
        Set MyAPI = New ImplFactory
        Set MyCore = MyAPI.Core
        blnParse = False
        If Not MyCore.CheckContent() Then
            MyRedirect "index.asp"
        ElseIf MyCore.Content("Category") = wmContentLinking Then
            Call doLog("content", MyCore.Content("SeqId"), MyKernel.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 "模板解析错误，请稍后访问"
                MyXML.Transform Response
            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 strPath
    Dim fso
    Set fso = vbsre.mocom.util.com.forName("Scripting.FileSystemObject")
    strPath = getMapPath("cache/staple" & lngFollow)
    If Not fso.FolderExists(strPath) Then fso.CreateFolder strPath
    strPath = strPath & "\" & TimeFormat(getDate(lngTime), "Ymd")
    If Not fso.FolderExists(strPath) Then fso.CreateFolder strPath
    strPath = strPath & "\index_" & lngId & "_" & intPageId & "." & strExt
    getContentPath = strPath
    Set fso = Nothing
End Function

Private Function ExportCache(ByVal lngId, ByVal lngTime, ByVal lngFollow, ByVal intPageId)
    Dim strPath
    Dim strTemp
    Select Case MyKernel.Env("XML_DOCTYPE")
    Case "xhtml"
        strPath = getContentPath(lngId, lngTime, lngFollow, intPageId, "xml")
    Case "wml"
        strPath = getContentPath(lngId, lngTime, lngFollow, intPageId, "wml")
    Case "html"
        strPath = getContentPath(lngId, lngTime, lngFollow, intPageId, "html")
    End Select
    strTemp = getFileString(strPath, "UTF-8")
    If strTemp = "" Then
        ExportCache = False
    ElseIf ValidVisit(strTemp) Then
        ExportCache = True
        Response.Charset = "utf-8"
        Response.ContentType = MyKernel.Env("XML_CONTENTTYPE")
        strTemp = FormatRemark(strTemp)
        MyIO.Echo FormatXML(strTemp)
    End If
End Function

Private Function ValidVisit(ByVal strData)
    Dim reg, arr
    Dim intStatus
    Set reg = New RegExp
    reg.Pattern = "<\!--UserStatus_([\d]+)-->"
    Set arr = reg.Execute(strData)
    If arr.Count > 0 Then
        intStatus = atol(arr(0).SubMatches(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
    Set arr = Nothing
    Set reg = Nothing
End Function

Private Function FormatRemark(ByVal strData)
    Dim strTemp
    Dim reg, arr
    Dim intType
    strTemp = strData
    Set reg = New RegExp
    reg.Pattern = "<\!--RemarkType_(\d+)-->"
    Set arr = reg.Execute(strData)
    If arr.Count > 0 Then
        intType = atoi(arr(0).SubMatches(0))
        If Not IsGuest() Then
            strTemp = ReplaceC(strTemp, "UserName", "")
        ElseIf intType = 0 Then
            strTemp = ReplaceC(strTemp, "RemarkForm", "")
        End If
    End If
    FormatRemark = strTemp
End Function