📄 admin_rootclass_menu.asp
字号:
Response.Write " >12pt</option>"
Response.Write " <option value=""14pt"" "
If FontSize_RCM_Item_39 = "14pt" Then Response.Write " selected"
Response.Write " >14pt</option>"
Response.Write " <option value=""16pt"" "
If FontSize_RCM_Item_39 = "16pt" Then Response.Write " selected"
Response.Write " >16pt</option>"
Response.Write " <option value=""18pt"" "
If FontSize_RCM_Item_39 = "18pt" Then Response.Write " selected"
Response.Write " >18pt</option>"
Response.Write " <option value=""24pt"" "
If FontSize_RCM_Item_39 = "24pt" Then Response.Write " selected"
Response.Write " >24pt</option>"
Response.Write " <option value=""36pt"" "
If FontSize_RCM_Item_39 = "36pt" Then Response.Write " selected"
Response.Write " >36pt</option>"
Response.Write " </select>"
Response.Write " </td>"
Response.Write " </tr>"
Response.Write " <tr class='tdbg'>"
Response.Write " <td height='40' colspan='6' align='center'>"
Response.Write " <input name='Action' type='hidden' id='Action' value='SaveConfig'>"
Response.Write " <input name='ChannelID' type='hidden' id='ChannelID' value='" & ChannelID & "'>"
Response.Write " <input name='cmdSave' type='submit' id='cmdSave' value=' 保存设置 ' "
If ObjInstalled_FSO = False Then Response.Write " disabled"
Response.Write " >"
Response.Write " </td>"
Response.Write " </tr>"
Response.Write "</table>"
Response.Write "</form>"
End Sub
Sub SaveConfig()
If ObjInstalled_FSO = False Then
FoundErr = True
ErrMsg = ErrMsg & "<br><li>你的服务器不支持 FSO(Scripting.FileSystemObject)! </li>"
Exit Sub
End If
Set hf = fso.CreateTextFile(Server.MapPath(InstallDir & AdminDir & "/RootClass_Menu_Config.asp"), True)
hf.Write "<" & "%" & vbCrLf
hf.Write "'菜单显示参数设置" & vbCrLf
hf.Write "Const RCM_Menu_1=" & Chr(34) & PE_CLng(Trim(request("RCM_Menu_1"))) & Chr(34) & " '菜单弹出方式 1：左 2：右 3：上 4：下" & vbCrLf
hf.Write "Const RCM_Menu_2=" & Chr(34) & PE_CLng(Trim(request("RCM_Menu_2"))) & Chr(34) & " '菜单弹出横向偏移量" & vbCrLf
hf.Write "Const RCM_Menu_3=" & Chr(34) & PE_CLng(Trim(request("RCM_Menu_3"))) & Chr(34) & " '菜单弹出纵向偏移量" & vbCrLf
hf.Write "Const RCM_Menu_4=" & Chr(34) & PE_CLng(Trim(request("RCM_Menu_4"))) & Chr(34) & " '菜单项边距" & vbCrLf
hf.Write "Const RCM_Menu_5=" & Chr(34) & PE_CLng(Trim(request("RCM_Menu_5"))) & Chr(34) & " '菜单项间距" & vbCrLf
hf.Write "Const RCM_Menu_6=" & Chr(34) & PE_CLng(Trim(request("RCM_Menu_6"))) & Chr(34) & " '菜单项左边距" & vbCrLf
hf.Write "Const RCM_Menu_7=" & Chr(34) & PE_CLng(Trim(request("RCM_Menu_7"))) & Chr(34) & " '菜单项右边距" & vbCrLf
hf.Write "Const RCM_Menu_8=" & Chr(34) & PE_CLng(Trim(request("RCM_Menu_8"))) & Chr(34) & " '菜单透明度 0-100 完全透明-完全不透明" & vbCrLf
hf.Write "Const RCM_Menu_9=" & Chr(34) & FilterString(Trim(request("RCM_Menu_9"))) & Chr(34) & " '其它特效" & vbCrLf
hf.Write "Const RCM_Menu_10=" & Chr(34) & PE_CLng(Trim(request("RCM_Menu_10"))) & Chr(34) & " '鼠标指在菜单项时，菜单弹出效果" & vbCrLf
hf.Write "Const RCM_Menu_11=" & Chr(34) & FilterString(Trim(request("RCM_Menu_11"))) & Chr(34) & " '其它特效" & vbCrLf
hf.Write "Const RCM_Menu_12=" & Chr(34) & PE_CLng(Trim(request("RCM_Menu_12"))) & Chr(34) & " '鼠标移出菜单项时，菜单弹出效果" & vbCrLf
hf.Write "Const RCM_Menu_13=" & Chr(34) & PE_CLng(Trim(request("RCM_Menu_13"))) & Chr(34) & " '菜单弹出效果速度 10-100" & vbCrLf
hf.Write "Const RCM_Menu_14=" & Chr(34) & PE_CLng(Trim(request("RCM_Menu_14"))) & Chr(34) & " '弹出菜单阴影效果 0：none 1：simple 2：complex" & vbCrLf
hf.Write "Const RCM_Menu_15=" & Chr(34) & PE_CLng(Trim(request("RCM_Menu_15"))) & Chr(34) & " '弹出菜单阴影深度" & vbCrLf
hf.Write "Const RCM_Menu_16=" & Chr(34) & FilterString(Trim(request("RCM_Menu_16"))) & Chr(34) & " '弹出菜单阴影颜色" & vbCrLf
hf.Write "Const RCM_Menu_17=" & Chr(34) & FilterString(Trim(request("RCM_Menu_17"))) & Chr(34) & " '弹出菜单背景颜色" & vbCrLf
hf.Write "Const RCM_Menu_18=" & Chr(34) & FilterString(Trim(request("RCM_Menu_18"))) & Chr(34) & " '弹出菜单背景图片，只有当菜单项背景颜色设为透明色：transparent 时才有效" & vbCrLf
hf.Write "Const RCM_Menu_19=" & Chr(34) & PE_CLng(Trim(request("RCM_Menu_19"))) & Chr(34) & " '弹出菜单背景图片平铺模式。 0：不平铺 1：横向平铺 2：纵向平铺 3：完全平铺" & vbCrLf
hf.Write "Const RCM_Menu_20=" & Chr(34) & PE_CLng(Trim(request("RCM_Menu_20"))) & Chr(34) & " '弹出菜单边框类型 0：无边框 1：单实线 2：双实线 5：凹陷 6：凸起" & vbCrLf
hf.Write "Const RCM_Menu_21=" & Chr(34) & PE_CLng(Trim(request("RCM_Menu_21"))) & Chr(34) & " '弹出菜单边框宽度" & vbCrLf
hf.Write "Const RCM_Menu_22=" & Chr(34) & FilterString(Trim(request("RCM_Menu_22"))) & Chr(34) & " '弹出菜单边框颜色" & vbCrLf
hf.Write "Const RCM_Menu_23=" & Chr(34) & "#ffffff" & Chr(34) & "" & vbCrLf
hf.Write "" & vbCrLf
hf.Write "'菜单项参数设置" & vbCrLf
hf.Write "Const RCM_Item_1=" & Chr(34) & "0" & Chr(34) & " '菜单项类型 0--Txt 1--Html 2--Image" & vbCrLf
hf.Write "Const RCM_Item_2=" & Chr(34) & "" & Chr(34) & " '菜单项名称" & vbCrLf
hf.Write "Const RCM_Item_3=" & Chr(34) & "" & Chr(34) & " '菜单项为Image，图片文件" & vbCrLf
hf.Write "Const RCM_Item_4=" & Chr(34) & "" & Chr(34) & " '菜单项为Image，鼠标指在菜单项时，图片文件。" & vbCrLf
hf.Write "Const RCM_Item_5=" & Chr(34) & "-1" & Chr(34) & " '菜单项为Image，图片宽度" & vbCrLf
hf.Write "Const RCM_Item_6=" & Chr(34) & "-1" & Chr(34) & " '菜单项为Image，图片高度" & vbCrLf
hf.Write "Const RCM_Item_7=" & Chr(34) & "0" & Chr(34) & " '菜单项为Image，图片边框" & vbCrLf
hf.Write "Const RCM_Item_8=" & Chr(34) & "" & Chr(34) & " '菜单项链接地址" & vbCrLf
hf.Write "Const RCM_Item_9=" & Chr(34) & "" & Chr(34) & " '菜单项链接目标 如：_self _blank" & vbCrLf
hf.Write "Const RCM_Item_10=" & Chr(34) & "" & Chr(34) & " '菜单项链接状态栏显示" & vbCrLf
hf.Write "Const RCM_Item_11=" & Chr(34) & "" & Chr(34) & " '菜单项链接地址提示信息" & vbCrLf
hf.Write "Const RCM_Item_12=" & Chr(34) & FilterString(Trim(request("RCM_Item_12"))) & Chr(34) & " '菜单项左图片" & vbCrLf
hf.Write "Const RCM_Item_13=" & Chr(34) & FilterString(Trim(request("RCM_Item_13"))) & Chr(34) & " '鼠标指在菜单项时，菜单项左图片" & vbCrLf
hf.Write "Const RCM_Item_14=" & Chr(34) & PE_CLng(Trim(request("RCM_Item_14"))) & Chr(34) & " '菜单项左图片宽度，0为图像文件原始值" & vbCrLf
hf.Write "Const RCM_Item_15=" & Chr(34) & PE_CLng(Trim(request("RCM_Item_15"))) & Chr(34) & " '菜单项左图片高度，0为图像文件原始值" & vbCrLf
hf.Write "Const RCM_Item_16=" & Chr(34) & PE_CLng(Trim(request("RCM_Item_16"))) & Chr(34) & " '菜单项左图片边框大小" & vbCrLf
hf.Write "Const RCM_Item_17=" & Chr(34) & FilterString(Trim(request("RCM_Item_17"))) & Chr(34) & " '菜单项右图片。如：arrow_r.gif" & vbCrLf
hf.Write "Const RCM_Item_18=" & Chr(34) & FilterString(Trim(request("RCM_Item_18"))) & Chr(34) & " '鼠标指在菜单项时，菜单项右图片。如：arrow_w.gif" & vbCrLf
hf.Write "Const RCM_Item_19=" & Chr(34) & PE_CLng(Trim(request("RCM_Item_19"))) & Chr(34) & " '菜单项右图片宽度，0为图像文件原始值" & vbCrLf
hf.Write "Const RCM_Item_20=" & Chr(34) & PE_CLng(Trim(request("RCM_Item_20"))) & Chr(34) & " '菜单项右图片高度，0为图像文件原始值" & vbCrLf
hf.Write "Const RCM_Item_21=" & Chr(34) & PE_CLng(Trim(request("RCM_Item_21"))) & Chr(34) & " '菜单项右图片边框大小" & vbCrLf
hf.Write "Const RCM_Item_22=" & Chr(34) & PE_CLng(Trim(request("RCM_Item_22"))) & Chr(34) & " '菜单项文字水平对齐方式 0：左对齐 1：居中 2：右对齐" & vbCrLf
hf.Write "Const RCM_Item_23=" & Chr(34) & PE_CLng(Trim(request("RCM_Item_23"))) & Chr(34) & " '菜单项文字垂直对齐方式 0：顶部 1：居中 2：底部" & vbCrLf
hf.Write "Const RCM_Item_24=" & Chr(34) & FilterString(Trim(request("RCM_Item_24"))) & Chr(34) & " '菜单项背景颜色 透明色：'transparent'" & vbCrLf
hf.Write "Const RCM_Item_25=" & Chr(34) & PE_CLng(Trim(request("RCM_Item_25"))) & Chr(34) & " '菜单项背景颜色是否显示 0：显示 其它：不显示" & vbCrLf
hf.Write "Const RCM_Item_26=" & Chr(34) & FilterString(Trim(request("RCM_Item_26"))) & Chr(34) & " '鼠标指在菜单项时，菜单项背景颜色" & vbCrLf
hf.Write "Const RCM_Item_27=" & Chr(34) & PE_CLng(Trim(request("RCM_Item_27"))) & Chr(34) & " '鼠标指在菜单项时，菜单项背景颜色是否显示。 0：显示 其它：不显示" & vbCrLf
hf.Write "Const RCM_Item_28=" & Chr(34) & FilterString(Trim(request("RCM_Item_28"))) & Chr(34) & " '菜单项背景图片" & vbCrLf
hf.Write "Const RCM_Item_29=" & Chr(34) & FilterString(Trim(request("RCM_Item_29"))) & Chr(34) & " '鼠标指在菜单项时，菜单项背景图片" & vbCrLf
hf.Write "Const RCM_Item_30=" & Chr(34) & PE_CLng(Trim(request("RCM_Item_30"))) & Chr(34) & " '菜单项背景图片平铺模式。 0：不平铺 1：横向平铺 2：纵向平铺 3：完全平铺" & vbCrLf
hf.Write "Const RCM_Item_31=" & Chr(34) & "3" & Chr(34) & " '鼠标指在菜单项时，菜单项背景图片平铺模式。0-3" & vbCrLf
hf.Write "Const RCM_Item_32=" & Chr(34) & PE_CLng(Trim(request("RCM_Item_32"))) & Chr(34) & " '菜单项边框类型 0：无边框 1：单实线 2：双实线 5：凹陷 6：凸起" & vbCrLf
hf.Write "Const RCM_Item_33=" & Chr(34) & PE_CLng(Trim(request("RCM_Item_33"))) & Chr(34) & " '菜单项边框宽度" & vbCrLf
hf.Write "Const RCM_Item_34=" & Chr(34) & FilterString(Trim(request("RCM_Item_34"))) & Chr(34) & " '菜单项边框颜色" & vbCrLf
hf.Write "Const RCM_Item_35=" & Chr(34) & FilterString(Trim(request("RCM_Item_35"))) & Chr(34) & " '鼠标指在菜单项时，菜单项边框颜色" & vbCrLf
hf.Write "Const RCM_Item_36=" & Chr(34) & FilterString(Trim(request("RCM_Item_36"))) & Chr(34) & " '菜单项文字颜色" & vbCrLf
hf.Write "Const RCM_Item_37=" & Chr(34) & FilterString(Trim(request("RCM_Item_37"))) & Chr(34) & " '鼠标指在菜单项时，菜单项文字颜色" & vbCrLf
hf.Write "Const FontSize_RCM_Item_38=" & Chr(34) & FilterString(Trim(request("FontSize_RCM_Item_38"))) & Chr(34) & " '菜单项文字大小" & vbCrLf
hf.Write "Const FontName_RCM_Item_38=" & Chr(34) & FilterString(Trim(request("FontName_RCM_Item_38"))) & Chr(34) & " '菜单项文字字体" & vbCrLf
hf.Write "Const FontSize_RCM_Item_39=" & Chr(34) & FilterString(Trim(request("FontSize_RCM_Item_39"))) & Chr(34) & " '鼠标指在菜单项时,菜单项文字大小" & vbCrLf
hf.Write "Const FontName_RCM_Item_39=" & Chr(34) & FilterString(Trim(request("FontName_RCM_Item_39"))) & Chr(34) & " '鼠标指在菜单项时,菜单项文字字体" & vbCrLf
hf.Write "%" & ">"
hf.Close
Call WriteSuccessMsg("顶部栏目菜单参数设置成功！", ComeUrl)
End Sub
Sub ShowCreate_RootClass_Menu()
Response.Write "<br><table width='100%' border='0' cellspacing='1' cellpadding='2' class='border'>"
Response.Write " <tr class='title'>"
Response.Write " <td height='22' align='center'><strong> 生 成 顶 部 栏 目 菜 单 </strong></td>"
Response.Write " </tr>"
Response.Write " <tr class='tdbg'>"
Response.Write " <td height='150'>"
Response.Write "<form name='myform' method='post' action='Admin_RootClass_Menu.asp'>"
Response.Write "<p align='center'>此操作将根据顶部栏目菜单参数设置中设置的参数生成自定义的菜单。</p>"
Response.Write "<p align='center'><input name='Action' type='hidden' id='Action' value='Create'>"
Response.Write "<input name='ChannelID' type='hidden' id='ChannelID' value='" & ChannelID & "'>"
Response.Write "<input type='submit' name='Submit' value=' 生成顶部栏目菜单 '></p>"
Response.Write "</form>"
Response.Write " </td>"
Response.Write " </tr>"
Response.Write "</table>"
End Sub
Sub Create_RootClass_Menu()
strTopMenu = GetRootClass_Menu()
If Not fso.FolderExists(Server.MapPath(InstallDir & ChannelDir & "/js")) Then
fso.CreateFolder Server.MapPath(InstallDir & ChannelDir & "/js")
End If
Set hf = fso.CreateTextFile(Server.MapPath(InstallDir & ChannelDir & "/js/ShowClass_Menu.js"), True)
hf.Write strTopMenu
hf.Close
Call WriteSuccessMsg("顶部栏目菜单生成成功！", ComeUrl)
End Sub
'=================================================
'函数名：GetRootClass_Menu
'作 用：得到栏目无级下拉菜单效果的HTML代码
'参 数：无
'返回值：栏目无级下拉菜单效果的HTML代码
'=================================================
Function GetRootClass_Menu()
Dim Class_MenuTitle, strJS
pNum = 1
pNum2 = 0
strJS = stm_bm() & vbCrLf
strJS = strJS & stm_bp_h() & vbCrLf
strJS = strJS & stm_ai() & vbCrLf
If UseCreateHTML > 0 Then
strJS = strJS & stm_aix("p0i1", "p0i0", ChannelName & "首页", ChannelUrl & "/Index" & FileExt_List, "_self", "", False) & vbCrLf
Else
strJS = strJS & stm_aix("p0i1", "p0i0", ChannelName & "首页", ChannelUrl & "/Index.asp", "_self", "", False) & vbCrLf
End If
strJS = strJS & stm_aix("p0i2", "p0i0", "|", "", "_self", "", False) & vbCrLf
Dim sqlRoot, rsRoot, j
sqlRoot = "select * from PE_Class where ChannelID=" & ChannelID & " and Depth=0 and ShowOnTop=" & PE_True & " order by RootID"
Set rsRoot = Server.CreateObject("ADODB.Recordset")
rsRoot.open sqlRoot, Conn, 1, 1
If Not (rsRoot.bof And rsRoot.EOF) Then
j = 3
Do While Not rsRoot.EOF
If rsRoot("OpenType") = 0 Then
OpenType_Class = "_self"
Else
OpenType_Class = "_blank"
End If
If Trim(rsRoot("Tips")) <> "" Then
Class_MenuTitle = Replace(Replace(Replace(Replace(rsRoot("Tips"), "'", ""), """", ""), Chr(10), ""), Chr(13), "")
Else
Class_MenuTitle = ""
End If
If rsRoot("ClassType") = 1 Then
If UseCreateHTML > 0 And rsRoot("ClassPurview") < 2 Then
Select Case ListFileType
Case 0
strJS = strJS & stm_aix("p0i" & j & "", "p0i0", rsRoot("ClassName"), ChannelUrl & rsRoot("ParentDir") & rsRoot("ClassDir") & "/Index" & FileExt_List, OpenType_Class, Class_MenuTitle, False) & vbCrLf
Case 1
strJS = strJS & stm_aix("p0i" & j & "", "p0i0", rsRoot("ClassName"), ChannelUrl & "/List/List_" & rsRoot("ClassID") & FileExt_List, OpenType_Class, Class_MenuTitle, False) & vbCrLf
Case 2
strJS = strJS & stm_aix("p0i" & j & "", "p0i0", rsRoot("ClassName"), ChannelUrl & "/List_" & rsRoot("ClassID") & FileExt_List, OpenType_Class, Class_MenuTitle, False) & vbCrLf
Case Else
strJS = strJS & stm_aix("p0i" & j & "", "p0i0", rsRoot("ClassName"), ChannelUrl & "/ShowClass.asp?ClassID=" & rsRoot("ClassID"), OpenType_Class, Class_MenuTitle, False) & vbCrLf
End Select
Else
strJS = strJS & stm_aix("p0i" & j & "", "p0i0", rsRoot("ClassName"), ChannelUrl & "/ShowClass.asp?ClassID=" & rsRoot("ClassID"), OpenType_Class, Class_MenuTitle, False) & vbCrLf
End If
If rsRoot("Child") > 0 Then
strJS = strJS & GetClassMenu(rsRoot("ClassID"), 0)
End If
Else
strJS = strJS & stm_aix("p0i" & j & "", "p0i0", rsRoot("ClassName"), rsRoot("LinkUrl"), OpenType_Class, Class_MenuTitle, False) & vbCrLf
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -