core.asp

WAPmo手机网站管理平台是一款创建与管理维护WAP网站的的软件产品

        Content.CommandType = "SELECT"
        Content.Where = "HIDDEN=0 AND EXAMINE=1 AND SEQID=" & lngID
        If Not Content.Exec Then Exit Function
    End If
    If Content("SeqId") = 0 Then Exit Function
    If Content("Hidden") = 1 Then Exit Function
    CheckContent = True
End Function

Private Function GetMatterView(objMatter, ByVal intType, ByVal intWidth, ByVal intHeight, ByVal strExt)
    Dim ret
    If MyKernel.Config("IsRewrite") = "1" Then
        ret = "$(Prefix)$(Type)/$(StapleId)/$(ContentId)/$(Category)/$(Intime)/$(Width)/$(Height)/$(Matter)/$(Name).$(Ext)"
        ret = Replace(ret, "$(Type)", IIf(intType = 0, "view", "download"))
        ret = Replace(ret, "$(Category)", GetMatterName(objMatter("Category")))
    Else
        ret = "$(Prefix)view.asp?Type=$(Type)&StapleId=$(StapleId)&ContentId=$(ContentId)&Intime=$(Intime)&Matter=$(Matter)&Width=$(Width)&Height=$(Height)"
        ret = Replace(ret, "$(Type)", intType)
    End If
    If MyKernel.Modlist(moMISC) = 1 Then
        Dim arr(7)
        If IsMISCHome(Staple("SeqId"), arr) Then
            If arr(5) = 1 And arr(4) <> "" Then
                ret = Replace(ret, "$(Prefix)", arr(4))
            Else
                ret = Replace(ret, "$(Prefix)", arr(3))
            End If
        ElseIf IsMISCChild(Staple("Mark"), arr) Then
            If arr(5) = 1 And arr(4) <> "" Then
                ret = Replace(ret, "$(Prefix)", arr(4))
            Else
                ret = Replace(ret, "$(Prefix)", arr(3))
            End If
        Else
            ret = Replace(ret, "$(Prefix)", "")
        End If
    Else
        ret = Replace(ret, "$(Prefix)", "")
    End If
    ret = Replace(ret, "$(StapleId)", Staple("SeqId"))
    ret = Replace(ret, "$(ContentId)", Content("SeqId"))
    ret = Replace(ret, "$(Intime)", Content("Intime"))
    ret = Replace(ret, "$(Width)", intWidth)
    ret = Replace(ret, "$(Height)", intHeight)
    ret = Replace(ret, "$(Matter)", Hex(objMatter("Mark")))
    ret = Replace(ret, "$(Name)", objMatter("Mark"))
    ret = Replace(ret, "$(Ext)", strExt)
    GetMatterView = GetPathName(ret)
End Function

Private Function GetMISCArray()
    If IsEmpty(GetCache("WAPmo.MISC")) Then
        SetCache "WAPmo.MISC", MyKernel.DB.GetRows("SELECT SeqId,Title,Mark,MISC_Visit,MISC_Fee,MISC_Type,MISC_Code,MISC_Confirm FROM " & T_STAPLE & " WHERE IsMISC=1")
    End If
    GetMISCArray = GetCache("WAPmo.MISC")
End Function

Private Function IsMISCHome(ByVal lngID, ByRef arr())
    Dim arr1
    Dim i, k
    arr1 = GetMISCArray()
    IsMISCHome = False
    If IsEmpty(arr1) Then Exit Function
    For i = 0 To UBound(arr1, 2)
        If arr1(0, i) = atol(lngID) Then
            For k = 0 To UBound(arr1)
                arr(k) = arr1(k, i)
            Next
            IsMISCHome = True
            Exit For
        End If
    Next
End Function

Private Function IsMISCChild(ByVal strMark, ByRef arr())
    Dim arr1
    Dim i, k
    Dim strTemp
    arr1 = GetMISCArray()
    IsMISCChild = False
    If IsEmpty(arr1) Then Exit Function
    For i = 0 To UBound(arr1, 2)
        strTemp = arr1(2, i) & "_"
        If Left(strMark, Len(strTemp)) = strTemp Then
            For k = 0 To UBound(arr1)
                arr(k) = arr1(k, i)
            Next
            IsMISCChild = True
            Exit For
        End If
    Next
End Function

Private Sub ExportBackMISCHome(ByVal strPrefix, ByVal strTitle, ByVal lngID)
    Dim arr
    Dim i
    arr = GetMISCArray()
    If IsEmpty(arr) Then Exit Sub
    For i = 0 To UBound(arr, 2)
        If arr(0, i) = lngID Then
            If strPrefix = "1" Then
                MyXML.Printf MyXML.CreateA(arr(3, i) & "index.asp", Replace(strTitle, "$(StapleName)", arr(1, i)), "imgaes/home.gif", "")
            Else
                MyXML.Printf MyXML.CreateA(arr(3, i) & "index.asp", Replace(strTitle, "$(StapleName)", arr(1, i)), "", "")
            End If
            Exit Sub
        End If
    Next
End Sub

Private Sub ExportBackMISCStaple(ByVal strPrefix, ByVal strTitle, ByVal lngID, ByVal strMark)
    Dim arr
    Dim i
    Dim strTemp
    arr = GetMISCArray()
    For i = 0 To UBound(arr, 2)
        strTemp = arr(2, i) & "_"
        If Left(strMark, Len(strTemp)) = strTemp Then
            If strPrefix = "1" Then
                MyXML.Printf MyXML.CreateA(arr(3, i) & "staple.asp?StapleId=" & lngID, strTitle, "images/staple.gif", "")
            Else
                MyXML.Printf MyXML.CreateA(arr(3, i) & "staple.asp?StapleId=" & lngID, strTitle, "", "")
            End If
            Exit Sub
        End If
    Next
End Sub

Private Sub ExportMatter()
    Dim strName
    Dim objArgv
    strName = "image"
    If Content("Download") = 1 Then
        Set objArgv = GetMatterHash("id=" & Hex(Content("Matter")) & ",download=1,name=0,imageSize=1,fileSize=1,content=0,count=1")
    Else
        Set objArgv = GetMatterHash("id=" & Hex(Content("Matter")) & ",download=0")
    End If
    ParseMatter strName, objArgv, True
    Set objArgv = Nothing
End Sub

Private Sub ParseContent(ByVal strIn)
    Dim reg, arr, ptr
    Dim pos
    Dim strName
    Dim objArgv
    Dim blnMark, blnUBB
    Dim strTemp
    Set reg = New RegExp
    reg.Pattern = "\[(image|ring|video|soft|img|link),([^\[\]\r\n]+)\]"
    reg.Global = True
    reg.IgnoreCase = True
    Set arr = reg.Execute(strIn)
    pos = 1
    blnMark = CBool(Content("IsWML") = 1)
    blnUBB = CBool(Staple("IsUBB") = 1)
    For Each ptr In arr
        If ptr.FirstIndex + 1 > pos Then
            If blnMark Then
                strTemp = SubString(strIn, pos, ptr.FirstIndex + 1)
                If blnUBB Then strTemp = FormatUBB(strTemp)
                MyXML.Println MyXML.CreateT(strTemp)
            Else
                strTemp = SubString(strIn, pos, ptr.FirstIndex + 1)
                If blnUBB Then
                    strTemp = MyIO.HTMLEncode(strTemp)
                    strTemp = FormatUBB(strTemp)
                    MyXML.Println MyXML.CreateT(strTemp)
                Else
                    MyXML.Println strTemp
                End If
            End If
        End If
        pos = ptr.FirstIndex + 1 + ptr.Length
        strName = ptr.SubMatches(0)
        Set objArgv = GetMatterHash(ptr.SubMatches(1))
        ParseMatter strName, objArgv, False
        Set objArgv = Nothing
    Next
    If blnMark Then
        strTemp = Mid(strIn, pos)
        If blnUBB Then strTemp = FormatUBB(strTemp)
        MyXML.Println MyXML.CreateT(strTemp)
    Else
        strTemp = Mid(strIn, pos)
        If blnUBB Then
            strTemp = MyIO.HTMLEncode(strTemp)
            strTemp = FormatUBB(strTemp)
            MyXML.Println MyXML.CreateT(strTemp)
        Else
            MyXML.Println strTemp
        End If
    End If
    Set arr = Nothing
    Set reg = Nothing
End Sub

Private Function GetMatterHash(ByVal strIn)
    Dim arr, ret, i
    Set ret = Server.CreateObject(PROGID_HASH)
    arr = reg_matches("(\w+)=([A-Fa-f0-9]+)", "g", strIn)
    If IsArray(arr) Then
        For i = 0 To UBound(arr, 2)
            ret(arr(0, i)) = arr(1, i)
        Next
    End If
    Set GetMatterHash = ret
    Set ret = Nothing
End Function

Private Sub ParseMatter(ByVal strName, argv, ByVal blnType)
    Select Case strName
    Case "image", "ring", "video", "soft"
        Dim objMatter
        Dim strPath
        Set objMatter = MyKernel.Command(T_MATTER)
        objMatter.CommandType = "SELECT"
        objMatter.Where = "HIDDEN=0 AND MARK=" & atol("&H" & argv("id"))
        If Not objMatter.Exec Then
            MyXML.Printf MyXML.CreateC("MARK " & argv("id") & " lost")
        Else
            strPath = GetMatterFile(objMatter("Category"), objMatter("Intime"), objMatter("Mark"), objMatter("Ext"), "")
            If objMatter("Category") = wmTypeImage Then
                CheckMatterSize objMatter
                MyXML.Println MyXML.CreateImg(GetMatterPreview(objMatter), "加载中……", -1, -1)
                If argv("download") = "1" Then
                    If argv("name") = "1" Then
                        MyXML.Println "图片名称：" & objMatter("Title")
                    End If
                    If argv("imageSize") = "1" Then
                        MyXML.Println "图片尺寸：" & objMatter("Width") & "x" & objMatter("Height")
                    End If
                    If argv("fileSize") = "1" Then
                        MyXML.Println "图片大小：" & FormatNumber(GetFileSize(GetMapPath(strPath)) / 1024, 2, True) & " KB"
                    End If
                    If argv("content") = "1" Then
                        MyXML.Println "图片说明：" & objMatter("Content")
                    End If
                    If argv("count") = "1" Then
                        MyXML.Println "下载次数：" & objMatter("Download")
                    End If
                    If MyKernel.Config("DownType") = "1" Then
                        MyXML.Println "按下列尺寸下载"
                        Dim arrSize
                        Dim ptr
                        Dim size
                        arrSize = Split(MyKernel.Config("DownConfig"), "|")
                        For Each ptr In arrSize
                            size = Split(ptr, "x", 2)
                            If UBound(size) = 1 Then
                                MyXML.Println MyXML.CreateAnchor(GetMatterView(objMatter, 1, size(0), size(1), objMatter("Ext")), ptr)
                            End If
                        Next
                    Else
                        MyXML.Println MyXML.CreateAnchor(GetMatterView(objMatter, 1, objMatter("Width"), objMatter("Height"), objMatter("Ext")), "下载到手机")
                    End If
                    If MyKernel.Config("DownOrig") = "1" Then
                        MyXML.Println MyXML.CreateAnchor(GetMatterView(objMatter, 1, objMatter("Width"), objMatter("Height"), objMatter("Ext")), "原始尺寸下载")
                    End If
                End If
            Else
                If (objMatter("Category") = wmTypeVideo Or objMatter("Category") = wmTypeSoft) And InString(MyKernel.Config("AllowImage"), objMatter("Preview"), False) Then
                    MyXML.Println MyXML.CreateImg(GetMatterPreview(objMatter), "加载中……", -1, -1)
                End If
                If argv("name") = "1" Then
                    MyXML.Println objMatter("Title")
                End If
                If argv("fileSize") = "1" Or blnType = True Then
                    MyXML.Println "文件大小：" & FormatNumber(GetFileSize(GetMapPath(strPath)) / 1024, 2, True) & " KB"
                End If
                If argv("content") = "1" Then
                    MyXML.Println "文件说明：" & objMatter("Content")
                End If
                If argv("count") = "1" Or blnType = True Then
                    MyXML.Println "下载次数：" & objMatter("Download")
                End If
                If UCase(objMatter("Ext")) = "JAR" Then
                    strPath = GetMatterFile(objMatter("Category"), objMatter("Intime"), objMatter("Mark"), "jad", "")
                    If fso.FileExists(GetMapPath(strPath)) Then
                        MyXML.Println MyXML.CreateAnchor(GetMatterView(objMatter, 1, objMatter("Width"), objMatter("Height"), "jad"), "下载JAD文件")
                    End If
                    MyXML.Println MyXML.CreateAnchor(GetMatterView(objMatter, 1, objMatter("Width"), objMatter("Height"), objMatter("Ext")), "下载JAR文件")
                Else
                    MyXML.Println MyXML.CreateAnchor(GetMatterView(objMatter, 1, objMatter("Width"), objMatter("Height"), objMatter("Ext")), "下载到手机")
                End If
            End If
            Dim arr1, arr2
            arr1 = Array("Handle", "Id", "Referer")
            arr2 = Array("matter", objMatter("SeqId"), MyIO.Env("REQUEST_URI"))
            MyXML.Printf MyXML.CreateImg(GetURL("log.asp", arr1, arr2), "", 0, 0)
        End If
        Set objMatter = Nothing
    Case "img"
        If argv("href") = "" Then
            MyXML.Printf MyXML.CreateImg(argv("src"), argv("text"), -1, -1)
        Else
            MyXML.Printf MyXML.CreateA(argv("href"), "", argv("src"), "")
        End If
    Case "link"
        MyXML.Printf MyXML.CreateA(argv("href"), argv("text"), "", "")
    Case Else
    End Select
End Sub

Private Function FormatUBB(ByVal strData)
    Dim reg, arr, ptr
    Dim ret, pos
    Set reg = New RegExp
    reg.Pattern = "\[(url|b|i|u|img|call)[=]*(.*?)\]([\s\S]+?)\[/\1\]"
    reg.Global = True
    reg.IgnoreCase = True
    Set arr = reg.Execute(strData)
    pos = 1
    For Each ptr In arr
        ret = ret & SubString(strData, pos, ptr.FirstIndex + 1)
        pos = ptr.FirstIndex