admin_loadskin.asp

品泡女人香XI8.NET文章管理系统的源码

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)
	Dvbbs.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 = 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=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
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

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,"&_
	"Forum_CSS text not Null default '|||@@@|||',"
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)
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=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
%>