matter.asp

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

Private Sub ParseRemote(objStaple)
    Dim strURL
    Dim varBuf
    Dim strExt
    Dim blnKeep
    Dim objCmd
    Dim strPath
    Dim size
    Dim intPlace
    strURL = MyIO.Form("URL")
    intPlace = atoi(MyIO.Form("Place"))
    varBuf = GetRemoteBody(strURL)
    If VarType(varBuf) <> (vbArray Or vbByte) Then
        MyIO.Echo "文件不存在"
    Else
        blnKeep = CBool(MyIO.Form("Keep") = "1")
        Set objCmd = MyKernel.Command(T_MATTER)
        objCmd("Ext") = fso.GetExtensionName(strURL)
        objCmd("Category") = GetMatterCategory(objCmd("Ext"))
        If objCmd("Category") <> 0 Then
            If blnKeep Then
                objCmd("Title") = fso.GetFileName(strURL)
            Else
                objCmd("Title") = GetFileNameNoExt(strURL)
            End If
            objCmd("Source") = strURL
            objCmd("Mark") = GetMatterMark() + 1
            objCmd("Intime") = GetTime(Now())
            CheckMatterFolder objCmd("Category"), objCmd("Intime")
            strPath = GetMatterPath(objCmd("Category"), objCmd("Intime"), objCmd("Mark"), objCmd("Ext"), "")
            SetFileBinary strPath, varBuf, True
            If objCmd("Category") = wmTypeImage Then
                size = ImageResize2(strPath, strPath, atoi(MyKernel.Config("KeepWidth")), atoi(MyKernel.Config("KeepHeight")))
                If Not size(0) Then
                    size = GetFileInfo(strPath)
                End If
                objCmd("Width") = size(1)
                objCmd("Height") = size(2)
                ImageImpress strPath
            End If
            AddMatter objCmd
            AddContent objStaple, objCmd("Title"), objCmd("Mark"), "", intPlace
            SetMatterMark objCmd("Mark")
            MyIO.Echo "OK"
        Else
            MyIO.Echo "不支持的文件类型"
        End If
        Set objCmd = Nothing
    End If
End Sub

Private Sub doPostChange()
    If MyPower("ModifyMatter") = 0 Then
        MyIO.Echo "您没有编辑素材的权限"
    Else
        Dim arr
        Dim intType
        arr = Split(MyIO.Form("SeqId"), ",")
        intType = atoi(MyIO.Form("Type"))
        If Not IsNumericArray(arr) Then
            MyIO.Echo "请指定您要" & IIf(intType = 0, "隐藏", "恢复") & "的素材"
        Else
            strSQL = "UPDATE $(Table) SET Hidden=$(Hidden) WHERE $(Where)"
            strSQL = Replace(strSQL, "$(Table)", T_MATTER)
            strSQL = Replace(strSQL, "$(Hidden)", IIf(intType = 0, 1, 0))
            strSQL = Replace(strSQL, "$(Where)", GetWhere("SEQID", arr))
            MyKernel.DB.Exec strSQL
            MyIO.Echo "OK"
        End If
    End If
End Sub

Private Sub doPostRemove()
    If MyPower("DeleteMatter") = 0 Then
        MyIO.Echo "您没有删除素材的权限"
    Else
        Dim arr
        arr = Split(MyIO.Form("SeqId"), ",")
        If Not IsNumericArray(arr) Then
            MyIO.Echo "请先选择您要删除的素材"
        Else
            ClearMatter arr
        End If
    End If
End Sub

Private Sub ClearMatter(arr)
    Dim intCate
    Dim strName
    strSQL = "SELECT * FROM $(Table) WHERE $(Where)"
    strSQL = Replace(strSQL, "$(Table)", T_MATTER)
    strSQL = Replace(strSQL, "$(Where)", GetWhere("SEQID", arr))
    Set rs = MyKernel.DB.Exec2(strSQL)
    If rs.EOF Then
        MyIO.Echo "找不到您要删除的素材，或者您没有删除这些素材的权限"
    Else
        Do While Not rs.EOF
            intCate = rs("Category")
            strName = GetMatterName(intCate) & "/" & FormatTime(rs("Intime"), "Ymd") & "/" & Hex(rs("Mark"))
            If intCate = wmTypeImage Then
                ClearImage strName & "D"
                ClearImage strName & "P"
                ClearImage strName & "F"
                ClearImage strName
            ElseIf intCate = wmTypeVideo Or intCate = wmTypeSoft Then
                ClearFile strName, IIf(intCate = wmTypeVideo, "AllowVideo", "AllowSoft")
                ClearImage strName & "P"
                ClearImage strName & "F"
                ClearImage strName
            Else
                ClearFile strName, "AllowRing"
            End If
            rs.MoveNext
        Loop
        MyIO.Echo "OK"
        blnError = False
    End If
    rs.Close
    Set rs = Nothing
    If Not blnError Then
        strSQL = "DELETE FROM $(Table) WHERE $(Where)"
        strSQL = Replace(strSQL, "$(Table)", T_MATTER)
        strSQL = Replace(strSQL, "$(Where)", GetWhere("SEQID", arr))
        MyKernel.DB.Exec strSQL
        strSQL = "UPDATE $(Table) SET MATTER=0 WHERE $(Where)"
        strSQL = Replace(strSQL, "$(Table)", T_CONTENT)
        strSQL = Replace(strSQL, "$(Where)", GetWhere("MATTER", arr))
        MyKernel.DB.Exec strSQL
    End If
End Sub

Private Sub doPostModify()
    Dim objCmd
    Dim strPath, objItem
    Set objCmd = MyKernel.Command(T_MATTER)
    objCmd.CommandType = "SELECT"
    objCmd.Where = "SeqId=" & atol(MyIO.QueryString("SeqId"))
    MyIO.Allow = MyKernel.Config("AllowImage") & "|" & MyKernel.Config("AllowSoft")
    If MyPower("ModifyMatter") = 0 Then
        strError = "您没有编辑素材的权限"
    ElseIf objCmd.Exec Then
        strError = "找不到您要编辑的素材"
    ElseIf MyPower.Status <> 1 And MyAdmin("GroupId") <> objCmd("GroupId") And MyKernel.Config("MatterGroup") = "1" Then
        strError = "找不到您要编辑的素材"
    ElseIf MyPower.Status = 100 And MyAdmin("SeqId") <> objCmd("AdminId") Then
        strError = "不能编辑不输入您的素材"
    ElseIf MyIO.Parse <> 0 Then
        strError = "超过最大数据请求长度：" & MBYTE
    Else
        objCmd.CommandType = "UPDATE"
        objCmd.Where = "SEQID=" & objCmd("SeqId")
        objCmd.Add "Title", MyIO.Form("Title")
        objCmd.Add "Content", MyIO.Form("Content")
        If UCase(objCmd("Ext")) = "JAR" Then
            Set objItem = MyIO.File("JAD")
            If objItem Is Nothing Then
                'pass
            ElseIf objItem.fileSize > 0 And UCase(objItem.FileExt) = "JAD" Then
                strPath = GetMatterPath(objCmd("Category"), objCmd("Intime"), objCmd("Mark"), "jad", "")
                objItem.SaveToFile strPath
            End If
            Set objItem = Nothing
        End If
        If objCmd("Category") = wmTypeVideo Or objCmd("Category") = wmTypeSoft Then
            Set objItem = MyIO.File("PRE")
            If objItem Is Nothing Then
                'pass
            ElseIf objItem.State = 0 And InString(MyKernel.Config("AllowImage"), objItem.FileExt, False) Then
                objCmd.Add "Preview", objItem.FileExt
                strPath = GetMatterPath(objCmd("Category"), objCmd("Intime"), objCmd("Mark"), objCmd("Preview"), "")
                objItem.SaveToFile strPath
            End If
            Set objItem = Nothing
        End If
        objCmd.Exec
        blnError = False
        strError = "素材编辑成功"
    End If
    Set objCmd = Nothing
    ExportHead "编辑素材"
    MyIO.Echo "<script language=""javascript"">"
    MyIO.Echo "function myload()"
    MyIO.Echo "{"
    MyIO.Echo "var prt = window.parent;"
    If Not blnError Then
        MyIO.Echo "prt.MessageBox.show(MSG_HINT, """ & strError & """);"
    Else
        MyIO.Echo "prt.MessageBox.show(MSG_WARNING, """ & strError & """);"
    End If
    MyIO.Echo "prt.document.getElementById(""frmMain"").btnPost.disabled = false;"
    MyIO.Echo "}"
    MyIO.Echo "</script>"
    ExportFoot
End Sub

Private Sub doPostMake()
    If MyPower("ModifyMatter") = 0 Then
        MyIO.Echo "您没有编辑素材的权限"
    Else
        Dim arr
        Dim blnMake
        Dim objCmd
        Dim lngID
        Dim strTitle
        Dim strContent
        arr = Split(MyIO.Form("SeqId"), ",")
        blnMake = CBool(MyIO.Form("Category") = "1")
        strTitle = Trim(MyIO.Form("Title"))
        lngID = atol(MyIO.Form("Staple"))
        Set objCmd = MyKernel.Command(T_STAPLE)
        objCmd.CommandType = "SELECT"
        objCmd.Where = GetWhere("SEQID", Array(lngID))
        If Not IsNumericArray(arr) Then
            MyIO.Echo "请选择您要生成内容的素材"
        ElseIf lngID <= 0 Then
            MyIO.Echo "请先选择目标栏目"
        ElseIf Not objCmd.Exec Then
            MyIO.Echo "找不到目标栏目或者您没有在该栏目下生成内容的权限"
        ElseIf objCmd("Category") <> wmStapleNormal Then
            MyIO.Echo "非普通栏目不能生成内容"
        ElseIf blnMake And strTitle = "" Then
            MyIO.Echo "请输入内容标题"
        Else
            strSQL = "SELECT * FROM $(Table) WHERE $(Where)"
            strSQL = Replace(strSQL, "$(Table)", T_MATTER)
            strSQL = Replace(strSQL, "$(Where)", GetWhere("SEQID", arr))
            Set rs = MyKernel.DB.Exec2(strSQL)
            If rs.EOF Then
                MyIO.Echo "找不到您要生成内容的素材或者您没有使用这些素材的权限"
            Else
                Do While Not rs.EOF
                    If blnMake Then
                        Select Case rs("Category")
                        Case wmTypeImage
                            strContent = strContent & "[image,id=" & Hex(rs("Mark")) & ",download=1,name=1,imageSize=1,fileSize=1,content=0,count=1]" & vbCrLf
                        Case wmTypeRing
                            strContent = strContent & "[ring,id=" & Hex(rs("Mark")) & ",name=1,fileSize=1,content=0,count=1]" & vbCrLf
                         Case wmTypeVideo
                            strContent = strContent & "[video,id=" & Hex(rs("Mark")) & ",name=1,fileSize=1,content=0,count=1]" & vbCrLf
                         Case wmTypeSoft
                            strContent = strContent & "[soft,id=" & Hex(rs("Mark")) & ",name=1,fileSize=1,content=0,count=1]" & vbCrLf
                        End Select
                    Else
                        AddContent objCmd, rs("Title"), rs("Mark"), "", wmImgUnderContent
                    End If
                    rs.MoveNext
                Loop
                If blnMake Then
                    AddContent objCmd, strTitle, 0, strContent, wmImgUnderContent
                End If
                MyIO.Echo "OK"
            End If
            rs.Close
            Set rs = Nothing
        End If
        Set objCmd = Nothing
    End If
End Sub

Private Sub doPostCache()
    Dim arr, ptr
    Dim objParent, objFolder
    Dim objFile
    Dim strPath
    arr = Array("image", "ring", "video", "soft")
    For Each ptr In arr
        strPath = GetMapPath("images/" & ptr)
        If fso.FolderExists(strPath) Then
            Set objParent = fso.GetFolder(strPath)
            For Each objFolder In objParent.SubFolders
                For Each objFile In objFolder.Files
                    If InString("P|D|F", Mid(objFile.Name, 9, 1), False) Then
                        fso.DeleteFile strPath & "\" & objFolder.Name & "\" & objFile.Name
                    End If
                Next
            Next
            Set objParent = Nothing
        End If
    Next
    RemoveCache "index", 0, 0, 0
    RemoveCache "staple", 0, 0, 0
    RemoveCache "content", 0, 0, 0
    MyIO.Echo "OK"
End Sub

Private Function GetMatterCategory(ByVal strExt)
    If InString(MyKernel.Config("AllowImage"), strExt, False) Then
        GetMatterCategory = wmTypeImage
    ElseIf InString(MyKernel.Config("AllowRing"), strExt, False) Then
        GetMatterCategory = wmTypeRing
    ElseIf InString(MyKernel.Config("AllowVideo"), strExt, False) Then
        GetMatterCategory = wmTypeVideo
    ElseIf InString(MyKernel.Config("AllowSoft"), strExt, False) Then
        GetMatterCategory = wmTypeSoft
    Else
        GetMatterCategory = 0
    End If
End Function

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