您没有管理本页面的权限。<.li>"
dvbbs_error()
Call Footer()
Response.End
End If
Select Case Request("action")
Case ""
Main()
Case "doout"
doout()
Case "load"
Load()
Case "doload"
doLoad()
Case "doupdate"
doupdate()
End Select
Sub doupdate()
Dim Rs,node,inid,cssid,RsSkin,i,cssdom,toid
If Request.form("submit")="" Then
Head()
Readme()
Setup1
Else
If Request.form("inid")="" Then
Head()
Errmsg=ErrMsg + "
必须选择源模板."
dvbbs_error()
Call Footer()
Exit Sub
End If
If Request.form("toid")="" Then
Head()
Errmsg=ErrMsg + "
必须选择目标模板."
dvbbs_error()
Call Footer()
Exit Sub
End If
If SkinConnection(Request.Form("skinmdb")) Then
inid=Request.form("inid")
toid=Request.form("toid")
Set Rs=StyleConn.Execute("select * From Dv_style Where ID="&CLng(inid))
Set RsSkin=Server.CreateObject("adodb.recordset")
RsSkin.open "Select * From Dv_Style Where Id="& CLng(toid),Conn,1,3
For i=2 to 19
If Request.form(RsSkin(i).Name)="1" Then
RsSkin(i)=Rs(RsSkin(i).Name)
End If
Next
RsSkin.update
RsSkin.Close
If Request.form("Forum_CSS")="1" Then
Set CssList=Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
Set cssdom=Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
CssList.LoadXML Rs("Forum_CSS")
Set Rs=Dvbbs.Execute("select Forum_Css From Dv_Setup")
cssdom.LoadXMl Rs(0)
SetTid toid
Rem 删除该模板的CSS样式
For Each Node in cssdom.documentElement.selectNodes("css[tid='"&toid&"']")
cssdom.documentElement.removeChild(node)
Next
For Each Node in CssList.documentElement.selectNodes("css")
cssdom.documentElement.appendChild(node)
Next
i=1
For Each Node in cssdom.documentElement.selectNodes("css/@filename")
Node.text="aspsky_"&i
i=i+1
Next
i=1
For Each Node in cssdom.documentElement.selectNodes("css/@id")
Node.text=i
i=i+1
Next
Dvbbs.Execute("Update Dv_Setup Set Forum_Css='"&Dvbbs.Checkstr(cssdom.xml)&"'")
End If
Dvbbs.loadSetup()
Dvbbs.Loadstyle()
createsccfile()
Head()
Dv_suc("模板覆盖更新完成！")
Call Footer()
Else
Head()
Errmsg=ErrMsg + "
目标数据库"& Request.Form("skinmdb")&"不存在或有错误.
"
dvbbs_error()
Call Footer()
End If
End If
End Sub
Sub Load()
If Request("setup")="" or Request.form("submit")="" Then
Head()
Readme()
Setup1
ElseIf Request("setup")="1" Then
Head()
Setup2
End If
Footer()
End Sub
Sub doload()
Dim Rs,node,skid,cssid,RsSkin,i,cssdom
If Request.form("skid")="" Then
Head()
Errmsg=ErrMsg + "
必须选择要导入的模板."
dvbbs_error()
Call Footer()
Exit Sub
End If
If SkinConnection(Request.Form("skinmdb")) Then
Set Rs=Dvbbs.Execute("select Forum_Css From Dv_Setup")
Set CssList=Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
Set cssdom=Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
cssdom.LoadXMl Rs(0)
Set Rs=Nothing
For Each skid in Request.form("skid")
Set Rs=StyleConn.Execute("select * From Dv_style Where ID="&CLng(skid))
Set cssid=Request.Form("cssid_"&skid)
Set RsSkin=Server.CreateObject("adodb.recordset")
RsSkin.open "Select * From Dv_Style Where Id=0",Conn,1,3
RsSkin.AddNew
RsSkin("StyleName")=Request.Form("StyleName"&skid)
RsSkin("Main_Style")=Rs("Main_Style")
RsSkin("Style_Pic")=Rs("Style_Pic")
RsSkin("page_index")=Rs("page_index")
RsSkin("page_dispbbs")=Rs("page_dispbbs")
RsSkin("page_showerr")=Rs("page_showerr")
RsSkin("page_login")=Rs("page_login")
RsSkin("page_online")=Rs("page_online")
RsSkin("page_usermanager")=Rs("page_usermanager")
RsSkin("page_fmanage")=Rs("page_fmanage")
RsSkin("page_boardstat")=Rs("page_boardstat")
RsSkin("page_paper_even_toplist")=Rs("page_paper_even_toplist")
RsSkin("page_query")=Rs("page_query")
RsSkin("page_show")=Rs("page_show")
RsSkin("page_dispuser")=Rs("page_dispuser")
RsSkin("page_help_permission")=Rs("page_help_permission")
RsSkin("page_postjob")=Rs("page_postjob")
RsSkin("page_post")=Rs("page_post")
RsSkin("page_boardhelp")=Rs("page_boardhelp")
CssList.LoadXML Rs("Forum_CSS")
Set CssList=OutCSSDom(cssid)
RsSkin.Update
RsSkin.MoveLast
SetTid(RsSkin("id"))
RsSkin.Close
For Each Node in CssList.documentElement.selectNodes("css")
cssdom.documentElement.appendChild(node)
Next
Next
i=1
For Each Node in cssdom.documentElement.selectNodes("css/@filename")
Node.text="aspsky_"&i
i=i+1
Next
i=1
For Each Node in cssdom.documentElement.selectNodes("css/@id")
Node.text=i
i=i+1
Next
Dvbbs.Execute("Update Dv_Setup Set Forum_Css='"&Dvbbs.Checkstr(cssdom.xml)&"'")
Dvbbs.loadSetup()
Dvbbs.Loadstyle()
createsccfile()
Head()
Dv_suc("模板成功导入")
Call Footer()
Else
Head()
Errmsg=ErrMsg + "
目标数据库"& Request.Form("skinmdb")&"不存在或有错误.
"
dvbbs_error()
Call Footer()
End If
End Sub
Sub createsccfile()
On error resume Next
Dim Fso,filename,Forum_CSS
Set FSO=Server.CreateObject("Scripting.FileSystemObject")
If Err Then
err.Clear
Errmsg=ErrMsg + "
您的服务器不支持写文件,CSS文件写入失败,请手工操作或把生成文件的内容清空!
"
Dvbbs_error()
Exit Sub
End If
For Each filename In Application(Dvbbs.CacheName & "_csslist").documentElement.selectNodes("css/@filename")
If filename.text<>"" Then
If InStr(filename.text,".")=0 Then
Dvbbs.SkinID=filename.selectSingleNode("../tid").text
Dvbbs.LoadTemplates("")
Forum_CSS=filename.selectSingleNode("../cssdata").text
Forum_CSS=Replace(Forum_CSS,"{$width}",Dvbbs.mainsetting(0))
Forum_CSS=Replace(Forum_CSS,"{$PicUrl}",filename.selectSingleNode("../@picurl").text)
Fso.CreateTextFile(server.MapPath("../skins/"& filename.text &".css")).WriteLine(Forum_CSS)
If Err Then
err.Clear
Errmsg=ErrMsg + "
您的服务器不支持写文件,CSS文件写入失败,请手工操作或把生成文件的内容清空!
"
Dvbbs_error()
Exit Sub
End If
End If
End If
Next
Set FSO=Nothing
End Sub
Sub SetTid(id)
Dim Node
For Each Node in CssList.documentElement.selectNodes("css/tid")
node.text=id
Next
End Sub
Sub Setup2()
If SkinConnection(Request.Form("skinmdb")) Then
Dim Rs,node
Set CssList=Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
Set Rs=StyleConn.Execute("select ID,StyleName ,Forum_CSS,DateAndTime,readme From Dv_style")
%>
<%
Else
Errmsg=ErrMsg + "
数据库"& Request.Form("skinmdb")&"不存在或有错误.
"
dvbbs_error()
End If
End Sub
Sub Main
Head()
Readme()
Skinlist()
Footer()
End Sub
Sub Setup1()%>
<%
End Sub
Sub doout()
Dim Rs,node,skid,cssid,RsSkin,i
If Request.form("skid")="" Then
Head()
Errmsg=ErrMsg + "
必须选择要导出的模板."
dvbbs_error()
Call Footer()
Exit Sub
End If
If SkinConnection(Request.Form("skinmdb")) Then
Set Rs=Dvbbs.Execute("select Forum_Css From Dv_Setup")
Set CssList=Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
CssList.LoadXMl Rs(0)
Set Rs=Nothing
For Each skid in Request.form("skid")
Set Rs=Dvbbs.Execute("select * From Dv_style Where ID="&CLng(skid))
Set cssid=Request.Form("cssid_"&skid)
Set RsSkin=Server.CreateObject("adodb.recordset")
RsSkin.open "Select * From Dv_Style Where Id=0",StyleConn,1,3
RsSkin.AddNew
RsSkin("StyleName")=Request.Form("StyleName"&skid)
RsSkin("Main_Style")=Rs("Main_Style")
RsSkin("Style_Pic")=Rs("Style_Pic")
RsSkin("page_index")=Rs("page_index")
RsSkin("page_dispbbs")=Rs("page_dispbbs")
RsSkin("page_showerr")=Rs("page_showerr")
RsSkin("page_login")=Rs("page_login")
RsSkin("page_online")=Rs("page_online")
RsSkin("page_usermanager")=Rs("page_usermanager")
RsSkin("page_fmanage")=Rs("page_fmanage")
RsSkin("page_boardstat")=Rs("page_boardstat")
RsSkin("page_paper_even_toplist")=Rs("page_paper_even_toplist")
RsSkin("page_query")=Rs("page_query")
RsSkin("page_show")=Rs("page_show")
RsSkin("page_dispuser")=Rs("page_dispuser")
RsSkin("page_help_permission")=Rs("page_help_permission")
RsSkin("page_postjob")=Rs("page_postjob")
RsSkin("page_post")=Rs("page_post")
RsSkin("page_boardhelp")=Rs("page_boardhelp")
RsSkin("Forum_CSS")=OutCSSDom(cssid).xml
RsSkin("DateAndTime")=Now()
RsSkin("Readme")=Request.Form("readme"&skid)
RsSkin.Update
RsSkin.Close
Next
Head()
Dv_suc "模板数据已经保存到您的论坛根目录下的skins下,文件名为"&Request.Form("skinmdb")
Call Footer()
Else
Head()
Errmsg=ErrMsg + "
目标数据库"& Request.Form("skinmdb")&"不存在或有错误.
"
dvbbs_error()
Call Footer()
End If
End Sub
Function OutCSSDom(IDlist)
Dim XML
Set XML=CssList.cloneNode(True)
Dim Node,cssid,id
cssid=""
For Each id in IDlist
If IsNumeric(id) and id<>"" Then
If cssid="" Then
cssid="@id !="&id&" "
Else
cssid=cssid & "and @id !="&Id&" "
End If
End If
Next
If CssID<>"" Then CssID="["&CssID&"]"
For Each Node in XML.documentElement.SelectNodes("css"&CSSID)
XML.documentElement.removeChild(node)
Next
Set OutCSSDom=XML
End Function
Function SkinConnection(mdbname)
On Error Resume Next
Set StyleConn = Server.CreateObject("ADODB.Connection")
StyleConn.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(MyDbPath &"skins/"&mdbname)
If Err Then
err.Clear
SkinConnection=False
Else
SkinConnection=True
End If
End Function
Sub Readme()
%>
<%
End Sub
Sub Skinlist()
Dim Rs,node
Set Rs=Dvbbs.Execute("select Forum_Css From Dv_Setup")
Set CssList=Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
CssList.LoadXMl Rs(0)
Set Rs=Nothing
Set Rs=Dvbbs.Execute("select ID,StyleName From Dv_style")
%>
<%
End Sub
%>