<%Head()%>
论坛风格及模版数据管理
注意
１，确认模版数据库名正确；
２，如模版数据库放在skin目录下，即填写：Skins/Dv_skin.mdb；
３，模版数据库内备份的表名为Dv_Style,请不要更改；
４，模版数据包括论坛ＣＳＳ设置，与及所有论坛图片设置．
论坛模版导出 | 论坛模版导入 | 论坛风格CSS导出 | 论坛风格CSS导入

<% Dim admin_flag Dim skid,sname,act,mdbname,StyleConn,SucMsg admin_flag=",21," mdbname = "../Skins/Dv_skin.mdb" If not Dvbbs.master or instr(","&session("flag")&",",admin_flag)=0 Then Errmsg=ErrMsg + "
  • 本页面为管理员专用，请登录后进入。
  • 您没有管理本页面的权限。" dvbbs_error() Else Select Case Request("action") Case "inputskin" Call inputskin() Case "loadskin" Call loadskin() Case "load" Call load("loadthis") Case "rename" Call rename() Case "savenm" Call savenm() Case "CreatMdb" Call CreateStyleMdb() Case "DelFields" Call DelFields() Case "OutputCss" Call OutputCss() Case "LoadCss" Call LoadCss() Case Else Call MAIN() End Select End If If Errmsg<>"" Then dvbbs_error() If IsObject(StyleConn) Then StyleConn.close Set StyleConn=Nothing End IF Call Footer() '导出CSS风格数据 Sub OutputCss() Dim Rs,Sql,CssStyle Set Rs=Dvbbs.Execute("Select Top 1 Forum_Css From Dv_setup") If not Rs.eof Then CssStyle = Rs(0) End If Set Rs=Nothing If Request.Form("ReAct") = "SaveCss" Then mdbname=Dvbbs.Checkstr(trim(Request.form("skinmdb"))) If mdbname="" Then Errmsg=ErrMsg + "
  • 请填写导出模版保存的表名" Exit Sub End If SkinConnection(mdbname) If IsFoundTable("Dv_Css",1)=False Then '创建独立CSS数据表 Dim CreatStr CreatStr = "CREATE TABLE Dv_Css (ID int IDENTITY (1, 1) NOT NULL CONSTRAINT PK_Dv_Css PRIMARY KEY,"&_ "Forum_Css text,Add_Time datetime default now())" StyleConn.Execute(CreatStr) End If If Not IsEmpty(Request.Form("skid")) Then Dim StyleData Dim CssName,CssData,CssPic,CssID,i Dim Temp0,Temp1,Temp2,Temp3 Dim SelID SelID = Replace(Trim(Request.Form("skid"))," ","") SelID = ","&SelID&"," StyleData = Split(CssStyle,"@@@") CssName = Split(StyleData(0),"|||") CssData = Split(StyleData(1),"|||") CssPic = Split(StyleData(2),"|||") CssID = Split(StyleData(3),"|||") For i=0 To Ubound(CssName) If Instr(SelID,","&i&",") Then Temp0 = Temp0 & CssName(i) & "|||" Temp1 = Temp1 & CssData(i) & "|||" Temp2 = Temp2 & CssPic(i) & "|||" Temp3 = Temp3 & CssID(i) & "|||" End If Next CssStyle = Temp0 & "@@@"& Temp1 & "@@@"& Temp2 & "@@@"& Temp3 End If Sql = "insert into Dv_Css(Forum_Css)Values('"&Dvbbs.checkstr(CssStyle)&"') " StyleConn.Execute(Sql) Dv_suc("成功导出所选风格。") Else Call CssList(CssStyle,0) End If End Sub '导入CSS风格数据 Sub LoadCss() Dim Rs,Sql,CssStyle mdbname=Dvbbs.Checkstr(trim(Request.form("skinmdb"))) If mdbname="" Then Errmsg=ErrMsg + "
  • 请填写导出模版保存的表名" Exit Sub End If If Request.Form("ReAct") = "ShowCss" Then Call LoadCssStep1() ElseIf Request.Form("ReAct") = "Loadthis" Then Dim skid skid = Request.Form("skid") If Not IsNumeric(skid) Then skid=1 Else skid=Cint(Skid) End If SkinConnection(mdbname) Set Rs=StyleConn.Execute("Select Top 1 Forum_Css From Dv_Css where id="&skid) If not Rs.eof Then CssStyle = Rs(0) End If Set Rs=Nothing Call CssList(CssStyle,skid) ElseIf Request.Form("ReAct") = "SaveCss" Then Dim cid cid = Request.Form("cid") Dim CssStyle1,CssStyle2,i Dim Temp1,Temp2 Set Rs=Dvbbs.Execute("Select Top 1 Forum_Css From Dv_setup") If not Rs.eof Then CssStyle1 = Rs(0) End If Rs.Close SkinConnection(mdbname) Set Rs=StyleConn.Execute("Select Top 1 Forum_Css From Dv_Css where id="&Dvbbs.Checkstr(cid)) If not Rs.eof Then CssStyle2 = Rs(0) End If Rs.Close Set Rs=Nothing Temp1 = Split(CssStyle1,"@@@") Temp2 = Split(CssStyle2,"@@@") '对要导入的CSS进行对应模板ID检测 Dim SysSkinID,TempCssID,TempCssStr Set Rs=Dvbbs.Execute("Select Top 1 ID From Dv_Style") SysSkinID = Rs(0) TempCssID = Split(Temp2(3),"|||") For i = 0 To Ubound(TempCssID)-1 Set Rs=Dvbbs.Execute("Select ID From Dv_Style Where ID = " & TempCssID(i)) If Rs.Eof And Rs.Bof Then TempCssStr = TempCssStr & SysSkinID & "|||" Else TempCssStr = TempCssStr & TempCssID(i) & "|||" End If Next Rs.Close Set Rs=Nothing CssStyle = Temp1(0)&Temp2(0) &"@@@"& Temp1(1)&Temp2(1) &"@@@" & Temp1(2)&Temp2(2) &"@@@" & Temp1(3)&TempCssStr Sql = "Update Dv_setup set Forum_Css = '"&Dvbbs.Checkstr(CssStyle)&"'" Dvbbs.Execute(Sql) ReloadSetup() TemplatesToCache() Dv_suc("成功导入所选风格，建议您到风格模板总管理的CSS设置中进行CSS对应模板的设置。") ElseIf Request.Form("ReAct") = "DllCss" Then Dim DelID DelID = Request.Form("skid") If DelID="" Then Errmsg=ErrMsg + "
  • 请选取要删除的风格备份!" Exit Sub End If Sql = "Delete From Dv_Css where id in ("&Dvbbs.Checkstr(DelID)&")" SkinConnection(mdbname) StyleConn.Execute(Sql) Dv_suc("成功删除所选取的风格备份。") Else Call load("LoadCss") End If End Sub Sub LoadCssStep1() SkinConnection(mdbname) %> <% Dim Rs,i i=0 Set Rs=StyleConn.Execute("Select * From Dv_Css") Do While Not Rs.Eof %> <% i = i+1 Rs.MoveNext Loop Set Rs = Nothing %>
    导入论坛CSS列表
    按备份时间选取需要导入的数据 选择
    <%=Rs("Add_Time")%> ">
    导入的数据库： 全选
    <% End Sub 'CSS列表 'Forum_CSS 规则 '风格名称|||@@@风格CSS内容|||@@@风格图片目录|||@@@对应的模板ID||| Sub CssList(CssData,Cid) Dim StyleData,CssName,CssID,i If Request("action")="LoadCss" Then sname="导入" act="LoadCss" mdbname=Dvbbs.Checkstr(trim(Request.form("skinmdb"))) If mdbname="" Then Errmsg=ErrMsg + "
  • 请填写导出模版保存的表名" Exit Sub End If Else sname="导出" act="OutputCss" End If StyleData = Split(CssData,"@@@") CssName = Split(StyleData(0),"|||") CssID = Split(StyleData(3),"|||") %> <% Dim MyTempLateName MyTempLateName=TempLateName For i=0 To Ubound(CssName)-1 %> <% Next %>
    论坛CSS列表
    风格名称 选择
    <%If sname="导出" Then Response.Write MyTempLateName(CssID(i))&"-- "%> <%=CssName(i)%>
    <%=sname%>的数据库： 全选
    <% End Sub Sub MAIN() If Request("action")="loadthis" Then sname="导入" act="loadskin" mdbname=Dvbbs.Checkstr(trim(Request.form("skinmdb"))) If mdbname="" Then Errmsg=ErrMsg + "
  • 请填写导出模版保存的表名" Exit Sub End If Else sname="导出" act="inputskin" End If %> <% If act="loadskin" Then SkinConnection(mdbname) set Rs=StyleConn.Execute("select id,StyleName from Dv_Style order by id ") Else set Rs=Dvbbs.Execute("select id,StyleName from Dv_Style order by id ") End If do while not Rs.eof %> <% Rs.movenext loop Rs.close:Set Rs=Nothing %>
    <%=sname%>论坛模版列表
    序号 模版名称 操作 选择
    <%=Rs("id")%> <%=Rs("StyleName")%> &mdbname=<%=mdbname%>" >改名 <%If act<>"loadskin" Then Response.Write " | 编辑" End If %> ">
    <%=sname%>的数据库： 全选
    <% End Sub Sub SkinConnection(mdbname) On Error Resume Next Set StyleConn = Server.CreateObject("ADODB.Connection") StyleConn.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(mdbname) If Err.Number ="-2147467259" Then Errmsg=ErrMsg + "
  • "&Server.MapPath(mdbname)&"数据库不存在。" Dvbbs_error() Response.end End If End Sub Sub inputskin() Dim TempRs skid=Dvbbs.checkstr(Request("skid")) mdbname=Dvbbs.Checkstr(Trim(Request.form("skinmdb"))) If skid="" or Isnull(skid) or Not IsNumeric(Replace(Replace(skid,",","")," ","")) Then Errmsg=ErrMsg + "
  • 您还未选取要导出的模版，或参数有错误！" Exit Sub End If If mdbname="" Then Errmsg=ErrMsg + "
  • 请请填写导出模版数据库名" Exit Sub End If If Request("submit")="删除" Then If instr(","&skid&",",","&Dvbbs.cachedata(17,0)&",") Then Errmsg=ErrMsg + "
  • 本模板是默认模版，不允许删除。" Exit Sub End If Set Rs=Dvbbs.Execute("select Count(*) From [Dv_Board] Where sid in ("&skid&")") If Rs(0)>0 Then Set Rs=Nothing Errmsg=ErrMsg + "
  • 本模板尚有分论坛在使用，不能删除。" Dvbbs_error() End If Set rs=Nothing Dvbbs.Execute("Delete From [Dv_Style] Where ID in ("&skid&")") Dv_suc("成功删除模板。") Reloadtemplates() Set Rs=Nothing Else SkinConnection(mdbname) ChkSkinMDB() If Errmsg<>"" Then Exit Sub set Rs=Dvbbs.Execute("select * from Dv_Style where id in ("&skid&") order by id ") If Rs.EOF Or Rs.BOF Then Errmsg=ErrMsg + "
  • 无法取出源模版数据" Dvbbs_error() Exit Sub End If Dim InsertName,InsertValue Do while not Rs.eof InsertName="" InsertValue="" For i = 1 to Rs.Fields.Count-1 InsertName=InsertName & Rs(i).Name InsertValue=InsertValue & "'" & Dvbbs.checkStr(Rs(i)) & "'" If i<> Rs.Fields.Count-1 Then InsertName = InsertName & "," InsertValue = InsertValue & "," End If Next StyleConn.Execute("insert into [Dv_Style] ("&InsertName&") values ("&InsertValue&") ") 'StyleConn.Execute("Update [Dv_Style] set "&SQLSTR&" where ID="&SkinMdbID) Rs.movenext loop Rs.close set Rs=nothing Dv_suc(SucMsg&"
  • 数据导出成功！") End If End Sub Sub Load(ACT) %>
    导入模版数据
    导入模版数据库名：
    <% End Sub Sub loadskin() Dim tRs skid=Dvbbs.checkstr(Request("skid")) mdbname=Dvbbs.Checkstr(trim(Request.form("skinmdb"))) If skid="" or isnull(skid) or Not Isnumeric(Replace(Replace(skid,",","")," ","")) Then Errmsg=ErrMsg + "
  • 您还未选取要导入的模版" Exit Sub End If If mdbname="" Then Errmsg=ErrMsg + "
  • 请填写导入模版数据库名" Exit Sub End If SkinConnection(mdbname) If Request("submit")="删除" Then StyleConn.Execute("Delete from Dv_Style where id in ("&skid&")") Dv_suc("删除成功。") Else ChkSkinMDB() if Errmsg<>"" Then Exit Sub Dim InsertName,InsertValue Set TRs=StyleConn.Execute("select * from Dv_Style where id in ("&skid&") order by id ") Do while not TRs.eof InsertName="" InsertValue="" For i = 1 to TRs.Fields.Count-1 InsertName=InsertName & TRs(i).Name InsertValue=InsertValue & "'" & Dvbbs.checkStr(TRs(i)) & "'" If i<> TRs.Fields.Count-1 Then InsertName = InsertName & "," InsertValue = InsertValue & "," End If Next Dvbbs.Execute("insert into [Dv_Style] ("&InsertName&") values ("&InsertValue&") ") TRs.movenext loop TRs.close set Rs=nothing set TRs=nothing Dv_suc("数据导入成功！") Reloadtemplates() End If End Sub '模板改名 Sub rename() Dim sRs skid=Dvbbs.checkstr(Request("skid")) mdbname=Dvbbs.Checkstr(Trim(Request("mdbname"))) If skid<>"" and IsNumeric(skid) Then skid=Clng(skid) Else skid=1 If Request("act")="loadskin" and mdbname<>"" Then SkinConnection(mdbname) set sRs=StyleConn.Execute("select id,StyleName from Dv_Style where id="&skid) Else set sRs=Dvbbs.Execute("select id,StyleName from Dv_Style where id="&skid) End If %>
    <% If Request("act")="loadskin" Then %> <% End If %> ">
    更改模版名称 ID=<%=sRs(0)%>
    模版原名： <%=sRs(1)%>
    模版新名：
    <% sRs.close set sRs=nothing End Sub '模板改名保存 Sub savenm() Dim skinNAME skid=Dvbbs.checkstr(Request.Form("skid")) mdbname=Dvbbs.Checkstr(trim(Request.Form("mdbname"))) skinNAME=Dvbbs.Checkstr(trim(Request.Form("skinname"))) If skid="" or Not IsNumeric(skid) Then Errmsg=ErrMsg + "
  • 请选择正确的参数" Exit Sub End IF If skinNAME="" Then Errmsg=ErrMsg + "
  • 新模板名称不能为空！" Exit Sub End IF If Request("act")="loadskin" and mdbname<>"" Then SkinConnection(mdbname) StyleConn.Execute("UPDATE Dv_Style set StyleName='"&skinNAME&"' where id="&skid) Else Dvbbs.Execute("UPDATE Dv_Style set StyleName='"&skinNAME&"' where id="&skid) ReloadTemplateslist() End If Dv_suc("
  • 数据更新成功！") End Sub Sub ChkSkinMDB() If IsFoundTable("Dv_Style",1)=False Then Errmsg=ErrMsg + "
  • "&mdbname&"数据库中找不到指定的数据表，请新建风格数据表；" Errmsg=ErrMsg + "
  • 现在就新建风格数据表。" Exit Sub End IF '两个表字段比较 Dim TempField,TempRs,TempSql,FalseName,LostName TempField="" FalseName="" TempSql="Select top 1 * From [Dv_Style]" If Request("action")="loadskin" Then Set TempRs = Dvbbs.Execute(TempSql) Else Set TempRs = StyleConn.Execute(TempSql) End If For i= 0 to TempRs.Fields.Count-1 TempField = TempField & TempRs(i).Name &"," Next TempRs.Close TempField=Lcase(TempField) If Request("action")="loadskin" Then Set TempRs = StyleConn.Execute(TempSql) Else Set TempRs = Dvbbs.Execute(TempSql) End If For i = 0 to TempRs.Fields.Count-1 If instr(TempField,Lcase(TempRs(i).Name)) = 0 Then FalseName = FalseName & TempRs(i).Name &"," Else TempField = Replace(TempField,Lcase(TempRs(i).Name),"") TempField = Replace(TempField,",,",",") End If Next TempRs.Close Set TempRs=Nothing If Right(FalseName,1)="," Then FalseName=Left(FalseName,Len(FalseName)-1) If Right(TempField,1)="," Then TempField=Left(TempField,Len(TempField)-1) If Left(TempField,1)="," Then TempField=Replace(TempField,",","",1,1) If FalseName<>"" Then If Request("action")="loadskin" Then Errmsg=ErrMsg + "
  • 备份表中多出以下字段： "& FalseName &" ，请更新数据库结构后再执行刚才的操作！" Else Call AddFields(FalseName) End If 'Errmsg=ErrMsg + "
  • 备份表中缺少字段： "& FalseName &" ，请更新数据库结构后再执行刚才的操作！" End If If TempField<>"" and Request("action")<>"loadskin" Then SucMsg=SucMsg+"
  • 备份表中多出以下字段： "& TempField &" ，你可以点击下面链接删除多余的字段！" SucMsg=SucMsg+"
  • 执行清理删除该字段！" End If End Sub Sub DelFields() Dim Fields,TempFields Fields=Request.QueryString("fields") If Request("mdbname")="" Then Errmsg=ErrMsg + "
  • 请指定备份模版数据库。" Exit Sub Else mdbname=Dvbbs.Checkstr(Trim(Request("mdbname"))) End If If Replace(Fields,",","")="" Then Exit Sub If not IsObject(StyleConn) Then SkinConnection(mdbname) TempFields=Split(Fields,",") For i=0 to Ubound(TempFields) IF TempFields(i)<>"" Then StyleConn.Execute("alter table [Dv_Style] drop COLUMN "&TempFields(i)) End If Next Dv_suc("
  • "&Fields&"删除成功！
  • 返回模板管理首页") End Sub Sub AddFields(Fields) If Replace(Fields,",","")="" Then Exit Sub Dim TempFields,FieldName,FieldSql,FieldValue TempFields=Split(Fields,",") If IsObject(StyleConn) Then For i=0 to Ubound(TempFields) Select case Lcase(TempFields(i)) Case "stylename" FieldValue=TempFields(i) & "=''" FieldSql=TempFields(i) & " varchar(50) NOT NULL" Case "forum_css" FieldValue=TempFields(i) & "='|||@@@|||'" FieldSql=TempFields(i) & " text not Null default '|||@@@|||'" Case Else FieldValue=TempFields(i) & "='|||@@@|||@@@|||@@@|||'" FieldSql=TempFields(i) & " text not Null default '|||@@@|||@@@|||@@@|||'" End Select If Request("action")="loadskin" Then Dvbbs.Execute("alter table [Dv_Style] add "&FieldSql) Dvbbs.Execute("Update [Dv_Style] Set "&FieldValue) Else StyleConn.Execute("alter table [Dv_Style] add "&FieldSql) StyleConn.Execute("Update [Dv_Style] Set "&FieldValue) End IF Next Else Errmsg=ErrMsg + "
  • 备份表链接未曾建立！" End If End Sub 'Forum_CSS 规则 '风格名称|||@@@风格CSS内容|||@@@风格图片目录|||@@@对应的模板ID||| Sub CreateStyleMdb() '|||@@@||| --> Forum_CSS '|||@@@|||@@@|||@@@||| --> other If Request("mdbname")="" Then Errmsg=ErrMsg + "
  • 请指定备份模版数据库。" Exit Sub Else mdbname=Dvbbs.Checkstr(Trim(Request("mdbname"))) End If Dim CreatStr '创建模板数据表 CreatStr = "CREATE TABLE Dv_Style (ID int IDENTITY (1, 1) NOT NULL CONSTRAINT PK_Dv_Style PRIMARY KEY,"&_ "StyleName varchar(50) NOT NULL," Set Rs=Dvbbs.Execute("select top 1 * From [Dv_Style] ") If Rs.EOF Then Errmsg=ErrMsg + "
  • 无法取出源模版数据" Dvbbs_error() Exit Sub End If For i= 3 to Rs.Fields.Count-1 CreatStr=CreatStr & Rs(i).Name & " text not Null default '|||@@@|||@@@|||@@@|||'" If i<> Rs.Fields.Count-1 Then CreatStr=CreatStr & "," End If Next CreatStr=CreatStr & ")" Rs.close:Set Rs=Nothing SkinConnection(mdbname) StyleConn.Execute(CreatStr) '创建独立CSS数据表 CreatStr = "CREATE TABLE Dv_Css (ID int IDENTITY (1, 1) NOT NULL CONSTRAINT PK_Dv_Css PRIMARY KEY,"&_ "Forum_Css text,Add_Time datetime default now())" StyleConn.Execute(CreatStr) Dv_suc("
  • Dv_Style数据表结构创建成功！
  • 返回模板管理首页") End Sub '校验字段是否存在 Function IsTruePage(page) IsTruePage=False If page<>"" Then page=LCase(Trim(page)) Dim myRs Set MyRs=Dvbbs.Execute("Select top 1 * From [Dv_Style]") For i= 2 to MyRs.Fields.Count-1 If LCase(myRs(i).name)=page Then IsTruePage=True Exit Function End If Next Set MyRs=Nothing End If End Function '两个表字段比较 Sub ChkFields() Dim TempField,TempRs,TempSql,FalseName,LostName TempField="" TempSql="Select top 1 * From [Dv_Style]" Set TempRs=StyleConn.Execute(TempSql) For i= 0 to TempRs.Fields.Count-1 TempField = TempField & TempRs(i).Name &"," Next TempRs.Close TempField=Lcase(TempField) Set TempRs = Dvbbs.Execute(TempSql) For i = 0 to TempRs.Fields.Count-1 If instr(TempField,Lcase(TempRs(i).Name)) = 0 Then FalseName = FalseName & TempRs(i).Name &"," Else TempField = Replace(TempField,Lcase(TempRs(i).Name),"") TempField = Replace(TempField,",,",",") End If Next TempRs.Close Set TempRs=Nothing End Sub '校验表名是否存在。TableName=表名，str:0=默认库，1=风格库 Function IsFoundTable(TableName,Str) Dim ChkRs IsFoundTable=False If TableName<>"" Then TableName=LCase(Trim(TableName)) If Str=0 Then Set ChkRs=Conn.openSchema(20) Else Set ChkRs=StyleConn.openSchema(20) End If Do Until ChkRs.EOF If ChkRs("TABLE_TYPE")="TABLE" Then If Lcase(ChkRs("TABLE_NAME"))=TableName then IsFoundTable=True Exit Function End If End If ChkRs.movenext Loop ChkRs.close:Set ChkRs=Nothing End If End Function Sub Reloadtemplates() TemplatesToCache() ReloadTemplateslist() Set Rs = Dvbbs.Execute("Select ID From Dv_Style") If Not (Rs.Eof And Rs.Bof) Then Do While Not Rs.Eof LoadXslttemplate Rs(0) Rs.MoveNext Loop End If Rs.Close Set Rs=Nothing End Sub Function TempLateName() Dim MaxTempID,MyTempLateName Dim Rs,Sql Set Rs = Dvbbs.Execute("Select Max(ID) From Dv_Style") MaxTempID = Rs(0) If IsNull(MaxTempID) Then MaxTempID = 0 Sql = "Select ID,StyleName From Dv_Style" Set Rs = Dvbbs.Execute(Sql) If Rs.Eof And Rs.Bof Then Exit Function Else 'Response.Write Rs.RecordCount ReDim MyTempLateName(MaxTempID) Do While Not Rs.Eof MyTempLateName(Rs(0)) = Rs(1) Rs.MoveNext Loop End If TempLateName = MyTempLateName End Function %>