动易的JS栏目生成，未整理

<%@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),""),"/","