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 + -
显示快捷键?