admin_spacemanage.asp

个人网站比较简短

    End If
    Intro = Trim(Request.Form("Intro"))
    listnum = PE_CLng(Trim(Request.Form("ListNum")))
    If listnum = 0 Then listnum = 10

    If FoundErr = True Then
        Exit Sub
    End If

    BlogType = PE_CLng(Trim(Request.Form("BlogType")))
    Set rsBlog = Server.CreateObject("Adodb.RecordSet")
    sqlBlog = "Select * from PE_Space where ID=" & BlogID
    rsBlog.Open sqlBlog, Conn, 1, 3
    If Not (rsBlog.BOF And rsBlog.EOF) Then
        If BlogName <> "" Then rsBlog("Name") = BlogName
        If BlogType > 0 Then rsBlog("ClassID") = BlogType
        If addtype = 1 And Birthday <> "" Then
            rsBlog("BirthDay") = Birthday
        End If
        If rsBlog("Type") > 1 Then rsBlog("Type") = addtype
        If addtype = 1 Then
            rsBlog("Address") = Address
            rsBlog("Tel") = Tel
            rsBlog("Fax") = Fax
            rsBlog("Company") = Company
            rsBlog("Department") = Department
            rsBlog("ZipCode") = ZipCode
            rsBlog("HomePage") = Homepage
            rsBlog("Email") = Email
            rsBlog("QQ") = PE_CLng(QQ)
            If Photo <> "" Then rsBlog("Photo") = Photo
        End If
        rsBlog("Intro") = Intro
        If Trim(LinkUrl & "") = "" Then
           rsBlog("LinkUrl") = Null
        Else
           rsBlog("LinkUrl") = LinkUrl
        End If
        rsBlog("listnum") = listnum
        rsBlog.Update
    End If
    rsBlog.Close
    Set rsBlog = Nothing
    Call CloseConn
    Response.Redirect ComUrl
End Sub

Sub SetStat(istat)
    Dim BlogID, OrderID, tmporderid, fl, UserName, UserID
    BlogID = PE_CLng(Trim(Request("ID")))
    If BlogID = 0 And istat < 7 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要操作的聚合空间</li>"
        Exit Sub
    End If
    istat = PE_CLng(istat)
    If istat = 1 Or istat = 2 Then
        Dim blogdir
        Set blogdir = Conn.Execute("Select Top 1 A.ID,C.UserName,C.UserID from PE_Space A left join PE_User C on A.UserID=C.UserID where A.ID=" & BlogID)
        If Not (blogdir.BOF And blogdir.EOF) Then
            UserName = blogdir("UserName")
            UserID = blogdir("UserID")
        End If
        Set blogdir = Nothing
    End If

    Dim spacename
    spacename = Replace(LCase(UserName & UserID), ".", "")

    Select Case istat
    Case 1
        If fso.FolderExists(Server.MapPath(InstallDir & "Space/" & spacename & "/")) = False Then
            Call CreateBlogDir(UserID, UserName)
        End If
        Conn.Execute ("update PE_Space set Passed=" & PE_False & " where ID=" & BlogID & "")
        Set fl = fso.CreateTextFile(Server.MapPath(InstallDir & "Space/" & spacename & "/index.asp"), True)
        fl.WriteLine ("审核中...")
        fl.Close
        Set fl = Nothing
    Case 2
        If fso.FolderExists(Server.MapPath(InstallDir & "Space/" & spacename & "/")) = False Then
            Call CreateBlogDir(UserID, UserName)
        End If
        Conn.Execute ("update PE_Space set Passed=" & PE_True & ",LastUseTime=" & PE_Now & " where ID=" & BlogID & "")
        Set fl = fso.GetFile(Server.MapPath(InstallDir & "Space/Default/index.asp"))
        fl.Copy Server.MapPath(InstallDir & "Space/" & spacename & "/index.asp"), True
        Set fl = Nothing
    Case 3
        Conn.Execute ("update PE_Space set IsElite=" & PE_False & " where ID=" & BlogID & "")
    Case 4
        Conn.Execute ("update PE_Space set IsElite=" & PE_True & " where ID=" & BlogID & "")
    Case 5
        Conn.Execute ("update PE_Space set onTop=" & PE_False & " where ID=" & BlogID & "")
    Case 6
        Conn.Execute ("update PE_Space set onTop=" & PE_True & " where ID=" & BlogID & "")
    Case 7
        tmporderid = Split(Action, "|")
        If UBound(tmporderid) = 1 Then
            BlogID = PE_CLng(tmporderid(1))
            OrderID = Trim(Request("OrderID" & BlogID))
            If OrderID > 0 And BlogID > 0 Then Conn.Execute ("update PE_Space set OrderID=" & OrderID & " where ID=" & BlogID & "")
        End If
    End Select
    Call CloseConn
    Response.Redirect ComUrl
End Sub

Sub Del()
    Dim BlogID
    BlogID = Trim(Request("ID"))
    If IsValidID(BlogID) = False Then
        BlogID = ""
    End If
    If BlogID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要删除的聚合空间</li>"
        Exit Sub
    End If
    Call DelBlogDir(BlogID)
    If InStr(BlogID, ",") > 0 Then
        Conn.Execute ("delete from PE_Space where ID in (" & BlogID & ")")
    Else
        Conn.Execute ("delete from PE_Space where ID=" & BlogID & "")
    End If
    Call CloseConn
    Response.Redirect ComUrl
End Sub

Sub CreateBlogDir(UID, UName)
    If PE_CLng(UID) = 0 Or Trim(UName & "") = "" Then Exit Sub
    On Error Resume Next
    Dim fsfl, fl, strDir, spacename
    spacename = Replace(LCase(UName & UID), ".", "")

    strDir = InstallDir & "Space/" & spacename & "/"
    If fso.FolderExists(Server.MapPath(strDir)) = False Then fso.CreateFolder Server.MapPath(strDir)

    Set fsfl = fso.GetFolder(Server.MapPath(InstallDir & "Space/Default/"))
    For Each fl In fsfl.Files
        fl.Copy Server.MapPath(strDir & fl.name), True
    Next

    Set fsfl = fso.CreateTextFile(Server.MapPath(strDir & "config.xml"), True)
    fsfl.WriteLine ("<?" & "xml version=""1.0"" encoding=""gb2312""" & "?>")
    fsfl.WriteLine ("<" & "body" & ">")
    fsfl.WriteLine ("<" & "baseconfig" & ">")
    fsfl.WriteLine ("<" & "userid" & ">" & UID & "</" & "userid" & ">")
    fsfl.WriteLine ("</" & "baseconfig" & ">")
    fsfl.WriteLine ("</" & "body" & ">")
    fsfl.Close
    Set fsfl = Nothing
End Sub

Sub DelBlogDir(BID)
    Dim UsRs, tmporderid, i, tempuserid, spacename
    On Error Resume Next
    If Trim(BID & "") = "" Then Exit Sub
    If InStr(BID, ",") > 0 Then
        tmporderid = Split(BID, ",")
        For i = 0 To UBound(tmporderid)
            Set UsRs = Conn.Execute("select top 1 A.ID,A.UserID,A.Type,C.UserID,C.UserName from PE_Space A left join PE_User C on A.UserID=C.UserID where A.ID=" & PE_CLng(tmporderid(i)) & " and A.Type=1")
            If Not (UsRs.BOF And UsRs.EOF) Then
                tempuserid = UsRs(1)

                spacename = Replace(LCase(UsRs(4) & tempuserid), ".", "")

                If fso.FolderExists(Server.MapPath(InstallDir & "Space/" & spacename & "/")) Then
                    fso.DeleteFolder Server.MapPath(InstallDir & "Space/" & spacename & "/")
                End If
                '删除全部数据
                Conn.Execute ("delete from PE_Space Where UserID=" & tempuserid)
                Conn.Execute ("delete from PE_SpaceBook Where UserID=" & tempuserid)
                Conn.Execute ("delete from PE_SpaceDiary Where UserID=" & tempuserid)
                Conn.Execute ("delete from PE_SpaceMusic Where UserID=" & tempuserid)
                Conn.Execute ("update PE_User Set Blog=" & PE_False & " Where UserID=" & tempuserid)
            End If
        Next
    Else
        Set UsRs = Conn.Execute("select top 1 A.UserID,A.Type,C.UserName from PE_Space A left join PE_User C on A.UserID=C.UserID where A.ID=" & PE_CLng(BID) & " and A.Type=1")
        If Not (UsRs.BOF And UsRs.EOF) Then
            tempuserid = UsRs(0)
            spacename = Replace(LCase(UsRs(2) & tempuserid), ".", "")
            If fso.FolderExists(Server.MapPath(InstallDir & "Space/" & spacename & "/")) Then
                fso.DeleteFolder Server.MapPath(InstallDir & "Space/" & spacename & "/")
            End If
            '删除全部数据
            Conn.Execute ("delete from PE_Space Where UserID=" & tempuserid)
            Conn.Execute ("delete from PE_SpaceBook Where UserID=" & tempuserid)
            Conn.Execute ("delete from PE_SpaceDiary Where UserID=" & tempuserid)
            Conn.Execute ("delete from PE_SpaceMusic Where UserID=" & tempuserid)
            Conn.Execute ("update PE_User Set Blog=" & PE_False & " Where UserID=" & tempuserid)
        End If
    End If
    Set UsRs = Nothing
End Sub

'*********
'*模块类别管理
'*********

Sub Kind()
    Dim KindID, rsGKind, sqlGKind
    sqlGKind = "select * from PE_Spacekind order by OrderID"
    Set rsGKind = Conn.Execute(sqlGKind)

    Response.Write "<br><table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border'>"
    Response.Write "  <tr class='title' height='22'>"
    Response.Write "    <td width='50' align='center'><strong>分类ID</strong></td>"
    Response.Write "    <td width='150' align='center'><strong>分类名称</strong></td>"
    Response.Write "    <td align='center'><strong>分类说明</strong></td>"
    Response.Write "    <td width='150' align='center'><strong>常规操作</strong></td>"
    Response.Write "    <td width='100' align='center'><strong>排序操作</strong></td>" & vbCrLf
    Response.Write "  </tr>"
    If rsGKind.BOF And rsGKind.EOF Then
        Response.Write "<tr class='tdbg'><td colspan='5' align='center'>您还没有添加任何分类!</td><tr>" & vbCrLf
    Else
        Do While Not rsGKind.EOF
            Response.Write "  <tr class='tdbg' onmouseout=""this.className='tdbg'"" onmouseover=""this.className='tdbgmouseover'"">"
            Response.Write "    <td width='50' align='center'>" & rsGKind("KindID") & "</td>"
            Response.Write "    <td width='150' align='center'>" & rsGKind("KindName") & "</td>"
            Response.Write "    <td>" & PE_HTMLEncode(rsGKind("ReadMe")) & "</td>"
            Response.Write "    <td width='150' align='center'>"
            Response.Write "<a href='Admin_SpaceManage.asp?action=ModifyKind&ID=" & rsGKind("KindID") & "'>修改</a>&nbsp;&nbsp;"
            Response.Write "<a href='Admin_SpaceManage.asp?Action=DelKind&ID=" & rsGKind("KindID") & "' onClick=""return confirm('确定要删除此分类吗？删除此模块后原属于此分类的聚合空间将不属于任何分类。');"">删除</a>&nbsp;&nbsp;"
            Response.Write "<a href='Admin_SpaceManage.asp?Action=ClearKind&ID=" & rsGKind("KindID") & "' onClick=""return confirm('确定要清空此分类中的聚合空间吗？');"">清空</a>"
            Response.Write "</td>"
            Response.Write "<form name='orderform' method='post' action='Admin_SpaceManage.asp'>"
            Response.Write "    <td width='100' align='center'>      <input name='OrderID' type='text' id='OrderID' value='" & rsGKind("OrderID") & "' size='4' maxlength='4' style='text-align:center '>"
            Response.Write "      <input name='ID' type='hidden' id='ID' value='" & rsGKind("KindID") & "'>"
            Response.Write "    <input type='submit' name='Submit' value='修改'>"
            Response.Write "    <input name='Action' type='hidden' id='Action' value='OrderKind'></td></form>"
            Response.Write "</tr>"
            rsGKind.MoveNext
        Loop
    End If
    Response.Write "</table>"
    rsGKind.Close