<%@language=vbscript codepage=936 %>
<%
response.buffer=true
Const PurviewLevel=1
Const PurviewLevel_Channel=0
Const PurviewLevel_Others=""
ChannelID=0
%>
<!--#include file="../conn.asp"-->
<!--#include file="../conn_user.asp"-->
<!--#include file="../inc/function.asp"-->
<!--#include file="../inc/syscode_common.asp"-->
<%
dim hf, strTopMenu, pNum, pNum2, OpenType_Class, strMenuJS
dim ObjInstalled
ObjInstalled=IsObjInstalled(objName_FSO)
If Action = "Create" Then
Call Create_RootClass_Menu()
Else
Call ShowCreate_RootClass_Menu()
End If
Response.Write "</body></html>" & vbCrLf
Sub ShowCreate_RootClass_Menu()
%>
<br><table width='100%' border='0' cellspacing='1' cellpadding='2' class='border'>
<tr class='title'>
<td height='22' align='center'><strong> 生 成 顶 部 栏 目 菜 单 </strong></td>
</tr>
<tr class='tdbg'>
<td height='150'>
<form name='myform' method='post' action='Admin_RootClass_Menu.asp'>
<p align='center'>此操作将根据顶部栏目菜单参数设置中设置的参数生成自定义的菜单。</p>
<p align='center'><input name='Action' type='hidden' id='Action' value='Create'>
<input name='ChannelID' type='hidden' id='ChannelID' value='" & ChannelID & "'>
<input type='submit' name='Submit' value=' 生成顶部栏目菜单 '></p>
</form>
</td>
</tr>
</table>
<%
end Sub
Sub Create_RootClass_Menu()
strTopMenu = GetRootClass_Menu()
If Not fso.FolderExists(Server.MapPath("../js")) Then
fso.CreateFolder Server.MapPath("../js")
End If
Set hf = fso.CreateTextFile(Server.MapPath("../js/ShowClass_Menu.js"), True)
hf.Write strTopMenu
hf.Close
call WriteSuccessMsg("顶部栏目菜单生成成功!")
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 = True Then
strJS = strJS & stm_aix("p0i1","p0i0",ChannelName & "首页",strInstallDir & ChannelDir & "/Index.html","_self","",False) & vbCrLf
Else
strJS = strJS & stm_aix("p0i1","p0i0",ChannelName & "首页",strInstallDir & ChannelDir & "/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("ReadMe")) <> "" Then
Class_MenuTitle = Replace(Replace(Replace(Replace(rsRoot("Readme"), "'", ""), """", ""), Chr(10), ""), Chr(13), "")
Else
Class_MenuTitle = ""
End If
If rsRoot("ClassType") = 1 Then
If UseCreateHTML = True Then
strJS = strJS & stm_aix("p0i" & j & "","p0i0",rsRoot("ClassName"),strInstallDir & ChannelDir & rsRoot("ParentDir") & rsRoot("ClassDir") & "/Index.html",OpenType_Class,Class_MenuTitle,False) & vbCrLf
Else
strJS = strJS & stm_aix("p0i" & j & "","p0i0",rsRoot("ClassName"),strInstallDir & ChannelDir & "/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
End If
strJS = strJS & stm_aix("p0i2","p0i0","|","","_self","",False) & vbCrLf
j = j + 1
rsRoot.movenext
If (j - 2) Mod MaxPerLine = 0 And Not rsRoot.EOF Then
strJS = strJS & "stm_em();" & vbCrLf
strJS = strJS & stm_bm() & vbCrLf
strJS = strJS & stm_bp_h() & vbCrLf
strJS = strJS & stm_ai() & vbCrLf
End If
Loop
End If
rsRoot.Close
Set rsRoot = Nothing
strJS = strJS & "stm_em();" & vbCrLf
GetRootClass_Menu = strJS
End Function
Function GetClassMenu(ID, ShowType)
Dim sqlClass, rsClass, Sub_MenuTitle, k, strJS
strJS = ""
If pNum = 1 Then
strJS = strJS & stm_bp_v("p" & pNum & "") & vbCrLf
Else
strJS = strJS & stm_bpx("p" & pNum & "","p" & pNum2 & "",ShowType) & vbCrLf
End If
k = 0
sqlClass = "select * from PE_Class where ChannelID=" & ChannelID & " and ParentID=" & ID & " order by OrderID asc"
Set rsClass = Server.CreateObject("ADODB.Recordset")
rsClass.open sqlClass, Conn, 1, 1
Do While Not rsClass.EOF
If rsClass("OpenType") = 0 Then
OpenType_Class = "_self"
Else
OpenType_Class = "_blank"
End If
If Trim(rsClass("Readme")) <> "" Then
Sub_MenuTitle = Replace(Replace(Replace(Replace(rsClass("Readme"), "'", ""), """", ""), Chr(10), ""), Chr(13), "")
Else
Sub_MenuTitle = ""
End If
If rsClass("ClassType") = 1 Then
If rsClass("Child") > 0 Then
If UseCreateHTML = True Then
strJS = strJS & stm_aix("p" & pNum & "i" & k & "","p" & pNum2 & "i0",rsClass("ClassName"),strInstallDir & ChannelDir & rsClass("ParentDir") & rsClass("ClassDir") & "/Index.html",OpenType_Class,Sub_MenuTitle,True) & vbCrLf
Else
strJS = strJS & stm_aix("p" & pNum & "i" & k & "","p" & pNum2 & "i0",rsClass("ClassName"),strInstallDir & ChannelDir & "/ShowClass.asp?ClassID=" & rsClass("ClassID"),OpenType_Class,Sub_MenuTitle,True) & vbCrLf
End If
pNum = pNum + 1
pNum2 = pNum2 + 1
strJS = strJS & GetClassMenu(rsClass("ClassID"), 1)
Else
If UseCreateHTML = True Then
strJS = strJS & stm_aix("p" & pNum & "i" & k & "","p" & pNum2 & "i0",rsClass("ClassName"),strInstallDir & ChannelDir & rsClass("ParentDir") & rsClass("ClassDir") & "/Index.html",OpenType_Class,Sub_MenuTitle,False) & vbCrLf
Else
strJS = strJS & stm_aix("p" & pNum & "i" & k & "","p" & pNum2 & "i0",rsClass("ClassName"),strInstallDir & ChannelDir & "/ShowClass.asp?ClassID=" & rsClass("ClassID"),OpenType_Class,Sub_MenuTitle,False) & vbCrLf
End If
End If
Else
strJS = strJS & stm_aix("p" & pNum & "i" & k & "","p" & pNum2 & "i0",rsClass("ClassName"),rsClass("LinkUrl"),OpenType_Class,Sub_MenuTitle,False) & vbCrLf
End If
k = k + 1
rsClass.movenext
Loop
rsClass.Close
Set rsClass = Nothing
strJS = strJS & "stm_ep();" & vbCrLf
GetClassMenu = strJS
End Function
Function stm_bm()
stm_bm = "stm_bm(['uueoehr',400,'','" & strInstallDir & "images/blank.gif',0,'','',0,0,0,0,0,1,0,0]);"
End Function
Function stm_bp_h()
stm_bp_h = "stm_bp('p0',[0,4,0,0,2,2,0,0," & RCM_Menu_8 & ",'" & RCM_Menu_9 & "'," & RCM_Menu_10 & ",'" & RCM_Menu_11 & "'," & RCM_Menu_12 & "," & RCM_Menu_13 & ",0,0,'#000000','transparent','',3,0,0,'#000000']);"
End Function
Function stm_bp_v(bpID)
stm_bp_v = "stm_bp('" & bpID & "',[1," & RCM_Menu_1 & "," & RCM_Menu_2 & "," & RCM_Menu_3 & "," & RCM_Menu_4 & "," & RCM_Menu_5 & "," & RCM_Menu_6 & "," & RCM_Menu_7 & "," & RCM_Menu_8 & ",'" & RCM_Menu_9 & "'," & RCM_Menu_10 & ",'" & RCM_Menu_11 & "'," & RCM_Menu_12 & "," & RCM_Menu_13 & "," & RCM_Menu_14 & "," & RCM_Menu_15 & ",'" & RCM_Menu_16 & "','" & RCM_Menu_17 & "','" & RCM_Menu_18 & "'," & RCM_Menu_19 & "," & RCM_Menu_20 & "," & RCM_Menu_21 & ",'" & RCM_Menu_22 & "']);"
End Function
Function stm_bpx(bpOID,bpTID,bpType)
If bpType = 0 Then
stm_bpx = "stm_bpx('" & bpOID & "','" & bpTID & "',[1," & RCM_Menu_1 & "," & RCM_Menu_2 & "," & RCM_Menu_3 & "," & RCM_Menu_4 & "," & RCM_Menu_5 & "," & RCM_Menu_6 & "," & RCM_Menu_7 & "," & RCM_Menu_8 & ",'" & RCM_Menu_9 & "'," & RCM_Menu_10 & ",'" & RCM_Menu_11 & "'," & RCM_Menu_12 & "," & RCM_Menu_13 & "," & RCM_Menu_14 & "," & RCM_Menu_15 & ",'" & RCM_Menu_16 & "','" & RCM_Menu_17 & "','" & RCM_Menu_18 & "'," & RCM_Menu_19 & "," & RCM_Menu_20 & "," & RCM_Menu_21 & ",'" & RCM_Menu_22 & "']);"
Else
stm_bpx = "stm_bpx('" & bpOID & "','" & bpTID & "',[1,2,-2,-3," & RCM_Menu_4 & "," & RCM_Menu_5 & ",0," & RCM_Menu_7 & "," & RCM_Menu_8 & ",'" & RCM_Menu_9 & "'," & RCM_Menu_10 & ",'" & RCM_Menu_11 & "'," & RCM_Menu_12 & "," & RCM_Menu_13 & "," & RCM_Menu_14 & "," & RCM_Menu_15 & ",'" & RCM_Menu_16 & "','" & RCM_Menu_17 & "','" & RCM_Menu_18 & "'," & RCM_Menu_19 & "," & RCM_Menu_20 & "," & RCM_Menu_21 & ",'" & RCM_Menu_22 & "']);"
End If
End Function
Function stm_ai()
stm_ai = "stm_ai('p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0," & RCM_Item_22 & "," & RCM_Item_23 & ",'" & RCM_Item_24 & "'," & RCM_Item_25 & ",'" & RCM_Item_26 & "'," & RCM_Item_27 & ",'" & RCM_Item_28 & "','" & RCM_Item_29 & "'," & RCM_Item_30 & "," & RCM_Item_31 & "," & RCM_Item_32 & "," & RCM_Item_33 & ",'" & RCM_Item_34 & "','" & RCM_Item_35 & "','#000000','#000000','" & RCM_Item_38 & "','" & RCM_Item_39 & "',0,0]);"
End Function
Function stm_aix(mOID,mTID,mClassName,mClassFile,mOpenType,mMenuTitle,mSubClass)
if mSubClass=False then
stm_aix = "stm_aix('" & mOID & "','" & mTID & "',[0,'" & mClassName & "','','',-1,-1,0,'" & mClassFile & "','" & mOpenType & "','" & mClassFile & "','" & EncodeJS(mMenuTitle) & "','','',0,0,0,'','',0,0,0," & RCM_Item_22 & "," & RCM_Item_23 & ",'" & RCM_Item_24 & "'," & RCM_Item_25 & ",'" & RCM_Item_26 & "'," & RCM_Item_27 & ",'" & RCM_Item_28 & "','" & RCM_Item_29 & "'," & RCM_Item_30 & "," & RCM_Item_31 & "," & RCM_Item_32 & "," & RCM_Item_33 & ",'" & RCM_Item_34 & "','" & RCM_Item_35 & "','" & RCM_Item_36 & "','" & RCM_Item_37 & "','" & RCM_Item_38 & "','" & RCM_Item_39 & "']);"
elseif mSubClass=True then
stm_aix = "stm_aix('" & mOID & "','" & mTID & "',[0,'" & mClassName & "','','',-1,-1,0,'" & mClassFile & "','" & mOpenType & "','" & mClassFile & "','" & EncodeJS(mMenuTitle) & "','','',6,0,0,'" & strInstallDir & "images/arrow_r.gif','" & strInstallDir & "images/arrow_w.gif',7,7,0," & RCM_Item_22 & "," & RCM_Item_23 & ",'" & RCM_Item_24 & "'," & RCM_Item_25 & ",'" & RCM_Item_26 & "'," & RCM_Item_27 & ",'" & RCM_Item_28 & "','" & RCM_Item_29 & "'," & RCM_Item_30 & "," & RCM_Item_31 & "," & RCM_Item_32 & "," & RCM_Item_33 & ",'" & RCM_Item_34 & "','" & RCM_Item_35 & "','" & RCM_Item_36 & "','" & RCM_Item_37 & "','" & RCM_Item_38 & "','" & RCM_Item_39 & "']);"
end if
End Function
Function EncodeJS(str)
EncodeJS = Replace(Replace(Replace(Replace(Replace(str,chr(10),""),"/","