user_space_code.asp

个人网站比较简短

            Response.Write "</td></tr></table></td></tr><tr class='tdbg'>"

            Response.Write "    <tr class='title'> "
            Response.Write "      <td height='22' colspan='2'><strong>选填项目</strong></td>"
            Response.Write "    </tr>"
            Response.Write "  <tr class='tdbg'> "
            Response.Write "    <td width='300' class='tdbg'>&nbsp;<strong>分类：</strong><select name='BlogType'>" & GetKingOpti(rsBlog("ClassID")) & "</select></td>"
            Response.Write "    <td rowspan='10' align='center' valign='top' class='tdbg'>"
            Response.Write "        <table width='180' height='200' border='1'>"
            Response.Write "            <tr><td width='100%' align='center'>"
            If Trim(rsBlog("Photo") & "") = "" Then
                Response.Write "<img id='img' src='" & InstallDir & "Space/default.gif' width='150' height='172'>"
            Else
                Response.Write "<img id='img' src='" & rsBlog("Photo") & "' width='150' height='172'>"
            End If
            Response.Write "        </td></tr></table>"
            Response.Write "        <input name='url' type='text' size='25' value='" & rsBlog("Photo") & "'><strong>：照 片 地 址</strong><br><iframe style='top:2px' ID='uploadPhoto' src='Upload.asp?dialogtype=UserBlogPic&size=" & UserSetting(27) & "' frameborder=0 scrolling=no width='285' height='25'></iframe>"
            Response.Write "     </td></tr>"
            Response.Write "  <tr class='tdbg'><td>&nbsp;<strong>地址：</strong><input name='Address' type='text'  value='" & rsBlog("Address") & "'></td></tr>"
            Response.Write "  <tr class='tdbg'><td>&nbsp;<strong>电话：</strong><input name='Tel' type='text' value='" & rsBlog("Tel") & "'></td></tr>"
            Response.Write "  <tr class='tdbg'><td>&nbsp;<strong>传真：</strong><input name='Fax' type='text' value='" & rsBlog("Fax") & "'></td></tr>"
            Response.Write "  <tr class='tdbg'><td>&nbsp;<strong>单位：</strong><input name='Company' type='text' value='" & rsBlog("Company") & "'></td></tr>"
            Response.Write "  <tr class='tdbg'><td>&nbsp;<strong>部门：</strong><input name='Department' type='text' value='" & rsBlog("Department") & "'></td></tr>"
            Response.Write "  <tr class='tdbg'><td>&nbsp;<strong>邮编：</strong><input name='ZipCode' type='text' value='" & rsBlog("ZipCode") & "'></td>"
            Response.Write "  <tr class='tdbg'><td>&nbsp;<strong>ＱＱ：</strong><input name='QQ' type='text' value='" & rsBlog("QQ") & "'></td>"
            Response.Write "  <tr class='tdbg'><td>&nbsp;<strong>主页：</strong><input name='HomePage' type='text' value='" & rsBlog("HomePage") & "'></td></tr>"
            Response.Write "  <tr class='tdbg'><td>&nbsp;<strong>邮件：</strong><input name='Email' type='text' value='" & rsBlog("Email") & "'></td></tr>"
            Response.Write "  <tr>"
            Response.Write "  <tr class='tdbg'> "
            Response.Write "    <td colspan='2'>&nbsp;<strong>聚合空间简介</strong>↓<br>"
            Response.Write "      <textarea name='Intro' cols='72' rows='9' style='display:none'>" & Server.HTMLEncode(rsBlog("Intro")) & "</textarea>"
            Response.Write "      <iframe ID='editor' src='../editor.asp?ChannelID=1&ShowType=2&tContentid=Intro' frameborder='1' scrolling='no' width='550' height='250' ></iframe>"
            Response.Write "    </td>"
            Response.Write "  </tr>"
            Response.Write "    <tr>"
            Response.Write "      <td colspan='2' align='center' class='tdbg'>"
            Response.Write "    <input name='addtype' type='hidden' id='addtype' value=1>"
            Response.Write "      <input name='Action' type='hidden' id='Action' value='SaveModify'>"
            Response.Write "      <input name='ID' type='hidden' id='ID' value=" & rsBlog("ID") & ">"
            Response.Write "    <input  type='submit' name='Submit' value=' 修 改 ' style='cursor:hand;'>&nbsp;<input name='Cancel' type='button' id='Cancel' value=' 取 消 ' onClick=""window.location.href='User_Space.asp?Action=Manage&Passed=1';"" style='cursor:hand;'></td>"
            Response.Write "    </tr>"
            Response.Write "  </table>"
            Response.Write "</form>"
        End If
    End If
    rsBlog.Close
    Set rsBlog = Nothing
End Sub

Sub SaveBlog()
    Dim BlogID, BlogType, BlogName, Address, Tel, Fax, Company, Department, ZipCode, Homepage, Email, QQ, Intro, Photo, LinkUrl
    Dim rsBlog, sqlBlog, isFirst, addtype, listnum
    isFirst = False

    BlogName = Trim(Request.Form("BlogName"))
    If BlogName = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>名称不能为空！</li>"
    Else
        BlogName = ReplaceBadChar(BlogName)
    End If

    If Action = "SaveModify" Then
        BlogID = Trim(Request.Form("ID"))
        If BlogID = "" Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>请指定操作对象！</li>"
        Else
            BlogID = PE_CLng(BlogID)
        End If
    End If
    
    Dim cusers, UserPassword, LastPassword
    UserPassword = ReplaceBadChar(Trim(Request.Cookies(Site_Sn)("UserPassword")))
    LastPassword = ReplaceBadChar(Trim(Request.Cookies(Site_Sn)("LastPassword")))
    If Action = "SaveAdd" Then
        Set cusers = Conn.Execute("select UserID,UserName,UserPassword,LastPassword from PE_User Where UserID=" & UserID)
    Else
        Set cusers = Conn.Execute("select A.ID,C.UserID,C.UserName,C.UserPassword,C.LastPassword from PE_Space A inner join PE_User C on A.UserID=C.UserID Where A.ID=" & BlogID)
    End If
    If cusers.BOF And cusers.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>身份认证失败！</li>"
    Else
        If UserName <> cusers("UserName") Or UserPassword <> cusers("UserPassword") Or LastPassword <> cusers("LastPassword") Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>身份认证失败！</li>"
        End If
    End If
    Set cusers = Nothing

    If FoundErr = True Then Exit Sub

    addtype = PE_CLng(Trim(Request.Form("addtype")))

    If addtype = 0 Or addtype = 2 Then
        addtype = 2
        LinkUrl = Trim(Request.Form("LinkUrl"))
        If LinkUrl = "" Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>来源不能为空！</li>"
        Else
            Dim XmlRss, RssDOM, oItem, tetitle, teurl
            On Error Resume Next
            Set XmlRss = Server.CreateObject("MSXML2.ServerXMLHTTP")
            XmlRss.SetTimeouts 5000, 5000, 120000, 60000
            XmlRss.Open "GET", LinkUrl, False
            XmlRss.Send
            If Err.Number <> 0 Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>来源地址不存在或无法连接！</li>"
                Err.Clear
            Else
                If XmlRss.Readystate <> 4 Or Trim(XmlRss.responseText & "") = "" Then
                    FoundErr = True
                    ErrMsg = ErrMsg & "<li>来源地址不存在或无法连接！</li>"
                Else
                    Set RssDOM = Server.CreateObject("microsoft.XMLDOM")
                    RssDOM.async = False
                    RssDOM.Load (XmlRss.responseXML)
                    If RssDOM.Readystate <> 4 Then
                        FoundErr = True
                        ErrMsg = ErrMsg & "<li>来源地址不是有效的XML数据源</li>"
                    End If
                    Set RssDOM = Nothing
                End If
            End If
            Set XmlRss = Nothing
        End If
    ElseIf addtype = 1 Then
        LinkUrl = PE_HTMLEncode(Trim(Request.Form("Showitem")))
        Photo = PE_HTMLEncode(Trim(Request.Form("url")))
        Address = PE_HTMLEncode(Trim(Request.Form("Address")))
        Tel = PE_HTMLEncode(Trim(Request.Form("Tel")))
        Fax = PE_HTMLEncode(Trim(Request.Form("Fax")))
        Company = PE_HTMLEncode(Trim(Request.Form("Company")))
        Department = PE_HTMLEncode(Trim(Request.Form("Department")))
        ZipCode = PE_HTMLEncode(Trim(Request.Form("ZipCode")))
        Homepage = PE_HTMLEncode(Trim(Request.Form("HomePage")))
        Email = PE_HTMLEncode(Trim(Request.Form("Email")))
        QQ = PE_HTMLEncode(Trim(Request.Form("QQ")))
    End If

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

    If FoundErr = True Then Exit Sub

    If Action = "SaveAdd" Then
        BlogID = PE_CLng(Conn.Execute("select max(ID) from PE_Space")(0)) + 1

        Set rsBlog = Conn.Execute("Select Top 1 UserID,Passed from PE_Space where UserID=" & UserID & " and Type=1")
        If rsBlog.BOF And rsBlog.EOF Then
            isFirst = True
            Conn.Execute ("update PE_User set Blog=" & PE_True & " where UserID=" & UserID)
        Else
            If rsBlog("Passed") = False Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>您的聚合尚未通过申请,不能添加栏目！</li>"
                Set rsBlog = Nothing
                Call CloseConn
                Exit Sub
            End If
        End If

        Set rsBlog = Server.CreateObject("Adodb.RecordSet")
        sqlBlog = "Select * from PE_Space"
        rsBlog.Open sqlBlog, Conn, 1, 3
        rsBlog.AddNew
        rsBlog("ID") = BlogID
        rsBlog("UserID") = UserID
        rsBlog("ClassID") = BlogType
        rsBlog("Name") = BlogName
        rsBlog("BirthDay") = Now()
        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)
        End If
        rsBlog("Intro") = FilterJS(Intro)
        If Photo <> "" Then rsBlog("Photo") = Photo

        If isFirst = True Then
            rsBlog("Type") = 1
            rsBlog("OrderID") = 1
            If PE_CLng(UserSetting(26)) = 1 Then
                rsBlog("Passed") = True
            Else
                rsBlog("Passed") = False
            End If
        Else
            rsBlog("Type") = addtype
            rsBlog("OrderID") = 2
            rsBlog("Passed") = True
        End If
        rsBlog("LastUseTime") = Now()
        If Trim(LinkUrl & "") = "" Then
           rsBlog("LinkUrl") = Null
        Else
           rsBlog("LinkUrl") = LinkUrl
        End If
        rsBlog("listnum") = listnum
        rsBlog.Update
        If addtype = 1 And isFirst = True Then Call CreateBlogDir(UserID, UserName)
    Else
        Set rsBlog = Server.CreateObject("Adodb.RecordSet")
        sqlBlog = "Select * from PE_Space where ID=" & BlogID
        rsBlog.Open sqlBlog, Conn, 1, 3
        If rsBlog.BOF And rsBlog.EOF Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>未找到这个聚合！</li>"
            rsBlog.Close
            Set rsBlog = Nothing
            Exit Sub
        End If
            rsBlog("Name") = BlogName
            rsBlog("ClassID") = BlogType
            If addtype = 1 Then
                rsBlog("Address") = Address
                rsBlog("Tel") = Tel
                rsBlog("Fax") = Fax
                rsBlog("Company") = Company