admin_skin.asp

个人网站比较简短

'=================================================
Sub SetDefault()
    Dim SkinID, DefaultType, setUpdateItem, setUpdateItem2, strTemp

    SkinID = PE_CLng(Trim(Request("SkinID")))
    DefaultType = PE_CLng(Trim(Request("DefaultType")))

    If SkinID = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定SkinID!</li>"
        Exit Sub
    End If
        
    If DefaultType = 1 Then
        setUpdateItem = "IsDefault=" & PE_False & ",IsDefaultInProject=" & PE_False
        setUpdateItem2 = "IsDefault=" & PE_True & ",IsDefaultInProject=" & PE_True
        strTemp = "<li>成功将选定的风格,设置为<FONT style='font-size:12px' color='#008000'>系统默认</FONT>风格.</li>"
    ElseIf DefaultType = 2 Then
        setUpdateItem = "IsDefaultInProject=" & PE_False
        setUpdateItem2 = "IsDefaultInProject=" & PE_True
        strTemp = "<li>成功将选定的风格,设置为<FONT style='font-size:12px' color='#3366FF'>方案默认</FONT>风格.</li>"
    Else
        FoundErr = True
        ErrMsg = ErrMsg & "<li>设定的默认类型不对!</li>"
        Exit Sub
    End If

    Conn.Execute ("update PE_Skin set " & setUpdateItem & " where ProjectName='" & ProjectName & "'")
    Conn.Execute ("update PE_Skin set " & setUpdateItem2 & " where SkinID=" & SkinID & " and ProjectName='" & ProjectName & "'")
    Call WriteSuccessMsg(strTemp, ComeUrl)
    Call CreatSkinFile
    Call ClearSiteCache(0)
End Sub

'=================================================
'过程名：DelSkin
'作  用：删除指定风格
'=================================================
Sub DelSkin()
    Dim SkinID
    Dim rs, sql
    SkinID = Trim(Request("SkinID"))
	If IsValidID(SkinID) = False Then
		SkinID = ""
	End If

    If SkinID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定SkinID</li>"
        Exit Sub
    End If

    If InStr(SkinID, ",") > 0 Then
        sql = "select * from PE_Skin where SkinID In (" & SkinID & ")"
    Else
        sql = "select * from PE_Skin where SkinID=" & PE_CLng(SkinID)
    End If

    Set rs = Server.CreateObject("Adodb.RecordSet")
    rs.Open sql, Conn, 1, 3

    If rs.BOF And rs.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到指定的风格！</li>"
    Else
        Do While Not rs.EOF
            If rs("IsDefaultInProject") = False And rs("IsDefault") = False Then
                Conn.Execute ("update PE_Channel set DefaultSkinID=0 where DefaultSkinID=" & rs("SkinID"))
                Conn.Execute ("update PE_Class set SkinID=0 where SkinID=" & rs("SkinID"))
                Conn.Execute ("update PE_Class set DefaultItemSkin=0 where DefaultItemSkin=" & rs("SkinID"))
                Conn.Execute ("update PE_Article set SkinID=0 where SkinID=" & rs("SkinID"))
                Conn.Execute ("update PE_Soft set SkinID=0 where SkinID=" & rs("SkinID"))
                Conn.Execute ("update PE_Photo set SkinID=0 where SkinID=" & rs("SkinID"))
                Conn.Execute ("update PE_Special set SkinID=0 where SkinID=" & rs("SkinID"))
                Call CreatSkinFile
                rs.Delete
                rs.Update
            End If
            rs.MoveNext
        Loop
    End If
    rs.Close
    Set rs = Nothing
    Call WriteSuccessMsg("成功删除选定的风格。", ComeUrl)
End Sub

'=================================================
'过程名：DoExport
'作  用：导出风格处理
'=================================================
Sub DoExport()
    On Error Resume Next
    Dim rs
    Dim mdbname, tconn, trs
    Dim SkinID, FormatConn

    FormatConn = Request.Form("FormatConn")
    SkinID = Trim(Request("SkinID"))
    mdbname = Replace(Trim(Request.Form("skinmdb")), "'", "")
    If IsValidID(SkinID) = False Then
        SkinID = ""
    End If
    
    If SkinID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要导出的模板</li>"
    End If

    If mdbname = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<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

    If FormatConn <> "" Then
        tconn.Execute ("delete from PE_Skin")
    End If

    Set rs = Conn.Execute("select * from PE_Skin where SkinID in (" & SkinID & ")  order by SkinID ")
    Set trs = Server.CreateObject("adodb.recordset")
    trs.Open "select * from PE_Skin", tconn, 1, 3

    Do While Not rs.EOF
        trs.addnew
        trs("SkinName") = rs("SkinName")
        trs("Skin_CSS") = rs("Skin_CSS")
        trs("IsDefault") = False
        trs.Update
        rs.MoveNext
    Loop

    trs.Close
    Set trs = Nothing
    rs.Close
    Set rs = Nothing
    tconn.Close
    Set tconn = Nothing
    Call WriteSuccessMsg("已经成功将所选中的风格设置导出到指定的数据库中！<br><br>你还需要将Skin文件夹中图片文件一起打包。", ComeUrl)
End Sub

'=================================================
'过程名：DoImport
'作  用：导入风格处理
'=================================================
Sub DoImport()
    On Error Resume Next
    Dim mdbname, tconn, trs
    Dim SkinID
    Dim rs
    SkinID = Trim(Request("SkinID"))
    mdbname = Replace(Trim(Request.Form("skinmdb")), "'", "")
    If IsValidID(SkinID) = False Then
        SkinID = ""
    End If

    If SkinID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要导入的模板</li>"
    End If

    If mdbname = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<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_Skin where SkinID in (" & SkinID & ")  order by SkinID")
    Set trs = Server.CreateObject("adodb.recordset")
    trs.Open "select * from PE_Skin", Conn, 1, 3

    Do While Not rs.EOF
        trs.addnew
        trs("SkinName") = rs("SkinName")
        trs("Skin_CSS") = rs("Skin_CSS")
        trs("ProjectName") = ProjectName
        trs("IsDefault") = False
        trs.Update
        rs.MoveNext
    Loop

    trs.Close
    Set trs = Nothing
    rs.Close
    Set rs = Nothing
    tconn.Close
    Set tconn = Nothing
    Call WriteSuccessMsg("已经成功从指定的数据库中导入选中的风格！<br><br>你还需要将图片文件复制到Skin目录中的相应文件夹中才真正完成导入工作。", ComeUrl)
    Call CreatSkinFile
End Sub

'*************************  类模块主区域结束  *******************************
'*************************  类模块扩展域开始  *******************************
'=================================================
'过程名：CreatSkinFile
'作  用：显示处理结果生成css文件
'=================================================
Sub CreatSkinFile()

    If ObjInstalled_FSO = False Then
        Exit Sub
    End If

    If Not fso.FolderExists(Server.MapPath(InstallDir)) Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请先进行网站配置后再进行此项操作。</li>"
        Exit Sub
    End If

    If Not fso.FolderExists(Server.MapPath(InstallDir & "Skin")) Then
        fso.CreateFolder (Server.MapPath(InstallDir & "Skin"))
    End If

    Dim rsSkin, sqlSkin, hf, strSkin
    sqlSkin = "select * from PE_Skin"
    Set rsSkin = Conn.Execute(sqlSkin)

    Do While Not rsSkin.EOF
        strSkin = Replace_CaseInsensitive(rsSkin("Skin_CSS"), "Skin/", InstallDir & "Skin/")
        Call WriteToFile(InstallDir & "Skin/Skin" & rsSkin("SkinID") & ".css", strSkin)
        rsSkin.MoveNext
    Loop

    rsSkin.Close
    sqlSkin = "select * from PE_Skin where IsDefault=" & PE_True & ""
    Set rsSkin = Conn.Execute(sqlSkin)

    If rsSkin.BOF And rsSkin.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>你还没有将其中一个风格设为默认风格哦。请记得一定要做这一步呀。</li>"
    Else
        strSkin = Replace_CaseInsensitive(rsSkin("Skin_CSS"), "Skin/", InstallDir & "Skin/")
        Call WriteToFile(InstallDir & "Skin/DefaultSkin.css", strSkin)
    End If

    rsSkin.Close
    Set rsSkin = Nothing
End Sub

'*************************  类模块扩展域结束  *******************************
'*************************  类模块函数通用开始  *****************************
'=================================================
'过程名：GetProject_Option
'作  用：调用所属方案
'参  数：iProjectName  ----方案名称
'=================================================
Function GetProject_Option(iProjectName)
    Dim sqlProject, rsProject, strProject

    sqlProject = "select * from PE_TemplateProject"
    Set rsProject = Conn.Execute(sqlProject)

    If rsProject.BOF And rsProject.EOF Then
    Else

        Do While Not rsProject.EOF
            strProject = strProject & "<option value='" & rsProject("TemplateProjectName") & "'"

            If rsProject("TemplateProjectName") = iProjectName Then
                strProject = strProject & " selected"
            End If

            strProject = strProject & ">" & rsProject("TemplateProjectName")

            If rsProject("IsDefault") = True Then
                strProject = strProject & "（默认）"
            End If

            strProject = strProject & "</option>"
            rsProject.MoveNext
        Loop

    End If

    rsProject.Close
    Set rsProject = Nothing
    GetProject_Option = strProject
End Function

'**************************************************
'函数名：IsRadioChecked
'作  用：单选,多选默认
'参  数：Compare1-----比较值1
'参  数：Compare2-----比较值2
'返回值：替换后字符串
'**************************************************
Function IsRadioChecked(ByVal Compare1, _
                                ByVal Compare2)

    If Compare1 = Compare2 Then
        IsRadioChecked = " checked"
    Else
        IsRadioChecked = ""
    End If

End Function
%>