📄 admin_special.asp
字号:
Response.Write " alert('请不要在相同专题内进行操作！');" & vbCrLf
Response.Write " document.myform.TargetSpecialID.focus();" & vbCrLf
Response.Write " return false;" & vbCrLf
Response.Write " }" & vbCrLf
Response.Write "}" & vbCrLf
Response.Write "</script>" & vbCrLf
End Sub
Sub ShowBatch()
Response.Write "<form name='form1' method='post' action='Admin_Special.asp'>"
Response.Write " <table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border'>"
Response.Write " <tr class='title'>"
Response.Write " <td height='22' colspan='3' align='center'><strong>批量设置" & ChannelShortName & "专题属性</strong></td>"
Response.Write " </tr>"
Response.Write " <tr class='tdbg'>"
Response.Write " <td width='200' valign='top'><font color='red'>提示：</font>可以按住“Shift”<br>或“Ctrl”键进行多个专题的选择<br>"
Response.Write " <select name='SpecialID' size='2' multiple style='height:200px;width:200px;'>" & GetSpecial_Option(0) & "</select><br><div align='center'>"
Response.Write " <input type='button' name='Submit' value=' 选定所有专题 ' onclick='SelectAll()'><br>"
Response.Write " <input type='button' name='Submit' value='取消选定所有专题' onclick='UnSelectAll()'></div></td>"
Response.Write " <td>"
Response.Write " <table id='SpecialSettings' width='100%' border='0' cellpadding='2' cellspacing='1' bgcolor='#FFFFFF' style='display:'>"
Response.Write " <tr class='tdbg'>"
Response.Write " <td width='30' align='center'><input type='checkbox' name='ModifyOpenType' value='Yes'></td>"
Response.Write " <td width='300' class='tdbg5'><strong>打开方式：</strong></td>"
Response.Write " <td><input name='OpenType' type='radio' value='0' checked>在原窗口打开 <input name='OpenType' type='radio' value='1'>在新窗口打开</td>"
Response.Write " </tr>" & vbCrLf
Response.Write " <tr class='tdbg'>"
Response.Write " <td width='30' align='center'><input type='checkbox' name='ModifyIsElite' value='Yes'></td>"
Response.Write " <td width='300' class='tdbg5'><strong>是否为推荐专题：</strong></td>"
Response.Write " <td><input name='IsElite' type='radio' value='True' checked>是 <input name='IsElite' type='radio' value='False'>否</td>"
Response.Write " </tr>" & vbCrLf
Response.Write " <tr class='tdbg'>"
Response.Write " <td width='30' align='center'><input type='checkbox' name='ModifyMaxPerPage' value='Yes'></td>"
Response.Write " <td width='300' class='tdbg5'><strong>每页显示的" & InfoShortName & "数：</strong></td>"
Response.Write " <td><select name='MaxPerPage'>" & GetNumber_Option(5, 100, 20) & "</select></td>"
Response.Write " </tr>" & vbCrLf
Response.Write " <tr class='tdbg'>"
Response.Write " <td width='30' align='center'><input type='checkbox' name='ModifySkinID' value='Yes'></td>"
Response.Write " <td width='300' class='tdbg5'><strong>专题配色风格：</strong><br>相关模板中包含CSS、颜色、图片等信息</td>"
Response.Write " <td><select name='SkinID' id='SkinID'>" & GetSkin_Option(0) & "</td>"
Response.Write " </tr>" & vbCrLf
Response.Write " <tr class='tdbg'> "
Response.Write " <td width='30' align='center'><input type='checkbox' name='ModifyTemplateID' value='Yes'></td>"
Response.Write " <td width='300' class='tdbg5'><strong>版面设计模板：</strong><br>相关模板中包含了专题设计的版式等信息，如果是自行添加的设计模板，可能会导致“专题配色风格”失效。 </td>"
Response.Write " <td><select name='TemplateID' id='TemplateID'>" & GetTemplate_Option(ChannelID, 4, 0) & "</select></td>"
Response.Write " </tr>" & vbCrLf
Response.Write " <tr class='tdbg'>"
Response.Write " <td height='40' colspan='3' align='center'><input name='Action' type='hidden' id='Action' value='DoBatch'><input name='ChannelID' type='hidden' id='ChannelID' value='" & ChannelID & "'>"
Response.Write " <input name='Submit' type='submit' value=' 执行批处理 ' style='cursor:hand;'> <input name='Cancel' type='button' id='Cancel' value=' 取 消 ' onClick=""window.location.href='Admin_Special.asp?ChannelID=" & ChannelID & "'"" style='cursor:hand;'></td></tr>"
Response.Write " </table>"
Response.Write "</td></tr></table>"
Response.Write "</form>" & vbCrLf
Response.Write "<script language='javascript'>" & vbCrLf
Response.Write "function SelectAll(){" & vbCrLf
Response.Write " for(var i=0;i<document.form1.SpecialID.length;i++){" & vbCrLf
Response.Write " document.form1.SpecialID.options[i].selected=true;}" & vbCrLf
Response.Write "}" & vbCrLf
Response.Write "function UnSelectAll(){" & vbCrLf
Response.Write " for(var i=0;i<document.form1.SpecialID.length;i++){" & vbCrLf
Response.Write " document.form1.SpecialID.options[i].selected=false;}" & vbCrLf
Response.Write "}" & vbCrLf
Response.Write "</script>" & vbCrLf
End Sub
Sub SaveAdd()
Dim SpecialName, SpecialDir, SpecialID, OrderID
Dim rsSpecial, sql
SpecialName = ReplaceBadChar(Trim(Request("SpecialName")))
SpecialDir = Trim(Request("SpecialDir"))
If SpecialName = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>专题名称不能为空！</li>"
End If
If SpecialDir = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>专题目录不能为空！</li>"
Else
If IsValidStr(SpecialDir) = False Then
FoundErr = True
ErrMsg = ErrMsg & "<li>专题目录名只能是英文！</li>"
End If
End If
If FoundErr = True Then
Exit Sub
End If
SpecialID = GetNewID("PE_Special", "SpecialID")
OrderID = GetMinID("PE_Special", "OrderID")
Conn.Execute ("update PE_Special set OrderID=OrderID+1 where ChannelID=" & ChannelID & "")
Set rsSpecial = Server.CreateObject("Adodb.RecordSet")
rsSpecial.Open "Select * from PE_Special Where ChannelID=" & ChannelID & " and (SpecialName='" & SpecialName & "' or SpecialDir='" & SpecialDir & "')", Conn, 1, 3
If Not (rsSpecial.BOF And rsSpecial.EOF) Then
FoundErr = True
ErrMsg = ErrMsg & "<li>专题名称或专题目录已经存在！</li>"
rsSpecial.Close
Set rsSpecial = Nothing
Exit Sub
End If
rsSpecial.addnew
rsSpecial("SpecialID") = SpecialID
rsSpecial("ChannelID") = ChannelID
rsSpecial("OrderID") = OrderID
rsSpecial("SpecialName") = SpecialName
rsSpecial("SpecialDir") = SpecialDir
rsSpecial("SpecialPicUrl") = Trim(Request("SpecialPicUrl"))
rsSpecial("IsElite") = PE_CBool(Trim(Request("IsElite")))
rsSpecial("OpenType") = PE_CLng(Trim(Request("OpenType")))
rsSpecial("Tips") = Trim(Request("Tips"))
rsSpecial("ReadMe") = Trim(Request("ReadMe"))
rsSpecial("MaxPerPage") = PE_CLng(Trim(Request("MaxPerPage")))
rsSpecial("SkinID") = PE_CLng(Trim(Request("SkinID")))
rsSpecial("TemplateID") = PE_CLng(Trim(Request("TemplateID")))
'自设内容
Dim Custom_Num, Custom_Content, i
Custom_Num = PE_CLng(Request.Form("Custom_Num"))
If Custom_Num <> 0 Then
For i = 1 To Custom_Num
If i <> 1 Then
Custom_Content = Custom_Content & "{#$$$#}"
End If
Custom_Content = Custom_Content & Trim(Request("Custom_Content" & i))
Next
End If
rsSpecial("Custom_Content") = Custom_Content
rsSpecial.Update
rsSpecial.Close
Set rsSpecial = Nothing
Conn.Execute ("update PE_Channel set SpecialCount=SpecialCount+1 where ChannelID=" & ChannelID & "")
Call CreateJS_Special
If UseCreateHTML > 0 Then
Call CreateSpecialDir(SpecialDir)
End If
Call ClearSiteCache(ChannelID)
Call CloseConn
Response.Redirect "Admin_Special.asp?ChannelID=" & ChannelID
End Sub
Sub CreateSpecialDir(DirName)
If ObjInstalled_FSO = False Then
Exit Sub
End If
Dim tmpDir
tmpDir = InstallDir & ChannelDir & "/Special"
If Not fso.FolderExists(Server.MapPath(tmpDir)) Then
fso.CreateFolder Server.MapPath(tmpDir)
End If
tmpDir = tmpDir & "/" & DirName
If Not fso.FolderExists(Server.MapPath(tmpDir)) Then
fso.CreateFolder Server.MapPath(tmpDir)
End If
End Sub
Sub CreateSpecialDir1()
Dim SpecialID, rsSpecial, sql
SpecialID = PE_CLng(Trim(Request("SpecialID")))
If SpecialID = 0 Then
FoundErr = True
ErrMsg = ErrMsg & "<li>请指定要修改的专题ID！</li>"
Exit Sub
End If
sql = "Select SpecialDir from PE_Special Where SpecialID=" & SpecialID
Set rsSpecial = Server.CreateObject("Adodb.RecordSet")
rsSpecial.Open sql, Conn, 1, 3
If rsSpecial.BOF And rsSpecial.EOF Then
FoundErr = True
ErrMsg = ErrMsg & "<li>找不到指定的专题，可能已经被删除！</li>"
rsSpecial.Close
Set rsSpecial = Nothing
Else
Call CreateSpecialDir(rsSpecial(0))
End If
rsSpecial.Close
Set rsSpecial = Nothing
If FoundErr = False Then Call WriteSuccessMsg("创建专题目录成功！", ComeUrl)
End Sub
Sub SaveModify()
Dim SpecialID, SpecialName
Dim rsSpecial, sql
SpecialID = PE_CLng(Trim(Request("SpecialID")))
If SpecialID = 0 Then
FoundErr = True
ErrMsg = ErrMsg & "<li>请指定要修改的专题ID！</li>"
Exit Sub
End If
SpecialName = ReplaceBadChar(Trim(Request.Form("SpecialName")))
If SpecialName = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>专题名称不能为空！</li>"
End If
If FoundErr = True Then
Exit Sub
End If
sql = "Select * from PE_Special Where SpecialID=" & SpecialID
Set rsSpecial = Server.CreateObject("Adodb.RecordSet")
rsSpecial.Open sql, Conn, 1, 3
If rsSpecial.BOF And rsSpecial.EOF Then
FoundErr = True
ErrMsg = ErrMsg & "<li>找不到指定的专题，可能已经被删除！</li>"
rsSpecial.Close
Set rsSpecial = Nothing
Else
rsSpecial("SpecialName") = SpecialName
rsSpecial("SpecialPicUrl") = Trim(Request("SpecialPicUrl"))
rsSpecial("IsElite") = PE_CBool(Trim(Request("IsElite")))
rsSpecial("OpenType") = PE_CLng(Trim(Request("OpenType")))
rsSpecial("Tips") = Trim(Request("Tips"))
rsSpecial("ReadMe") = Trim(Request("ReadMe"))
rsSpecial("MaxPerPage") = PE_CLng(Trim(Request("MaxPerPage")))
rsSpecial("SkinID") = PE_CLng(Trim(Request("SkinID")))
rsSpecial("TemplateID") = PE_CLng(Trim(Request("TemplateID")))
'自设内容
Dim Custom_Num, Custom_Content, i
Custom_Num = PE_CLng(Request.Form("Custom_Num"))
If Custom_Num <> 0 Then
For i = 1 To Custom_Num
If i <> 1 Then
Custom_Content = Custom_Content & "{#$$$#}"
End If
Custom_Content = Custom_Content & Trim(Request("Custom_Content" & i))
Next
End If
rsSpecial("Custom_Content") = Custom_Content
rsSpecial.Update
rsSpecial.Close
Set rsSpecial = Nothing
Call CreateJS_Special
Call ClearSiteCache(ChannelID)
Call CloseConn
Response.Redirect "Admin_Special.asp?ChannelID=" & ChannelID
End If
End Sub
Sub DelSpecial()
Dim SpecialID
SpecialID = Trim(Request("SpecialID"))
If SpecialID = "" Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -