msgbox

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

Private strHandle
Private strReferer
Private blnError
Private strError
Private objRecv

Private Sub Class_Initialize()
    Set MyXML = MyKernel.XMLParser
    blnError = True
End Sub

Private Sub Class_Terminate()
End Sub

Public Sub main()
    MyXML.Align = "center"
    MyXML.Println MyKernel.Config("MsgboxTitle")
    MyXML.Align = "left"
    strHandle = MyIO.QueryString("Handle")
    strReferer = MyIO.QueryString("Referer")
    If MyKernel.Config("IsMsgbox") <> "1" Then
        MyXML.Println "该功能已被站长关闭"
    ElseIf IsGuest() Then
        Call RegisterHint("只有注册用户才能使用短信功能")
    ElseIf MyIO.Env("REQUEST_METHOD") = "POST" Then
        Call doPost
    Else
        Call doGet
    End If
    If strReferer <> "" Then
        MyXML.Println MyXML.CreateA(strReferer, "快速返回", GetImagePrefix("images/back.gif"), "")
    End If
    If strHandle <> "" Then
        MyXML.Println MyXML.CreateA(GetURL("msgbox.asp", "Referer", strReferer), "返回" & MyKernel.Config("MsgboxTitle"), GetImagePrefix("images/back.gif"), "")
    End If
    MyXML.Println MyXML.CreateA("console.asp", "返回控制台", GetImagePrefix("images/back.gif"), "")
    MyXML.Println MyXML.CreateA("index.asp", "返回首页", GetImagePrefix("images/home.gif"), "")
    Call setLog("msgbox", 0)
    Call MyKernel.OutputXML(Empty)
End Sub

Private Sub doGet()
    Select Case LCase(strHandle)
    Case "send"
        Call doGetSend
    Case "view"
        Call doGetView
    Case "detail"
        Call doGetDetail
    Case "remove"
        Call doGetRemove
    Case Else
        Call doGetMain
    End Select
End Sub

Private Sub doPost()
    Select Case LCase(strHandle)
    Case "send"
        Call doPostSend
    Case Else
    End Select
End Sub

Private Sub doGetSend()
    Dim lngUserID
    lngUserID = atol(MyIO.QueryString("UserId"))
    Set objRecv = MyKernel.Command(T_USER)
    objRecv.CommandType = "SELECT"
    objRecv.Where = "SEQID=" & lngUserID
    MyXML.Println "[发送短信]"
    If lngUserID < 1 Then
        MyXML.Println "请选择您要发送短信的目标会员"
    ElseIf Not objRecv.Exec Then
        MyXML.Println "找不到您要发送短信的目标用户"
    ElseIf objRecv("Status") < wmUserRegister Then
        MyXML.Println "找不到您要发送短信的目标用户"
    ElseIf objRecv("UserID") = atol(MyKernel.Memory("SeqID")) Then
        MyXML.Println "不能给自己发送信息"
    Else
        Call doGetForm
    End If
    Set objRecv = Nothing
End Sub

Private Function GetMsgCount()
    Dim ret
    ret = GetCache("WAPmo.MsgCount")
    If IsEmpty(ret) Then
        ret = MyKernel.DB.GetRow("SELECT COUNT(SeqId) FROM " & T_MSGBOX & " WHERE SENDER=0")
        SetCache "WAPmo.MsgCount", atol(ret)
    End If
    GetMsgCount = atol(ret)
End Function

Private Function GetMsgViewURL(ByVal intCate, ByVal intPage)
    Dim arr1, arr2
    arr1 = Array("Handle", "Category", "Referer", "Page")
    arr2 = Array("View", intCate, strReferer, intPage)
    GetMsgViewURL = GetURL("msgbox.asp", arr1, arr2)
End Function

Private Function GetMsgDetailURL(ByVal lngID)
    Dim arr1, arr2
    arr1 = Array("Handle", "SeqId", "Referer")
    arr2 = Array("Detail", lngID, strReferer)
    GetMsgDetailURL = GetURL("msgbox.asp", arr1, arr2)
End Function

Private Function GetMsgDelURL(ByVal lngID, ByVal strAccept)
    Dim arr1, arr2
    arr1 = Array("Handle", "SeqId", "Referer", "Accept")
    arr2 = Array("Remove", lngID, strReferer, strAccept)
    GetMsgDelURL = GetURL("msgbox.asp", arr1, arr2)
End Function

Private Sub doGetMain()
    MyXML.Println MyXML.CreateA(GetMsgViewURL(0, 1), "收件箱(" & MyKernel.Memory("MsgNew") & "/" & MyKernel.Memory("MsgRecv") & ")", GetImagePrefix("images/msgrecv.gif"), "")
    MyXML.Println MyXML.CreateA(GetMsgViewURL(1, 1), "发件箱(" & MyKernel.Memory("MsgSend") & ")", GetImagePrefix("images/msgsend.gif"), "")
    MyXML.Println MyXML.CreateA(GetMsgViewURL(2, 1), "系统消息(" & GetMsgCount() & ")", GetImagePrefix("images/msgsys.gif"), "")
End Sub

Private Sub doGetView()
    Dim objPage, xmlNode
    Dim i
    Dim intCate
    intCate = atoi(MyIO.QueryString("Category"))
    Set objPage = vbsre.mocom.WAPmo.Page.newInstance()
    objPage.ID = atol(MyIO.QueryString("Page"))
    objPage.Size = 10
    objPage.DataType = WM_DataType
    objPage.Table = T_MSGBOX
    objPage.Index = "SeqId"
    Select Case intCate
    Case 0
        MyXML.Println "[收件箱]"
        objPage.Where = "SENDTO=" & MyKernel.Memory("SeqID")
        objPage.Count = atol(MyKernel.Memory("MsgRecv"))
    Case 1
        MyXML.Println "[发件箱]"
        objPage.Where = "SENDER=" & MyKernel.Memory("SeqID")
        objPage.Count = atol(MyKernel.Memory("MsgSend"))
    Case Else
        MyXML.Println "[系统消息]"
        objPage.Where = "Sender=0"
        objPage.Count = GetMsgCount()
    End Select
    objPage.Sort = "SEQID DESC"
    objPage.SortType = 1
    objPage.Build "msgs", "msg"
    If objPage.Rows.hasChildNodes Then
        i = 0
        For Each xmlNode In objPage.Rows.childNodes
            If intCate = 0 Or intCate = 1 Then
                MyXML.Printf MyXML.CreateA(GetMsgDetailURL(XMLAttr(xmlNode, "seqid")), ((objPage.ID - 1) * objPage.Size + i + 1) & "." & XMLAttr(xmlNode, "title"), "", "")
                MyXML.Printf "/"
                MyXML.Println MyXML.CreateA(GetMsgDelURL(XMLAttr(xmlNode, "seqid"), ""), "删除", "", "")
            Else
                MyXML.Println MyXML.CreateA(GetMsgDetailURL(XMLAttr(xmlNode, "seqid")), ((objPage.ID - 1) * objPage.Size + i + 1) & "." & XMLAttr(xmlNode, "title"), "", "")
            End If
            i = i + 1
        Next
        If objPage.ID < objPage.Total Then
            MyXML.Printf MyXML.CreateA(GetMsgViewURL(intCate, objPage.ID + 1), "下一页", "", "")
            MyXML.Printf "|"
            MyXML.Println MyXML.CreateA(GetMsgViewURL(intCate, objPage.Total), "最末页", "", "")
        End If
        If objPage.ID > 1 Then
            MyXML.Printf MyXML.CreateA(GetMsgViewURL(intCate, objPage.ID - 1), "上一页", "", "")
            MyXML.Printf "|"
            MyXML.Println MyXML.CreateA(GetMsgViewURL(intCate, 1), "第一页", "", "")
        End If
        If objPage.Total > 2 Then
            MyXML.SetF "msgbox.asp", "get", "", True
            Call SetQuery
            MyXML.SetN "Handle", "hidden", "View", "", "", False, 0, 0, ""
            MyXML.SetN "Category", "hidden", intCate, "", "", False, 0, 0, ""
            MyXML.SetN "Referer", "hidden", strReferer, "", "", False, 0, 0, ""
            MyXML.SetN "Page", "text", "", objPage.ID & "/" & objPage.Total & "页>>跳到", "页", False, 5, 5, "N*"
            MyXML.SetN "", "submit", "GO", "", "", True, 0, 0, ""
        End If
    Else
        MyXML.Println "尚无任何短信"
    End If
    MyXML.Println ""
    Set objPage = Nothing
End Sub

Private Sub doGetDetail()
    Dim objCmd, intCate
    Set objCmd = MyKernel.Command(T_MSGBOX)
    objCmd.CommandType = "SELECT"
    objCmd.Where = "SEQID=" & atol(MyIO.QueryString("SeqId"))
    If Not objCmd.Exec Then
        MyXML.Println "找不到您要查看的消息"
    ElseIf objCmd("Sender") > 0 And objCmd("Sender") <> atol(MyKernel.Memory("SeqID")) And objCmd("Sendto") <> atol(MyKernel.Memory("SeqID")) Then
        MyXML.Println "找不到您要查看的消息"
    Else
        If objCmd("Sendto") = atol(MyKernel.Memory("SeqID")) Then
            MyXML.Println "[收件箱]"
            MyXML.Printf "发件人："
            MyXML.Println MyXML.CreateA(GetMsgSendURL(objCmd("Sender")), objCmd("SenderName"), "", "")
            If objCmd("Status") = 0 Then
                MyKernel.DB.Exec "UPDATE " & T_MSGBOX & " SET Status=1 WHERE SeqId=" & objCmd("SeqId")
                MyKernel.DB.Exec "UPDATE " & T_USER & " SET MsgNew=MsgNew-1 Where SeqId=" & MyKernel.Memory("SeqId")
                MyKernel.Memory("MsgNew") = atoi(MyKernel.Memory("MsgNew")) - 1
                If atoi(MyKernel.Memory("MsgNew")) < 0 Then
                    MyKernel.Memory("MsgNew") = MyKernel.DB.GetRow("SELECT COUNT(SeqId) FROM " & T_MSGBOX & " WHERE SENDTO=" & MyKernel.Memory("SeqID") & " AND STATUS=0")
                End If
            End If
            intCate = 0
        ElseIf objCmd("Sender") = atol(MyKernel.Memory("SeqID")) Then
            MyXML.Println "[发件箱]"
            MyXML.Printf "收件人："
            MyXML.Println MyXML.CreateA(GetMsgSendURL(objCmd("Sendto")), objCmd("SendtoName"), "", "")
            intCate = 1
        ElseIf objCmd("Sender") = 0 Then
            MyXML.Println "[系统消息]"
            intCate = 2
        End If
        MyXML.Println "标题：" & objCmd("Title")
        MyXML.Println "消息：" & objCmd("Content")
        MyXML.Println "时间：" & FormatTime(objCmd("Intime"), "Y-m-d H:i:s")
        If intCate <> 2 Then
            MyXML.Println MyXML.CreateA(GetMsgDelURL(objCmd("SeqId"), ""), "删除消息", "", "")
        End If
        If intCate = 0 Then
            MyXML.Println MyXML.CreateA(GetMsgViewURL(0, 1), "返回收件箱", GetImagePrefix("images/back.gif"), "")
        ElseIf intCate = 1 Then
            MyXML.Println MyXML.CreateA(GetMsgViewURL(1, 1), "返回发件箱", GetImagePrefix("images/back.gif"), "")
        Else
            MyXML.Println MyXML.CreateA(GetMsgViewURL(2, 1), "返回系统消息", GetImagePrefix("images/back.gif"), "")
        End If
    End If
    Set objCmd = Nothing
End Sub

Private Sub doGetRemove()
    Dim objCmd, intCate
    Set objCmd = MyKernel.Command(T_MSGBOX)
    objCmd.CommandType = "SELECT"
    objCmd.Where = "SEQID=" & atol(MyIO.QueryString("SeqId"))
    If Not objCmd.Exec Then
        MyXML.Println "找不到您要删除的消息"
    ElseIf objCmd("Sender") <> atol(MyKernel.Memory("SeqID")) And objCmd("Sendto") <> atol(MyKernel.Memory("SeqID")) Then
        MyXML.Println "找不到您要删除的消息"
    Else
        If objCmd("Sendto") = atol(MyKernel.Memory("SeqID")) Then
            intCate = 0
        ElseIf objCmd("Sender") = atol(MyKernel.Memory("SeqID")) Then
            intCate = 1
        End If
        If MyIO.QueryString("Accept") = "YES" Then
            MyKernel.DB.Exec "DELETE FROM " & T_MSGBOX & " WHERE SeqId=" & objCmd("SeqId")
            MyKernel.DB.Exec "UPDATE " & T_USER & " SET MSGSEND=MSGSEND-1 WHERE SEQID=" & objCmd("Sender")
            MyKernel.DB.Exec "UPDATE " & T_USER & " SET MSGRECV=MSGRECV-1 WHERE SEQID=" & objCmd("Sendto")
            If objCmd("Status") = 0 Then
                MyKernel.DB.Exec "UPDATE " & T_USER & " SET MSGNEW=MSGNEW-1 WHERE SEQID=" & objCmd("Sendto")
            End If
            MyXML.Println "消息删除成功"
            MyKernel.Memory("MsgRecv") = atoi(MyKernel.Memory("MsgRecv")) - 1
            If atoi(MyKernel.Memory("MsgRecv")) < 0 Then
                MyKernel.Memory("MsgRecv") = MyKernel.DB.GetRow("SELECT COUNT(SEQID) FROM " & T_MSGBOX & " WHERE SENDTO=" & MyKernel.Memory("SeqID"))
            End If
            If atoi(MyKernel.Memory("MsgNew")) < 0 Then
                MyKernel.Memory("MsgNew") = MyKernel.DB.GetRow("SELECT COUNT(SEQID) FROM " & T_MSGBOX & " WHERE SENDTO=" & MyKernel.Memory("SeqID") & " AND STATUS=0")
            End If
        Else
            MyXML.Println "您确定要删除该消息么？"
            MyXML.Println MyXML.CreateA(GetMsgDelURL(objCmd("SeqId"), "YES"), "确定", "", "")
        End If
        If intCate = 0 Then
            MyXML.Println MyXML.CreateA(GetMsgViewURL(0, 1), "返回收件箱", GetImagePrefix("images/back.gif"), "")
        ElseIf intCate = 1 Then
            MyXML.Println MyXML.CreateA(GetMsgViewURL(1, 1), "返回发件箱", GetImagePrefix("images/back.gif"), "")
        End If
    End If
    Set objCmd = Nothing
End Sub

Private Sub doPostSend()
    Dim strTitle, strContent
    Dim objCmd, strSQL
    MyXML.Println "[发送短信]"
    Set objRecv = MyKernel.Command(T_USER)
    objRecv.CommandType = "SELECT"
    objRecv.Where = "SEQID=" & atol(MyIO.QueryString("UserId"))
    strTitle = Trim(MyIO.Form("Title"))
    strContent = Trim(MyIO.Form("Content"))
    If Not objRecv.Exec Then
        blnError = False
        strError = "找不到您要发送短信的目标用户"
    ElseIf objRecv("Status") < wmUserRegister Then
        blnError = False
        strError = "找不到您要发送短信的目标用户"
    ElseIf objRecv("SeqID") = atol(MyKernel.Memory("SeqID")) Then
        blnError = False
        strError = "不能给自己发送信息"
    ElseIf strTitle = "" Then
        strError = "请输入标题"
    ElseIf strContent = "" Then
        strError = "请输入内容"
    Else
        blnError = False
        strError = "短信发送成功"
        Set objCmd = MyKernel.Command(T_MSGBOX)
        objCmd.CommandType = "INSERT"
        objCmd.Add "Sender", MyKernel.Memory("SeqID")
        objCmd.Add "SenderName", MyKernel.Memory("UserName")
        objCmd.Add "Sendto", objRecv("SeqID")
        objCmd.Add "SendtoName", objRecv("UserName")
        objCmd.Add "Title", strTitle
        objCmd.Add "Content", strContent
        objCmd.Add "Status", 0
        objCmd.Add "Intime", GetTime(Now())
        objCmd.Exec
        strSQL = "UPDATE $(Table) SET MsgSend=MsgSend+1 WHERE SeqId=$(SeqId)"
        strSQL = Replace(strSQL, "$(Table)", T_USER)
        strSQL = Replace(strSQL, "$(SeqId)", MyKernel.Memory("SeqId"))
        MyKernel.DB.Exec strSQL
        MyKernel.Memory("MsgSend") = atoi(MyKernel.Memory("MsgSend")) + 1
        strSQL = "UPDATE $(Table) SET MsgRecv=MsgRecv+1,MsgNew=MsgNew+1 WHERE SeqId=$(SeqId)"
        strSQL = Replace(strSQL, "$(Table)", T_USER)
        strSQL = Replace(strSQL, "$(SeqId)", objRecv("SeqId"))
        MyKernel.DB.Exec strSQL
    End If
    Set objRecv = Nothing
    MyXML.Println strError
    If blnError = True Then
        Call doGetForm
    End If
End Sub

Private Sub doGetForm()
    MyXML.SetF GetMsgSendURL(objRecv("SeqID")), "post", "", True
    MyXML.SetN "Title", "text", "", "标题：", "", True, 0, 0, ""
    MyXML.SetN "Content", "text", "", "内容：", "", True, 0, 0, ""
    MyXML.SetN "", "submit", "确定", "", "", True, 0, 0, ""
End Sub