admin_templateproject.asp

个人网站比较简短

    '这里根据需要填写逻辑处理
    If FoundErr = True Then
        Call WriteErrMsg(ErrMsg, ComeUrl)
        Exit Sub
    End If

    TemplateProjectName = PE_HTMLEncode(TemplateProjectName)
    Intro = PE_HTMLEncode(Intro)
        
    If FoundErr <> True Then
        '数据存储区
        Set rsItem = Server.CreateObject("adodb.recordset")

        If Action = "SaveAdd" Then
            SaveName = "添加"
            Set mrs = Conn.Execute("select max(TemplateProjectID) from PE_TemplateProject")

            If IsNull(mrs(0)) Then
                TemplateProjectID = 1
            Else
                TemplateProjectID = mrs(0) + 1
            End If

            Set mrs = Nothing
            sql = "select top 1 * from PE_TemplateProject"
            rsItem.Open sql, Conn, 1, 3
            rsItem.addnew
            rsItem("TemplateProjectID") = TemplateProjectID
        ElseIf Action = "SaveModify" Then
            SaveName = "修改"

            If TemplateProjectID = 0 Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>不能确定方案的ID!</li>"
                Exit Sub
            Else
                sql = "select * from PE_TemplateProject where TemplateProjectID=" & TemplateProjectID
                rsItem.Open sql, Conn, 1, 3

                If rsItem.BOF And rsItem.EOF Then
                    FoundErr = True
                    ErrMsg = ErrMsg & "<li>找不到指定的方案！</li>"
                    rsItem.Close
                    Set rsItem = Nothing
                    Exit Sub
                End If
            End If
        End If

        '更改模板,风格
        Conn.Execute ("update PE_Skin set ProjectName='" & TemplateProjectName & "' where ProjectName='" & rsItem("TemplateProjectName") & "'")
        Conn.Execute ("update PE_Template set ProjectName='" & TemplateProjectName & "' where ProjectName='" & rsItem("TemplateProjectName") & "'")

        rsItem("TemplateProjectName") = TemplateProjectName
        rsItem("Intro") = Intro
        rsItem.Update
        rsItem.Close
        Set rsItem = Nothing
    Else
        Call WriteErrMsg(ErrMsg, ComeUrl)
        Exit Sub
    End If

    Call WriteSuccessMsg("<Li>" & SaveName & "方案成功！", "Admin_TemplateProject.asp?Action=Main")
    Call CloseConn

End Sub

'=================================================
'过程名：Import
'作  用：导入项目第一步
'=================================================
Sub Import()

    Response.Write "<br>" & vbCrLf
    Response.Write "<form name='myform' action='Admin_TemplateProject.asp' method='post' >"
    Response.Write "  <table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border'>"
    Response.Write "    <tr class='title'>"
    Response.Write "      <td height='22' align='center'><strong>网站方案导入（第一步）</strong></td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td height='100'>&nbsp;&nbsp;&nbsp;&nbsp;请输入要导入的方案数据库的文件名："
    Response.Write "        <input name='ItemMdb' type='text' id='ItemMdb' value='../temp/PE_TemplateProject.mdb' size='50' maxlength='50'>"
    Response.Write "        <input name='Submit' type='submit' id='Submit' value=' 下一步 '>"
    Response.Write "        <input name='Action' type='hidden' id='Action' value='Import2'> </td>"
    Response.Write "    </tr>"
    Response.Write "  </table>"
    Response.Write "</form>"
End Sub

'=================================================
'过程名：Import2
'作  用：导入模板方案第二步
'=================================================
Sub Import2()
    On Error Resume Next
    Dim rs, sql
    Dim mdbname, tconn, trs, iCount
    mdbname = Replace(Trim(Request.Form("ItemMdb")), "'", "")

    If mdbname = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请填写导入数据库名"
    End If

    Set tconn = Server.CreateObject("ADODB.Connection")
    tconn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(mdbname)

    If Err.Number <> 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>数据库操作失败，请以后再试，错误原因：" & Err.Description
        Err.Clear
    End If

    If FoundErr = True Then
        Call WriteErrMsg(ErrMsg, ComeUrl)
        Exit Sub
    End If

    Response.Write "<br>" & vbCrLf
    Response.Write "<form name='myform' method='post' action='Admin_TemplateProject.asp?action=DoImport'>"
    Response.Write "  <table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border'>"
    Response.Write "    <tr class='title'>"
    Response.Write "      <td height='22' align='center'><strong>网站方案导入（第二步）</strong></td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td height='100' align='center'>"
    Response.Write "        <br>"
    Response.Write "        <table border='0' cellspacing='0' cellpadding='0'>"
    Response.Write "          <tr align='center'>"
    Response.Write "            <td><strong>将被导入的方案项目</strong><br>"
    Response.Write "<select name='TemplateProjectID' size='2' multiple style='height:300px;width:250px;'>"
    sql = "select * from PE_TemplateProject"
    Set rs = Server.CreateObject("Adodb.RecordSet")
    rs.Open sql, tconn, 1, 1

    If rs.BOF And rs.EOF Then
        Response.Write "<option value='0'>没有任何方案项目</option>"
        iCount = 0
    Else
        iCount = rs.RecordCount

        Do While Not rs.EOF
            Response.Write "<option value='" & rs("TemplateProjectID") & "'>" & rs("TemplateProjectName") & "</option>"
            rs.MoveNext
        Loop

    End If

    rs.Close
    Set rs = Nothing
    Response.Write "</select></td>"
    Response.Write "            <td width='80'><input type='submit' name='Submit' value='导入&gt;&gt;' "

    If iCount = 0 Then Response.Write " disabled"
    Response.Write "></td>"
    Response.Write "            <td><strong>系统中已经存在的方案项目</strong><br>"
    Response.Write "             <select name='tItemID' size='2' multiple style='height:300px;width:250px;' disabled>"
    Set rs = Conn.Execute(sql)

    If rs.BOF And rs.EOF Then
        Response.Write "<option value='0'>没有任何方案项目</option>"
    Else

        Do While Not rs.EOF
            Response.Write "<option value='" & rs("TemplateProjectID") & "'>" & rs("TemplateProjectName") & "</option>"
            rs.MoveNext
        Loop

    End If

    rs.Close
    Set rs = Nothing
    Response.Write "              </select></td>"
    Response.Write "          </tr>"
    Response.Write "        </table>"
    Response.Write "            <br><b>提示：按住“Ctrl”或“Shift”键可以多选</b><br>"
    Response.Write "        <input name='mdbname' type='hidden' id='mdbname' value='" & mdbname & "'>"
    Response.Write "        <input name='Action' type='hidden' id='Action' value='DoImport'>"
    Response.Write "        <br>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "  </table>"
    Response.Write "</form>"
End Sub

'=================================================
'过程名：DoImport
'作  用：导入模板方案项目处理
'=================================================
Sub DoImport()
    On Error Resume Next
    Dim mdbname, tconn, rs, trs, mrs
    Dim rsTemplate, trsTemplate, rsSkin, trsSkin, rsLabel, trsLabel
    Dim TemplateProjectID
    
    TemplateProjectID = Trim(Request("TemplateProjectID"))
    If IsValidID(TemplateProjectID) = False Then
        TemplateProjectID = ""
    End If

    '获得导入模版数据库路径
    mdbname = Replace(Trim(Request.Form("mdbname")), "'", "")

    If mdbname = "" Then
        mdbname = Replace(Trim(Request.QueryString("mdbname")), "'", "")
    End If

    mdbname = Replace(mdbname, "＄", "/") '防止外部链接安全问题

    If mdbname = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请填写导入模版数据库名"
        Exit Sub
    End If

    If TemplateProjectID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要导出的网站方案ID!</li>"
    End If
    
    If FoundErr = True Then
        Exit Sub
    End If
    
    Set tconn = Server.CreateObject("ADODB.Connection")
    tconn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(mdbname)

    If Err.Number <> 0 Then
        ErrMsg = ErrMsg & "<li>数据库操作失败，请以后再试，错误原因：" & Err.Description
        Err.Clear
        Exit Sub
    End If

    '方案导入
    Set rs = tconn.Execute("select * from PE_TemplateProject where TemplateProjectID in (" & TemplateProjectID & ")  order by TemplateProjectID")
    Set trs = Server.CreateObject("adodb.recordset")
    trs.Open "select * from PE_TemplateProject", Conn, 1, 3

    Do While Not rs.EOF

        If PE_CLng(Conn.Execute("select count(*) from PE_TemplateProject where TemplateProjectName='" & rs("TemplateProjectName") & "'")(0)) > 0 Then
            ErrMsg = ErrMsg & "<li><font color=red >" & rs("TemplateProjectName") & "</font>系统中已经有相同的方案没有导入!</li>"
        Else
            Set mrs = Conn.Execute("select max(TemplateProjectID) from PE_TemplateProject")

            If IsNull(mrs(0)) Then
                TemplateProjectID = 1
            Else
                TemplateProjectID = mrs(0) + 1
            End If

            Set mrs = Nothing

            trs.addnew
            trs("TemplateProjectID") = TemplateProjectID
            trs("TemplateProjectName") = rs("TemplateProjectName")
            trs("Intro") = rs("Intro")
            trs("IsDefault") = False
            '模板隶属方案导入
            Set rsTemplate = tconn.Execute("select * from PE_Template where ProjectName='" & rs("TemplateProjectName") & "' order by TemplateID")
            Set trsTemplate = Server.CreateObject("adodb.recordset")
            trsTemplate.Open "select * from PE_Template", Conn, 1, 3

            If rsTemplate.BOF Or rsTemplate.EOF Then
            Else

                Do While Not rsTemplate.EOF
                    trsTemplate.addnew
                    trsTemplate("ChannelID") = rsTemplate("ChannelID")
                    trsTemplate("TemplateName") = rsTemplate("TemplateName")
                    trsTemplate("TemplateType") = rsTemplate("TemplateType")
                    trsTemplate("TemplateContent") = rsTemplate("TemplateContent")
                    trsTemplate("IsDefault") = False
                    trsTemplate("ProjectName") = rsTemplate("ProjectName")
                    trsTemplate("IsDefaultInProject") = rsTemplate("IsDefaultInProject")
                    trsTemplate("Deleted") = rsTemplate("Deleted")
                    trsTemplate.Update
                    rsTemplate.MoveNext
                Loop

            End If

            trsTemplate.Close
            Set trsTemplate = Nothing
            rsTemplate.Close
            Set rsTemplate = Nothing
            '风格隶属方案导入
            Set rsSkin = tconn.Execute("select * from PE_Skin where ProjectName='" & rs("TemplateProjectName") & "' order by SkinID")
            Set trsSkin = Server.CreateObject("adodb.recordset")
            trsSkin.Open "select * from PE_Skin", Conn, 1, 3

            If rsSkin.BOF Or rsSkin.EOF Then
            Else

                Do While Not rsSkin.EOF
                    trsSkin.addnew
                    trsSkin("SkinName") = rsSkin("SkinName")
                    trsSkin("IsDefault") = False
                    trsSkin("Skin_CSS") = rsSkin("Skin_CSS")
                    trsSkin("IsDefaultInProject") = rsSkin("IsDefaultInProject")
                    trsSkin("ProjectName") = rsSkin("ProjectName")
                    trsSkin.Update