admin_loadskin.asp

来自「多用户管理分权限发布、管理软件信息;  自由选择系统默认为静态HTML或动态A」· ASP 代码 · 共 564 行 · 第 1/2 页

ASP
564
字号
	End If
End Sub

Private Sub rename()
	Dim sRs
	'模板改名
	skid = Newasp.checkStr(Request("skid"))
	mdbname = Newasp.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,TempName from NC_Template where id=" & skid)
	Else
		Set sRs = Newasp.Execute("select id,TempName from NC_Template where id=" & skid)
	End If
	Response.Write "<form action=""?action=savenm"" method=post >" & vbCrLf
	Response.Write "<table border=""0"" cellspacing=""1"" cellpadding=""5"" align=center width=""95%"" class=""tableBorder"">" & vbCrLf
	Response.Write "<tr><th colspan=""2"">更改模版名称 ID="
	Response.Write sRs(0)
	Response.Write "</td></tr>" & vbCrLf
	Response.Write "<tr>" & vbCrLf
	Response.Write Chr(9) & "<td width=""20%"" class=""forumrow"">模版原名:</td>" & vbCrLf
	Response.Write Chr(9) & "<td width=""80%"" class=""forumrow"">"
	Response.Write sRs(1)
	Response.Write "</td>" & vbCrLf
	Response.Write "</tr>" & vbCrLf
	Response.Write "<tr>" & vbCrLf
	Response.Write Chr(9) & "<td class=""forumrow"">模版新名:</td>" & vbCrLf
	Response.Write Chr(9) & "<td class=""forumrow""><input type=""text"" name=""skinNAME"" size=""30"" value=""""></td>" & vbCrLf
	Response.Write "</tr>" & vbCrLf
	Response.Write "<tr><td align=center class=forumRowHighlight colspan=""2""><input class=button type=""submit"" name=""submit"" value=""更 新""></td></tr>" & vbCrLf
	If Request("act") = "loadskin" Then
		Response.Write "<input TYPE=""hidden"" NAME=""mdbname"" VALUE="""
		Response.Write mdbname
		Response.Write """>" & vbCrLf
	End If
	Response.Write "<input TYPE=""hidden"" NAME=""skid"" VALUE="""
	Response.Write sRs(0)
	Response.Write """>" & vbCrLf
	Response.Write "<input TYPE=""hidden"" NAME=""act"" VALUE="""
	Response.Write Request("act")
	Response.Write """>" & vbCrLf
	Response.Write "</table></form>" & vbCrLf
	sRs.Close
	Set sRs = Nothing
End Sub

Private Sub savenm()
	Dim skinNAME
	'模板改名保存
	skid = Newasp.checkStr(Request.Form("skid"))
	mdbname = Newasp.checkStr(Trim(Request.Form("mdbname")))
	skinNAME = Newasp.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 NC_Template set TempName='" & skinNAME & "'  where id=" & skid)
	Else
		Newasp.Execute ("UPDATE NC_Template set TempName='" & skinNAME & "'  where id=" & skid)
		Newasp.DelCahe ("Templateslist")
	End If
	NC_Admin.Succeed_Msg ("<li>数据更新成功!")
End Sub

Private Sub ChkSkinMDB()
	Dim TempField
	Dim TempRs
	Dim TempSql
	Dim FalseName
	Dim LostName
	If IsFoundTable("NC_Template", 1) = False Then
		ErrMsg = ErrMsg + "<li>" & mdbname & "数据库中找不到指定的数据表,请新建风格数据表;"
		ErrMsg = ErrMsg + "<li><a href=?action=CreatMdb&mdbname=" & mdbname & " >现在就新建风格数据表</a>。"
		Exit Sub
	End If
	'两个表字段比较
	TempField = ""
	FalseName = ""
	TempSql = "Select top 1 * From [NC_Template]"
	If Request("action") = "loadskin" Then
		Set TempRs = Newasp.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 = Newasp.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
	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

Private Sub DelFields()
	Dim Fields
	Dim TempFields
	Fields = Request.Querystring("fields")
	If Request("mdbname") = "" Then
		ErrMsg = ErrMsg + "<BR><li>请指定备份模版数据库。"
		Exit Sub
	Else
		mdbname = Newasp.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 [NC_Template] drop COLUMN " & TempFields(i))
		End If
	Next
	NC_Admin.Succeed_Msg ("<li>" & Fields & "删除成功!<li><a href=admin_loadskin.asp>返回模板管理首页</a>")
End Sub

Private Sub AddFields(Fields)
	Dim TempFields
	Dim FieldName
	Dim FieldSql
	Dim FieldValue
	If Replace(Fields, ",", "") = "" Then Exit Sub
	TempFields = Split(Fields, ",")
	If IsObject(StyleConn) Then
		For i = 0 To UBound(TempFields)
			Select Case LCase(TempFields(i))
				Case "TempName"
					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
				Newasp.Execute ("alter table [NC_Template] add " & FieldSql)
				Newasp.Execute ("Update [NC_Template] Set " & FieldValue)
			Else
				StyleConn.Execute ("alter table [NC_Template] add " & FieldSql)
				StyleConn.Execute ("Update [NC_Template] Set " & FieldValue)
			End If
		Next
	Else
		ErrMsg = ErrMsg + "<li>备份表链接未曾建立!"
	End If
End Sub

Private Sub CreateStyleMdb()
	Dim CreatStr
	If Request("mdbname") = "" Then
		ErrMsg = ErrMsg + "<BR><li>请指定备份模版数据库。"
		Exit Sub
	Else
		mdbname = Newasp.checkStr(Trim(Request("mdbname")))
	End If
	CreatStr = "CREATE TABLE NC_Template (ID int IDENTITY (1, 1) NOT NULL CONSTRAINT PK_NC_Template PRIMARY KEY," & _
		   "TempName varchar(50) NOT NULL," & _
		   "Forum_CSS text not Null default '|||@@@|||',"
	Set Rs = Newasp.Execute("select top 1 * From [NC_Template] ")
	If Rs.EOF Then
		ErrMsg = ErrMsg + "<li>无法取出源模版数据"
		Founderr = True
		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)
	NC_Admin.Succeed_Msg ("<li>NC_Template数据表结构创建成功!<li><a href=admin_loadskin.asp>返回模板管理首页</a>")
End Sub

Private Function IsTruePage(page)
	Dim MyRs
	'校验字段是否存在
	IsTruePage = False
	If page <> "" Then
		page = LCase(Trim(page))
		Set MyRs = Newasp.Execute("Select top 1 * From [NC_Template]")
		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

Private Sub ChkFields()
	Dim TempField
	Dim TempRs
	Dim TempSql
	Dim FalseName
	Dim LostName
	'两个表字段比较
	TempField = ""
	TempSql = "Select top 1 * From [NC_Template]"
	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 = Newasp.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

Private 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
%>

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?