gusucode.com > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告) > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告)\13学生论坛ASPAC\BBS\admin_loadskin.asp

    <!--#include file="conn.asp"-->
<!-- #include file="inc/const.asp" -->
<!-- #include file="inc/DvADChar.asp" -->
<%Head()%>
<script language="JavaScript">
<!--
function CheckAll(form)  {
  for (var i=0;i<form.elements.length;i++)    {
    var e = form.elements[i];
    if (e.name != 'chkall'){
	e.checked = form.chkall.checked;
	}
   }
  }
//-->
</script>
<table border="0" cellspacing="1" cellpadding="5" align=center width="95%" class="tableBorder">
<tr>
<th colspan="3" align="center" ID="TableTitleLink"><a href=?>论坛模版导出功能</a> | <a href=?action=load>论坛模版导入功能</a></th>
</tr>
<tr>
<td class="forumrow">
注意<br>
1,确认模版数据库名正确;<br>
2,如模版数据库放在skin目录下,即填写:Skins/Dv_skin.mdb;<br>
3,模版数据库内备份的表名为Dv_Style,请不要更改;<br>
4,模版数据包括论坛CSS设置,与及所有论坛图片设置.
</td>
</tr>
</table><br>
<%
Dim admin_flag
Dim skid,sname,act,mdbname,StyleConn,SucMsg
admin_flag=",21,"
If not Mybbs.master or instr(","&session("flag")&",",admin_flag)=0 Then
	Errmsg=ErrMsg + "<BR><li>本页面为管理员专用,请<a href=admin_index.asp target=_top>登录</a>后进入。<br><li>您没有管理本页面的权限。"
	dvbbs_error()
Else
	If Request("action")="inputskin" Then
		Call inputskin()
	ElseIf Request("action")="loadskin" Then
		Call loadskin()
	ElseIf Request("action")="load" Then
		Call load()
	ElseIf Request("action")="rename" Then
		Call rename()
	ElseIf Request("action")="savenm" Then
		Call savenm()
	ElseIf Request("action")="CreatMdb" Then
		Call CreateStyleMdb()
	ElseIf Request("action")="DelFields" Then
		Call DelFields()
	Else
		Call MAIN()
	End If
End If
If Errmsg<>"" Then dvbbs_error()
If IsObject(StyleConn) Then
	StyleConn.close
	Set StyleConn=Nothing
End IF
Call Footer()

Sub MAIN()
If Request("action")="loadthis" Then
    sname="导入"
    act="loadskin"
    mdbname=Mybbs.Checkstr(trim(Request.form("skinmdb")))
    If mdbname="" Then
		Errmsg=ErrMsg + "<li>请填写导出模版保存的表名"
		Exit Sub
	End If
Else
	sname="导出"
	act="inputskin"
End If
%>
<table border="0" cellspacing="1" cellpadding="5" align=center width="95%" class="tableBorder">
<tr><th width="100%" colspan="4"><%=sname%>论坛模版列表</th></tr>
<tr>
<td width="10%"  align="center" class="forumrow">序号</td>
<td width="65%"  align="center" class="forumrow">模版名称</td>
<td width="20%"  align="center" class="forumrow">操作</td>
<td width="5%"  align="center" class="forumrow">选择</td>
</tr>
<form action="?action=<%=act%>" method=post name=even>
<%
If act="loadskin" Then
	SkinConnection(mdbname)
	set Rs=StyleConn.Execute("select id,StyleName from Dv_Style order by id ")
Else
	set Rs=Mybbs.Execute("select id,StyleName from Dv_Style order by id ")
End If
	do while not Rs.eof
%>
<tr>
	<td class="forumrow"><%=Rs("id")%></td>
	<td class="forumrow"><%=Rs("StyleName")%></td>
	<td class="forumrow" align=center>
	<a href="?action=rename&act=<%=act%>&skid=<%=Rs("id")%>&mdbname=<%=mdbname%>" >改名</a>
	<%If act<>"loadskin" Then
	Response.Write " | <a href=""admin_template.asp?action=manage&mostyle=编 辑&StyleID="&Rs("id")&""" >编辑</a>"
	End If %>
	</td>
	<td class="forumrow" align=center><input type="checkbox" name="skid" value="<%=Rs("id")%>"></td>
</tr>
<%	Rs.movenext
	loop
	Rs.close:Set Rs=Nothing
%>
<tr>
<td colspan="4" align=center class="forumRowHighlight">
<%=sname%>的数据库:<input type="text" name="skinmdb" size="30" value="Skins/Dv_skin.mdb">
<input type="submit" name="submit" value="<%=sname%>">
<input type=submit name=Submit value=删除  onclick="{if(confirm('注意:所删除的模版将不能恢复!')){this.document.even.submit();return true;}return false;}">  <input type=checkbox name=chkall value=on onclick="CheckAll(this.form)">全选</td>
</tr>
</form>
</table>
<% 
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 + "<li>"&mdbname&"数据库不存在。"
		Dvbbs_error()
		Response.end
	End If
End Sub

Sub inputskin()
Dim TempRs
	skid=Mybbs.checkstr(Request("skid"))
   	mdbname=Mybbs.Checkstr(Trim(Request.form("skinmdb")))
If skid="" or Isnull(skid) or Not IsNumeric(Replace(Replace(skid,",","")," ","")) Then
	Errmsg=ErrMsg + "<li>您还未选取要导出的模版,或参数有错误!"
	Exit Sub
End If
If mdbname="" Then
	Errmsg=ErrMsg + "<li>请请填写导出模版数据库名"
	Exit Sub
End If

If Request("submit")="删除" Then
	If instr(","&skid&",",","&Mybbs.cachedata(17,0)&",") Then 
		Errmsg=ErrMsg + "<BR><li>本模板是默认模版,不允许删除。"
		Exit Sub
	End If
	Set Rs=Mybbs.Execute("select Count(*) From [Dv_Board] Where sid in ("&skid&")")
	If Rs(0)>0 Then
		Set Rs=Nothing 
		Errmsg=ErrMsg + "<BR><li>本模板尚有分论坛在使用,不能删除。"
		Dvbbs_error()
	End If
	Set rs=Nothing 
	Mybbs.Execute("Delete From [Dv_Style] Where ID in ("&skid&")")
	Dv_suc("成功删除模板。")
	Mybbs.DelCahe("Templateslist")
	'删除该模板所有页面缓存
	Set Rs=Mybbs.Execute("Select Top 0 * From [Dv_Style]")
	For i=2 to Rs.Fields.Count-1
		Mybbs.DelCahe(Rs(i).Name&skid)	
	Next
	Mybbs.DelCahe("BbsListTop"&skid)
	Set Rs=Nothing
Else
	SkinConnection(mdbname)
	ChkSkinMDB()
	If Errmsg<>"" Then Exit Sub
	set Rs=Mybbs.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 & "'" & Mybbs.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()
%>
<form action="?action=loadthis" 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"></td>
</tr>
<tr><th colspan="2"><input type="submit" name="submit" value="下一步"></th></tr>
</table></form>
<%
End Sub

Sub loadskin()
Dim tRs
skid=Mybbs.checkstr(Request("skid"))
mdbname=Mybbs.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 & "'" & Mybbs.checkStr(TRs(i)) & "'"
		If i<> TRs.Fields.Count-1 Then 
			InsertName	= InsertName & ","
			InsertValue	= InsertValue & ","
		End If
	Next
Mybbs.Execute("insert into [Dv_Style] ("&InsertName&") values ("&InsertValue&") ")
TRs.movenext
loop
TRs.close
set Rs=nothing
set TRs=nothing
Dv_suc("数据导入成功!")
Mybbs.DelCahe("Templateslist")
End If

End Sub

'模板改名
Sub rename()
Dim sRs
skid=Mybbs.checkstr(Request("skid"))
mdbname=Mybbs.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=Mybbs.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=Mybbs.checkstr(Request.Form("skid"))
    mdbname=Mybbs.Checkstr(trim(Request.Form("mdbname")))
	skinNAME=Mybbs.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
	Mybbs.Execute("UPDATE Dv_Style set StyleName='"&skinNAME&"'  where id="&skid)
	Mybbs.DelCahe("Templateslist")
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 = Mybbs.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 = Mybbs.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=Mybbs.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=admin_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
Mybbs.Execute("alter table [Dv_Style] add "&FieldSql)
Mybbs.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

Sub CreateStyleMdb()
'|||@@@|||					--> Forum_CSS
'|||@@@|||@@@|||@@@|||		--> other
If Request("mdbname")="" Then
	Errmsg=ErrMsg + "<BR><li>请指定备份模版数据库。"
	Exit Sub
Else
	mdbname=Mybbs.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,"&_
	"Forum_CSS text not Null default '|||@@@|||',"
Set Rs=Mybbs.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)
Dv_suc("<li>Dv_Style数据表结构创建成功!<li><a href=admin_loadskin.asp>返回模板管理首页</a>")
End Sub

'校验字段是否存在
Function IsTruePage(page)
IsTruePage=False
If page<>"" Then 
	page=LCase(Trim(page))
	Dim myRs
	Set MyRs=Mybbs.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 = Mybbs.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
%>