loadskin.asp

前台及后台用户名密码都是：gz35gz35.com

		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 + "<BR><li>无法取出源模版数据"
			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&"<li>数据导出成功！")
	End If
End Sub

Sub Load(ACT)
	%>
	<form action="?action=<%=ACT%>" method=post>
	<table border="0"  cellspacing="1" cellpadding="5" height="1" align=center width="95%" class="tableBorder">
	<tr><th colspan="2">导入模版数据</th></tr>
	<tr>
	<td width="20%" class="forumrow">导入模版数据库名：</td>
	<td width="80%" class="forumrow">
	<input type="text" name="skinmdb" size="30" value="../Skins/Dv_skin.mdb">
	<input type="hidden" name="ReAct" value="ShowCss">
	</td>
	</tr>
	<tr><th colspan="2"><input type="submit" name="submit" value="下一步"></th></tr>
	</table></form>
	<%
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 + "<BR><li>您还未选取要导入的模版"
		Exit Sub
	End If
	If mdbname="" Then
		Errmsg=ErrMsg + "<BR><li>请填写导入模版数据库名"
		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
	%>
	<form action="?action=savenm" method=post >
	<table border="0"  cellspacing="1" cellpadding="5" align=center width="95%" class="tableBorder">
	<tr><th colspan="2">更改模版名称 ID=<%=sRs(0)%></td></tr>
	<tr>
		<td width="20%" class="forumrow">模版原名：</td>
		<td width="80%" class="forumrow"><%=sRs(1)%></td>
	</tr>
	<tr>
		<td class="forumrow">模版新名：</td>
		<td class="forumrow"><input type="text" name="skinNAME" size="30" value=""></td>
	</tr>
	<tr><th colspan="2"><input type="submit" name="submit" value="更新"></th></tr>
	<% If Request("act")="loadskin" Then
	%><input TYPE="hidden" NAME="mdbname" VALUE="<% =mdbname %>">
	<% End If %>
	<input TYPE="hidden" NAME="skid" VALUE="<% =sRs(0) %>">
	<input TYPE="hidden" NAME="act" VALUE="<% =Request("act") %>">
	</table></form>
	<%
	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 + "<BR><li>请选择正确的参数"
		Exit Sub
	End IF
	If skinNAME=""  Then
		Errmsg=ErrMsg + "<li>新模板名称不能为空！"
		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("<li>数据更新成功！")
End Sub

Sub ChkSkinMDB()
	If IsFoundTable("Dv_Style",1)=False Then
		Errmsg=ErrMsg + "<li>"&mdbname&"数据库中找不到指定的数据表，请新建风格数据表；"
		Errmsg=ErrMsg + "<li><a href=?action=CreatMdb&mdbname="&mdbname&" >现在就新建风格数据表</a>。"
		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 + "<li>备份表中多出以下字段： "& FalseName &" ，请更新数据库结构后再执行刚才的操作！"
		Else
			Call AddFields(FalseName)
		End If
		'Errmsg=ErrMsg + "<li>备份表中缺少字段： "& FalseName &" ，请更新数据库结构后再执行刚才的操作！"
	End If
	If TempField<>"" and Request("action")<>"loadskin" Then
	SucMsg=SucMsg+"<li>备份表中多出以下字段： "& TempField &" ，你可以点击下面链接删除多余的字段！"
	SucMsg=SucMsg+"<li><a href=?action=DelFields&fields="&TempField&"&mdbname="&mdbname&"><font color=red>执行清理删除该字段！</font></a>"
	End If
End Sub

Sub DelFields()
	Dim Fields,TempFields
	Fields=Request.QueryString("fields")
	If Request("mdbname")="" Then
		Errmsg=ErrMsg + "<BR><li>请指定备份模版数据库。"
		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("<li>"&Fields&"删除成功！<li><a href=loadskin.asp>返回模板管理首页</a>")
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 + "<li>备份表链接未曾建立！"
	End If
End Sub


'Forum_CSS 规则
'风格名称|||@@@风格CSS内容|||@@@风格图片目录|||@@@对应的模板ID|||
Sub CreateStyleMdb()
	'|||@@@|||					--> Forum_CSS
	'|||@@@|||@@@|||@@@|||		--> other
	If Request("mdbname")="" Then
		Errmsg=ErrMsg + "<BR><li>请指定备份模版数据库。"
		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 + "<li>无法取出源模版数据"
			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("<li>Dv_Style数据表结构创建成功！<li><a href=loadskin.asp>返回模板管理首页</a>")
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
%>