📄 wm.skin.asp
字号:
sRs.Open "Select WM_Name,WM_Explain,WM_Content,WM_Type,WM_Taxis,WM_SaveType,WM_SkinDir,WM_Sort,WM_Cache From WM_Label",sConn,1,3
sRs.AddNew
sRs(0) = WM_Name
sRs(1) = WM_Explain
sRs(2) = WM_Contents
sRs(3) = WM_Type
sRs(4) = WM_Taxis
sRs(5) = WM_SaveType
sRs(6) = WM_SkinFolder(i)
sRs(7) = WM_Sort
sRs(8) = WM_Cache
sRs.Update
sRs.Close
Rs.MoveNext
Loop
Rs.Close
Set Rs = Conn.Execute("Select WM_ADBig,WM_Tag From WM_ADSbig Where WM_SkinDir='"&WM_SkinFolder(i)&"'")
Do While Not Rs.Eof
WM_ADBig = Rs(0)
WM_Tag = Rs(1)
sConn.Execute("INSERT Into WM_ADSbig(WM_ADBig,WM_Tag,WM_SkinDir)values('"&WM_ADBig&"','"&WM_Tag&"','"&WM_SkinFolder(i)&"')")
Rs.MoveNext
Loop
Rs.Close
Set Rs = Conn.Execute("Select WM_ADBigID,WM_Tag,WM_ADSmall,WM_ADSize,WM_AdsType From WM_ADSsmall Where WM_SkinDir='"&WM_SkinFolder(i)&"'")
Do While Not Rs.Eof
WM_ADBigID = Rs(0)
WM_Tag = Rs(1)
WM_ADSmall = Rs(2)
WM_ADSize = Rs(3)
WM_AdsType = Rs(4)
sConn.Execute("INSERT Into WM_ADSsmall(WM_ADBigID,WM_Tag,WM_ADSmall,WM_ADSize,WM_AdsType,WM_SkinDir)values('"&WM_ADBigID&"','"&WM_Tag&"','"&WM_ADSmall&"','"&WM_ADSize&"',"&WM_AdsType&",'"&WM_SkinFolder(i)&"')")
Rs.MoveNext
Loop
Rs.Close
Set Rs = Conn.Execute("Select WM_AreaID,WM_Big,WM_Small,WM_Sort,WM_Type,WM_Pic,WM_Text,WM_Url,WM_Code,WM_Size,WM_OpenType,WM_PlayType,WM_Begin,WM_End,WM_SiteTitle,WM_Name,WM_Contact,WM_Remark,WM_Time,WM_Magic From WM_ADS Where WM_SkinDir='"&WM_SkinFolder(i)&"'")
Do While Not Rs.Eof
WM_AreaID = Rs(0)
WM_Big= Rs(1)
WM_Small= Rs(2)
WM_Sort= Rs(3)
WM_Type= Rs(4)
WM_Pic= Rs(5)
WM_Text= Rs(6)
WM_Url= Rs(7)
WM_Code= Rs(8)
WM_Size= Rs(9)
WM_OpenType= Rs(10)
WM_PlayType= Rs(11)
WM_Begin= Rs(12)
WM_End= Rs(13)
WM_SiteTitle= Rs(14)
WM_Name= Rs(15)
WM_Contact= Rs(16)
WM_Remark= Rs(17)
WM_Time= Rs(18)
WM_Magic= Rs(19)
sRs.Open "Select WM_AreaID,WM_Big,WM_Small,WM_Sort,WM_Type,WM_Pic,WM_Text,WM_Url,WM_Code,WM_Size,WM_OpenType,WM_PlayType,WM_Begin,WM_End,WM_SiteTitle,WM_Name,WM_Contact,WM_Remark,WM_Time,WM_Magic,WM_SkinDir From WM_ADS",sConn,1,3
sRs.AddNew
sRs(0) = WM_AreaID
sRs(1) = WM_Big
sRs(2) = WM_Small
sRs(3) = WM_Sort
sRs(4) = WM_Type
sRs(5) = WM_Pic
sRs(6) = WM_Text
sRs(7) = WM_Url
sRs(8) = WM_Code
sRs(9) = WM_Size
sRs(10) = WM_OpenType
sRs(11) = WM_PlayType
sRs(12) = WM_Begin
sRs(13) = WM_End
sRs(14) = WM_SiteTitle
sRs(15) = WM_Name
sRs(16) = WM_Contact
sRs(17) = WM_Remark
sRs(18) = WM_Time
sRs(19) = WM_Magic
sRs(20) = WM_SkinFolder(i)
sRs.Update
sRs.Close
Rs.MoveNext
Loop
Rs.Close
End If
Next
Call sConnEnd()
End If
Set sRs = Nothing
Set Rs = Nothing
Call WRMPS.ErrView("·模板导出成功<meta http-equiv=refresh content='1;URL=?Action=Export'>", 1)
Case "Export"
Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 Class=td1>" & vbCrLf
Content = Content & "<form name=addform method='post' action='?Action=ExportSave'>" & vbCrLf
Content = Content & "<tr Class=td4><td colspan=5><strong>可导出主题</strong></td></tr>" & vbCrLf
Content = Content & "<tr class=td3 align=center>" & vbCrLf
Content = Content & "<td width='4%'><input name='chkall' type='checkbox' id='chkall' value='select' onclick=""CheckAll(this.form)"" style='border:0'></td>" & vbCrLf
Content = Content & "<td width='15%'>主题名称</td>" & vbCrLf
Content = Content & "<td width='10%'>主题目录</td>" & vbCrLf
Content = Content & "<td width=*>说明</td>" & vbCrLf
Content = Content & "</tr>" & vbCrLf
Set Rs = Conn.Execute("Select WM_SkinName,WM_SkinFolder,WM_SkinExplain,WM_ID from WM_Skin Order By WM_ID Desc")
Do While Not Rs.Eof
Content = Content & "<tr class=td2>" & vbCrLf
Content = Content & "<td align=center><input type=checkbox name=WM_SkinFolder value="&Rs(1)&"></td>" & vbCrLf
Content = Content & "<td>"&Rs(0)&"</td>" & vbCrLf
Content = Content & "<td>"&Rs(1)&"</td>" & vbCrLf
Content = Content & "<td>"&Rs(2)&"</td>" & vbCrLf
Content = Content & "</tr>" & vbCrLf
Rs.MoveNext
Loop
Rs.Close
Set Rs = Nothing
Content = Content & "<tr class=td3>" & vbCrLf
Content = Content & "<td colspan=3><strong>目标数据库路径</strong></td>" & vbCrLf
Content = Content & "<td><input name='DBPath' type='text' size=20 style='width:200' value='../Skins/Skin.Mdb'></td>" & vbCrLf
Content = Content & "</tr>" & vbCrLf
Content = Content & "<tr class=td2><td colspan=3></td><td><input type=submit name=Submit value='提 交'></td></tr>" & vbCrLf
Content = Content & "</form>" & vbCrLf
Content = Content & "</table>" & vbCrLf
Case "Edit"
WM_SkinName = WRMPS.CheckStr(Request.Form("WM_SkinName"), 0)
WM_SkinFolder = WRMPS.CheckStr(Request.Form("WM_SkinFolder"), 0)
WM_SkinExplain = WRMPS.CheckStr(Request.Form("WM_SkinExplain"), 0)
WM_SkinCss = Request.Form("WM_SkinCss")
If WM_SkinName = "" Then Call WRMPS.ErrView("·主题名称不能为空", 0): Exit Sub
If WM_SkinFolder = "" Then Call WRMPS.ErrView("·主题包目录填写有误", 0): Exit Sub
If WM_SkinExplain = "" Then WM_SkinExplain = Null
Rs.Open "select WM_SkinName,WM_SkinExplain from WM_Skin where WM_ID=" & WRMPS.CheckStr(Request("WM_ID"), 1) & "", Conn, 1, 3
If Not Rs.EOF Then
Rs(0) = WM_SkinName
Rs(1) = WM_SkinExplain
Rs.Update
Rs.Close
Else
Rs.Close
Call WRMPS.ErrView("·操作错误", 0): Exit Sub
End If
Path = "../Skins/" & WM_SkinFolder &"/"
StyleFileName = Path & "Style.Css"
Call WRMPS.FsoBegin()
On Error Resume Next
Call WRMPS.CreFolder(Path)
If Err Then Err.Clear:Call WRMPS.ErrView("·主题包目录写入出错", 0): Exit Sub
On Error Resume Next
Call WRMPS.CreateFile(StyleFileName,WM_SkinCss)
If Err Then Err.Clear:Call WRMPS.ErrView("·主题文件(Style.Css)写入出错", 0): Exit Sub
Call WRMPS.FsoEnd()
Response.Redirect "WM.Skin.asp"
Case "Save"
WM_SkinName = WRMPS.CheckStr(Request.Form("WM_SkinName"), 0)
WM_SkinFolder = WRMPS.CheckStr(Request.Form("WM_SkinFolder"), 0)
WM_SkinExplain = WRMPS.CheckStr(Request.Form("WM_SkinExplain"), 0)
WM_SkinCss = Request.Form("WM_SkinCss")
If WM_SkinName = "" Then Call WRMPS.ErrView("·主题名称不能为空", 0): Exit Sub
If WM_SkinFolder = "" Then Call WRMPS.ErrView("·主题包目录填写有误",0): Exit Sub
If WM_SkinExplain = "" Then WM_SkinExplain = Null
Rs.Open "select WM_SkinName,WM_SkinFolder,WM_SkinExplain from WM_Skin where WM_SkinFolder='" & WM_SkinFolder & "'", Conn, 1, 3
If Rs.EOF Then
Rs.AddNew
Rs(0) = WM_SkinName
Rs(1) = WM_SkinFolder
Rs(2) = WM_SkinExplain
Rs.Update
Rs.Close
Else
Rs.Close
Call WRMPS.ErrView("·您填写的主题已存在", 0): Exit Sub
End If
Path = "../Skins/" & WM_SkinFolder & "/"
StyleFileName = Path & "Style.Css"
Call WRMPS.FsoBegin()
If WRMPS.FsoIsTrue("Dir",Path) = True Then Call WRMPS.ErrView("·主题包目录已经存在", 0): Exit Sub
On Error Resume Next
Call WRMPS.CreFolder(Path)
If Err Then Err.Clear:Call WRMPS.ErrView("·主题包目录写入出错", 0): Exit Sub
On Error Resume Next
Call WRMPS.CreateFile(StyleFileName,WM_SkinCss)
If Err Then
Err.Clear
Conn.Execute ("delete From WM_Skin Where WM_SkinFolder = '" & WM_SkinFolder & "'")
Call WRMPS.ErrView("·主题文件(Style.Css)写入出错", 0): Exit Sub
End If
Call WRMPS.FsoEnd()
Response.Redirect "WM.Skin.asp"
Case "Del"
WM_SkinFolder = WRMPS.CheckStr(Request("WM_SkinFolder"), 0)
Conn.Execute ("delete from WM_Skin Where WM_SkinFolder='" & WM_SkinFolder & "'")
Conn.Execute ("delete from WM_Templates Where WM_SkinFolder='" & WM_SkinFolder & "'")
Conn.Execute ("delete from WM_Label Where WM_SkinDir='" & WM_SkinFolder & "'")
Conn.Execute ("delete From WM_LabelSort Where WM_SkinDir='" & WM_SkinFolder & "'")
Call WRMPS.FsoBegin()
Call WRMPS.FsoDel("Dir","../Skins/" & WM_SkinFolder)
Call WRMPS.FsoEnd()
Response.Redirect "WM.Skin.asp"
Case "EditSkin"
Rs.Open "Select WM_SkinFolder,WM_SkinName,WM_SkinExplain from WM_Skin Where WM_ID=" & WRMPS.CheckStr(Request("WM_ID"), 1) & "", Conn, 1, 1
If Not Rs.EOF Then
Call WRMPS.FsoBegin()
If WRMPS.FsoIsTrue("File","../Skins/"&Rs(0)&"/Style.Css") = True Then WM_SkinCss = WRMPS.GetHtml("../Skins/"&Rs(0)&"/Style.Css") Else WM_SkinCss = ""
Call WRMPS.FsoEnd()
Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 Class=td1>" & vbCrLf
Content = Content & "<form name=addform method='post' action='?Action=Edit'>" & vbCrLf
Content = Content & "<input name=WM_ID type=hidden value=" & WRMPS.CheckStr(Request("WM_ID"), 1) & ">" & vbCrLf
Content = Content & "<tr Class=td4><td colspan=2><strong>修改主题</strong></td></tr>" & vbCrLf
Content = Content & "<tr class=td2><td width='25%'><strong>主题名称</strong></td>" & vbCrLf
Content = Content & "<td width='75%'><input name='WM_SkinName' type='text' size=20 style='width:150' maxlength=50 value='" & Rs(1) & "'> <font Class=Font2>*</font></td></tr>" & vbCrLf
Content = Content & "<tr class=td2><td><strong>主题包目录</strong><br>必须放在系统根目录的Skins目录下<br>只能由数字、英文组成<br>如 /Skins/ABC/ 则请填写 ABC<br><font class=font2>注意：添加后将不能修改</font></td>" & vbCrLf
Content = Content & "<td><input name=WM_SkinFolder type=text size=20 style='width:100' maxlength=30 readonly value='" & Rs(0) & "'> <font Class=Font2>*</font></td></tr>" & vbCrLf
Content = Content & "<tr class=td2><td><strong>主题说明</strong></td>" & vbCrLf
Content = Content & "<td><input name='WM_SkinExplain' type='text' size=20 style='width:400' maxlength=50 value='" & Rs(2) & "'></td></tr>" & vbCrLf
Content = Content & "<tr class=td2><td><strong>主题CSS</strong></td>" & vbCrLf
Content = Content & "<td><textarea name=WM_SkinCss style='width:600;height:450'>"&WM_SkinCss&"</textarea></td></tr>" & vbCrLf
Content = Content & "<tr class=td2><td></td><td><input type=submit name=Submit value='提 交'></td></tr>" & vbCrLf
Content = Content & "</form></table><script>document.addform.WM_SkinName.focus()</script>" & vbCrLf
End If
Rs.Close
Case "AddSkin"
Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 Class=td1>" & vbCrLf
Content = Content & "<form name=addform method='post' action='?Action=Save'>" & vbCrLf
Content = Content & "<tr Class=td4><td colspan=2><strong>添加主题</strong></td></tr>" & vbCrLf
Content = Content & "<tr class=td2><td width='25%'><strong>主题名称</strong></td>" & vbCrLf
Content = Content & "<td width='75%'><input name='WM_SkinName' type='text' size=20 style='width:150' maxlength=50> <font Class=Font2>*</font></td></tr>" & vbCrLf
Content = Content & "<tr class=td2><td><strong>主题包目录</strong><br>必须放在系统根目录的Skins目录下<br>只能由数字、英文组成<br>如 /Skins/ABC/ 则请填写 ABC<br><font class=font2>注意：添加后将不能修改</font></td>" & vbCrLf
Content = Content & "<td><input name=WM_SkinFolder type=text size=20 style='width:100' maxlength=30> <font Class=Font2>*</font></td></tr>" & vbCrLf
Content = Content & "<tr class=td2><td><strong>主题说明</strong></td>" & vbCrLf
Content = Content & "<td><input name='WM_SkinExplain' type='text' size=20 style='width:400' maxlength=50></td></tr>" & vbCrLf
Content = Content & "<tr class=td2><td><strong>主题CSS</strong></td>" & vbCrLf
Content = Content & "<td><textarea name=WM_SkinCss style='width:600;height:450'></textarea></td></tr>" & vbCrLf
Content = Content & "<tr class=td2><td></td><td><input type=submit name=Submit value='提 交'></td></tr>" & vbCrLf
Content = Content & "</form></table><script>document.addform.WM_SkinName.focus()</script>" & vbCrLf
Case Else
Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 Class=td1>" & vbCrLf
Content = Content & "<tr Class=td4><td colspan=5><strong>主题管理</strong></td></tr>" & vbCrLf
Rs.Open "Select WM_SkinName,WM_SkinFolder,WM_SkinExplain,WM_ID from WM_Skin Order By WM_ID Desc", Conn, 1, 1
Content = Content & "<tr class=td3 align=center>" & vbCrLf
Content = Content & "<td width='12%'>主题名称</td>" & vbCrLf
Content = Content & "<td width='11%'>主题目录</td>" & vbCrLf
Content = Content & "<td width=*>说明</td>" & vbCrLf
Content = Content & "<td width='12%'>当前使用主题</td>" & vbCrLf
Content = Content & "<td width='15%'>操作</td>" & vbCrLf
Content = Content & "</tr>" & vbCrLf
Do While Not Rs.EOF
Content = Content & "<tr class=td2 align=center>" & vbCrLf
Content = Content & "<td>" & Rs(0) & "</td>" & vbCrLf
Content = Content & "<td align=left>" & Rs(1)
Call WRMPS.FsoBegin()
If WRMPS.FsoIsTrue("Dir","../Skins/"&Rs(1)) = False Then Content = Content & "<strong><font Color=red>(×)</font></strong>"
Call WRMPS.FsoEnd()
Content = Content & "</td>" & vbCrLf
Content = Content & "<td align=left>" & Rs(2) & "</td>" & vbCrLf
Content = Content & "<td>"
If WR_Setting(5) = Rs(1) Then Content = Content & "<font class=font2 title='当前使用主题'><strong>√</strong></font>"
Content = Content & "</td>" & vbCrLf
Content = Content & "<td>" & vbCrLf
Content = Content & " <a href=?Action=EditSkin&WM_ID=" & Rs(3) & " title=修改主题>修改</a> |"
Content = Content & " <a href=?Action=Del&WM_SkinFolder=" & Rs(1) & " title=删除主题 onclick=""return confirm('确定删除？');"">删除</a>"
Content = Content & "</td></tr>" & vbCrLf
Rs.MoveNext
Loop
Rs.Close
Content = Content & "<tr><td class=td2 colspan=5><b>注：</b><br>①<strong><font Color=red>(×)</font></strong> 表示该主题目录不存在</td></tr>" & vbCrLf
Content = Content & "</table>" & vbCrLf
End Select
Set sRs = Nothing
Set Rs = Nothing
Call ClassEnd()
Call DBConnEnd()
Response.Write Content
Call GetBottom()
End Sub
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -