upload

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

Private blnError
Private strError
Private strCate
Private MyCore

Private Sub Class_Initialize()
    Set MyCore = vbsre.mocom.WAPmo.WAP.Core
    Set MyXML = MyKernel.XMLParser
    strCate = GetCategory(MyCore.CateId)
    blnError = True
End Sub

Private Sub Class_Terminate()
    Set MyCore = Nothing
End Sub

Public Sub main()
    MyXML.Align = "center"
    MyXML.Printf "发布信息"
    MyXML.Align = "left"
    If Not MyCore.CheckStaple() Then
        MyXML.Printf "找不到您发布信息的栏目"
    ElseIf MyCore.Staple("Category") = wmStapleLinking Then
        MyXML.Printf "找不到您发布信息的栏目"
    Else
        If atol(MyKernel.Memory("Status")) < wmUserRegister Then
            Call RegisterHint("只有注册用户才能发布信息")
        ElseIf MyIO.Env("REQUEST_METHOD") = "POST" Then
            Call doPost
        Else
            Call doGet
        End If
        If strCate <> "" Then
            MyXML.Println MyXML.CreateA("category.asp?StapleId=" & MyCore.Staple("SeqId") & "&PageNo=" & MyCore.PageNo & "&CateId=" & MyCore.CateId, "返回" & strCate, GetImagePrefix("images/cate.gif"), "")
        End If
        MyXML.Println MyXML.CreateA(getStapleURL(MyCore.Staple("SeqId"), MyCore.PageNo), "返回" & MyCore.Staple("Title"), GetImagePrefix("images/staple.gif"), "")
    End If
    MyXML.Println MyXML.CreateA("index.asp", "返回首页", GetImagePrefix("images/home.gif"), "")
    Call setLog("upload", 0)
    Call MyKernel.OutputXML(Empty)
End Sub

Private Sub doGet()
    Dim arr1, arr2
    MyXML.Println "注意事项："
    MyXML.Println "图片或铃声等附件需要支持WAP 2.0的手机才可以上传"
    MyXML.Println "支持如下格式的附件：" & Replace(MyKernel.Config("AllowAttach"), "|", "、")
    MyXML.Println "如果看不到附件框，表示您的手机不支持WAP 2.0或者您的浏览器不支持上传文件功能，推荐使用 Opera 浏览器上传"
    If MyCore.Staple("IsUBB") = 1 Then
        MyXML.Printf MyXML.CreateA(GetURL("ubb.asp", "Referer", MyIO.Env("REQUEST_URI")), "UBB标签", "", "")
        MyXML.Println "已开放"
    End If
    MyXML.Println ""
    arr1 = Array("StapleId", "PageNo", "CateId")
    arr2 = Array(MyCore.Staple("SeqId"), MyCore.PageNo, MyCore.CateId)
    MyXML.SetF GetURL("upload.asp", arr1, arr2), "post", "multipart/form-data", True
    MyXML.SetN "Title", "text", "", "标题：", "", True, 0, 0, ""
    MyXML.SetN "Content", "text", "", "内容：", "", True, 0, 0, ""
    MyXML.SetN "Matter", "file", "", "附件：", "", True, 0, 0, ""
    MyXML.SetN "", "submit", "确定", "", "", True, 0, 0, ""
End Sub

Private Sub doPost()
    MyIO.Allow = MyKernel.Config("AllowAttach")
    If MyIO.Parse <> 0 Then
        strError = "超过最大数据请求长度：" & (MBYTE * 5)
    Else
        Dim strTitle
        Dim strContent
        Dim objItem
        Dim lngMatter
        Dim objCmd, strSQL
        strTitle = Trim(MyIO.Form("Title"))
        strContent = Trim(MyIO.Form("Content"))
        Set objItem = MyIO.File("Matter", 0)
        If strTitle = "" Then
            strError = "请输入标题"
        ElseIf Not ValidMatter(objItem, lngMatter) Then
            strError = "不支持的附件文件格式"
        Else
            Set objCmd = MyKernel.Command(T_CONTENT)
            objCmd.CommandType = "INSERT"
            objCmd.Add "StapleId", MyCore.Mapping("SeqId")
            objCmd.Add "StapleTitle", MyCore.Mapping("Title")
            objCmd.Add "Category", wmContentNormal
            objCmd.Add "Title", strTitle
            objCmd.Add "Content", strContent
            objCmd.Add "Length", 512
            objCmd.Add "Place", wmImgUnderTitle
            objCmd.Add "Download", 1
            objCmd.Add "Templet", ""
            objCmd.Add "Commend", 0
            objCmd.Add "Hot", 0
            objCmd.Add "IsWML", 0
            objCmd.Add "Price", ""
            objCmd.Add "Hidden", 0
            objCmd.Add "RemarkTotal", 0
            objCmd.Add "Matter", lngMatter
            objCmd.Add "Mark", MyCore.Mapping("Mark")
            objCmd.Add "Examine", IIf(MyCore.Staple("Examine") = 1, 0, 1)
            objCmd.Add "Intime", GetTime(Now())
            objCmd.Add "UserID", MyKernel.Memory("SeqID")
            objCmd.Add "UserName", MyKernel.Memory("UserName")
            objCmd.Add "GroupId", MyCore.Mapping("GroupId")
            objCmd.Add "TeamId", MyCore.Mapping("TeamId")
            objCmd.Add "AdminId", MyCore.Mapping("AdminId")
            objCmd.Add "Cate", MyCore.CateId
            objCmd.Exec
            Set objCmd = Nothing
            blnError = False
            If MyCore.Staple("Examine") = 1 Then
                strError = "信息发布成功，请等待站长审核"
            Else
                strError = "信息发布成功"
            End If
        End If
        Set objItem = Nothing
    End If
    MyXML.Println strError
    If blnError Then
        Call doGet
    Else
        RemoveCache "staple", MyCore.Staple("SeqId"), 0, 0
        RemoveCache "staple", MyCore.Mapping("SeqId"), 0, 0
        RemoveCache "index", 0, 0, 0
        strSQL = "UPDATE $(Table) SET CONTENTTOTAL=$(ContentTotal) WHERE SEQID=$(SeqId)"
        strSQL = Replace(strSQL, "$(Table)", T_STAPLE)
        strSQL = Replace(strSQL, "$(ContentTotal)", MyCore.Mapping("ContentTotal") + 1)
        strSQL = Replace(strSQL, "$(SeqId)", MyCore.Mapping("SeqId"))
        MyKernel.DB.Exec strSQL
        WM_SetCache "staple"
        MyKernel.Memory("ContentTotal") = atol(MyKernel.Memory("ContentTotal")) + 1
        strSQL = "UPDATE $(Table) SET CONTENTTOTAL=$(ContentTotal) WHERE SEQID=$(SeqId)"
        strSQL = Replace(strSQL, "$(Table)", T_USER)
        strSQL = Replace(strSQL, "$(ContentTotal)", MyKernel.Memory("ContentTotal"))
        strSQL = Replace(strSQL, "$(SeqId)", MyKernel.Memory("SeqId"))
        MyKernel.DB.Exec strSQL
    End If
End Sub

Private Function ValidMatter(objItem, ByRef lngMatter)
    lngMatter = 0
    If objItem Is Nothing Then
        ValidMatter = True
    ElseIf objItem.State = 0 Then
        ValidMatter = True
        Dim objCmd 
        Dim strPath
        Dim size
        Dim intCategory
        Dim lngTime
        intCategory = GetMatterCategory(objItem.FileExt)
        lngMatter = GetMatterMark() + 1
        lngTime = GetTime(Now())
        Set objCmd = MyKernel.Command(T_MATTER)
        objCmd.CommandType = "INSERT"
        objCmd.Add "Ext", objItem.FileExt
        objCmd.Add "Category", intCategory
        objCmd.Add "Title", fso.GetFileName(objItem.FileName)
        objCmd.Add "Source", objItem.FileName
        objCmd.Add "Mark", lngMatter
        objCmd.Add "Intime", lngTime
        objCmd.Add "UserID", atol(MyKernel.Memory("SeqID"))
        objCmd.Add "UserName", MyKernel.Memory("UserName")
        objCmd.Add "Hit", 0
        objCmd.Add "Download", 0
        objCmd.Add "Hidden", 0
        objCmd.Add "GroupId", MyCore.Mapping("GroupId")
        objCmd.Add "TeamId", MyCore.Mapping("TeamId")
        objCmd.Add "AdminId", MyCore.Mapping("AdminId")
        SetMatterMark lngMatter
        CheckMatterFolder intCategory, lngTime
        strPath = GetMatterPath(intCategory, lngTime, lngMatter, objItem.FileExt, "")
        objItem.SaveToFile strPath
        If intCategory = 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.Add "Width", size(1)
            objCmd.Add "Height", size(2)
            ImageImpress strPath
        End If
        objCmd.Exec
        Set objCmd = Nothing
    Else
        ValidMatter = False
    End If
End Function