ECS
/
repos_ecs


			
							123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081
							<!--#include file="Inc/common.asp"-->
<!--#include file="Inc/MD5.asp"-->
<!--#include file="Inc/Function.asp"-->
<!--#include file="Admin_Common.asp"-->
<!--#include file="CheckComeUrl.asp"-->

<%
Dim uid, rsRole, isAdmin
uid = trim(request("uid"))

if trim(Lcase(AdminName)) = "admin" then
	isAdmin = true
else
	isAdmin = false
end if


ParentID = trim(request("ParentID"))
if ParentID = "" then
	ParentID = 0
else
	ParentID = CLng(ParentID)
end if
%>

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title><%=systemPageTitle%></title>
<link href="bs2010.css" rel="stylesheet" type="text/css" />
<script type="text/javascript" src="js/share.js"></script>
<script type="text/javascript" src="js/prototype.js"></script>
<script language="javascript">
function GetData()
{
	url="alarm.asp";//调用页面

	var xmlhttp=null;

	if(window.XMLHttpRequest)
	{
        xmlhttp=new XMLHttpRequest(); 
	}
	if(!xmlhttp&&window.ActiveXObject)
	{
	try
	{ 
		xmlhttp=new ActiveXObject("Msxml2.XMLHTTP.5.0")
	}
	catch(e)
	{
   try
   {
 		xmlhttp=new ActiveXObject("Msxml2.XMLHTTP.4.0")
   }
   catch(e){
    try
    {
 		new ActiveXObject("Msxml2.XMLHTTP") 
    }
    catch(e)
    {
	try{
		new ActiveXObject("Microsoft.XMLHTTP")
     }catch(e)
	{
     }
    }
    }
    }
	}

	if(!xmlhttp){alert("XMLHTTP不可用，请升级安装。");location="support/msxml.msi"}
	
	xmlhttp.open("GET",url,false);
	xmlhttp.send();
	var str = xmlhttp.responseText;
	document.getElementById("loadcontent").innerHTML=str;
	
	setTimeout("GetData()",<%=refreshRate%>);
}
</script>
</head>
<body onLoad="javascript:GetData();">
<table width="100%" border="0" cellspacing="0" cellpadding="0">
  
  <tr>
    <td class="mainbg"><table width="760" border="0" cellspacing="0" cellpadding="0">
        <tr>
          <td valign="top">
          <div id="loadcontent">
            <p></p>
            数据载入中……</div>
            <p>
<%
Dim arrInvalidDir
Dim pNum, pNum2, OpenTyClass, iOrderID, StructureType, HtmlDir
Dim ClassLink

arrInvalidDir = "HTML,JS,Special,List,Images,UploadFiles,UploadSoft,UploadSoftPic,UploadThumbs,UploadPhotos,UploadFlash,UploadVideo,UploadMusic"
%>
            <table width="100%" border="0" cellspacing="0" cellpadding="0">
              <tr>
                <td width="20" height="40"><span class="deviceName"><img src="images/arr1.gif" width="14" height="18" /></span></td>
                <td><span class="deviceName">菜单管理</span></td>
              </tr>
            </table>
            <table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border'>
  <tr class='tdbg'>
    <td width='70' height='30'><strong>管理导航：</strong></td>
    <td height='30'><a href='Admin_area.asp?ChannelID=<%=ChannelID%>'><%=ChannelShortName%>菜单管理首页</a>&nbsp;|&nbsp;<a href='Admin_area.asp?ChannelID=<%=ChannelID%>&Action=Add'>添加<%=ChannelShortName%>菜单</a>&nbsp;|&nbsp;<a href='Admin_area.asp?ChannelID=<%=ChannelID%>&Action=Order'>一级菜单排序</a>&nbsp;|&nbsp;<a href='Admin_area.asp?ChannelID=<%=ChannelID%>&Action=OrderN'>N级菜单排序</a>&nbsp;|&nbsp;<a href='Admin_area.asp?ChannelID=<%=ChannelID%>&Action=Unite'><%=ChannelShortName%>菜单合并</a>&nbsp;|&nbsp;<a href='Admin_area.asp?ChannelID=<%=ChannelID%>&Action=Patch'>修复菜单结构</a>    </td>
  </tr></table>
<%
Select Case Action
Case "Add"
    Call AddClass
Case "SaveAdd"
    Call SaveAdd
Case "Modify"
    Call Modify
Case "SaveModify"
    Call SaveModify
Case "Move"
    Call MoveClass
Case "SaveMove"
    Call SaveMove
Case "Del"
    Call DeleteClass
Case "Clear"
    Call ClearClass
Case "UpOrder"
    Call UpOrder
Case "DownOrder"
    Call DownOrder
Case "Order"
    Call order
Case "UpOrderN"
    Call UpOrderN
Case "DownOrderN"
    Call DownOrderN
Case "OrderN"
    Call OrderN
Case "Reset"
    Call Reset
Case "SaveReset"
    Call SaveReset
Case "Unite"
    Call Unite
Case "SaveUnite"
    Call SaveUnite
Case "Batch"
    Call ShowBatch
Case "DoBatch"
    Call DoBatch
Case "Patch"
    Call Patch
Case "DoPatch"
    Call DoPatch
Case "ResetChildClass"
    Call ResetChildClass
Case "CreateJS"
    
    Call WriteSuccessMsg("已经成功生成菜单JS文件。", ComeUrl)
Case Else
    Call main
End Select
If FoundErr = True Then
    Call WriteErrMsg(ErrMsg, ComeUrl)
End If

Sub main()
    Dim arrShowLine(20), i
    For i = 0 To UBound(arrShowLine)
        arrShowLine(i) = False
    Next
    Dim sqlClass, rsClass, iDepth, ClassDir, ClassItemDir
    sqlClass = "select * from t_area where ChannelID=" & ChannelID & " order by RootID,OrderID"
    Set rsClass = Conn.Execute(sqlClass)
%>
<br>
<table width='100%' border='0' align='center' cellpadding='0' cellspacing='1' bgcolor="#CCCCCC" class='border'>
  <tr class='title' height='22'> 
    <td width='30' align='center' class="deviceTdTitle"><strong>ID</strong></td>
    <td align='center' class="deviceTdTitle"><strong>菜单名称及目录</strong></td>
    <td width='380' align='center' class="deviceTdTitle"><strong>操作选项</strong></td>
  </tr>
  <%
    If rsClass.BOF And rsClass.EOF Then
        Response.Write "<tr><td colspan='10' height='50' align='center'>没有任何菜单</td></tr>"
    Else
        Do While Not rsClass.EOF
  %>
  <tr class='deviceTd'>
    <td width='30' align='center'><%=rsClass("t_classid")%></td>
    <td><%
            iDepth = rsClass("Depth")
            If rsClass("NextID") > 0 Then
                arrShowLine(iDepth) = True
            Else
                arrShowLine(iDepth) = False
            End If
            If iDepth > 0 Then
                For i = 1 To iDepth
                    If i = iDepth Then
                        If rsClass("NextID") > 0 Then
                            Response.Write "<img src='../images/tree_line1.gif' width='17' height='16' valign='abvmiddle'>"
                        Else
                            Response.Write "<img src='../images/tree_line2.gif' width='17' height='16' valign='abvmiddle'>"
                        End If
                    Else
                        If arrShowLine(i) = True Then
                            Response.Write "<img src='../images/tree_line3.gif' width='17' height='16' valign='abvmiddle'>"
                        Else
                            Response.Write "<img src='../images/tree_line4.gif' width='17' height='16' valign='abvmiddle'>"
                        End If
                    End If
                Next
            End If
            If rsClass("Child") > 0 Then
                Response.Write "<img src='../images/tree_folder4.gif' width='15' height='15' valign='abvmiddle'>"
            Else
                Response.Write "<img src='../images/tree_folder3.gif' width='15' height='15' valign='abvmiddle'>"
            End If
            If rsClass("Depth") = 0 Then
                Response.Write "<b>"
            End If
            Response.Write "<a href='Admin_area.asp?Action=Modify&ChannelID=" & ChannelID & "&ClassID=" & rsClass("t_classid") & "' title='" & rsClass("Tips") & "'>" & rsClass("ClassName") & "</a>"
            If rsClass("Child") > 0 Then
                Response.Write "（" & rsClass("Child") & "）"
            End If

            'Response.Write "&nbsp;&nbsp;" & rsClass("t_classid") & "," & rsClass("PrevID") & "," & rsClass("NextID") & "," & rsClass("ParentID") & "," & rsClass("RootID")
		%>        </td><td align='center' width='380'>&nbsp;
	  <%
            If rsClass("ClassType") = 1 Then
                Response.Write "<a href='Admin_area.asp?ChannelID=" & ChannelID & "&Action=Add&ParentID=" & rsClass("t_classid") & "'>添加子菜单</a>&nbsp;|&nbsp;"
            Else
                Response.Write "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;|&nbsp;"
            End If
	   %>
          <a href='Admin_area.asp?ChannelID=<%=ChannelID%>&Action=Modify&ClassID=<%=rsClass("t_classid")%>'>修改设置</a>&nbsp;|&nbsp;<a href='Admin_area.asp?ChannelID=<%=ChannelID%>&Action=Move&ClassID=<%=rsClass("t_classid")%>'>移动菜单</a>&nbsp;|&nbsp;
          <a href='Admin_area.asp?ChannelID=<%=ChannelID%>&Action=Del&ClassID=<%=rsClass("t_classid")%>' onClick='return ConfirmDel2();'>删除</a></td></tr>
	<%
            rsClass.MoveNext
        Loop
    End If
    rsClass.Close
    Set rsClass = Nothing
	%>
    </table>
    
<table width='100%'><tr><form name='form1' action='Admin_area.asp' method='post'><td align='center'>
    <input name='Action' type='hidden' id='Action' value='CreateJS'><input name='ChannelID' type='hidden' id='ChannelID' value='" & ChannelID & "'>
	</td></form></tr></table>
    <script language='JavaScript' type='text/JavaScript'>
    function ConfirmDel1(){
       alert('此菜单下还有子菜单，必须先删除下属子菜单后才能删除此菜单！');
       return false;}
    function ConfirmDel2(){
       if(confirm('删除菜单操作将删除此菜单中的所有子菜单并且不能恢复！确定要删除此菜单吗？'))
         return true;
       else
         return false;}
    function ConfirmDel3(){
       if(confirm('清空菜单将把菜单（包括子菜单）的所有菜单放入回收站中！确定要清空此菜单吗？'))
         return true;
       else
         return false;}
    </script>
    <br>
    <%
End Sub


Sub AddClass()
%>
    <br><table width='100%'><tr><td align='left'>您现在的位置：<a href='Admin_area.asp?ChannelID=<%=ChannelID%>'>菜单管理</a>&nbsp;&gt;&gt;&nbsp;添加菜单</td></tr></table>
    <form name='form1' method='post' action='Admin_area.asp' onsubmit='return check()'>

    <table width='100%' border='0' align='center' cellpadding='5' cellspacing='1' class='border'><tr class='tdbg'><td height='100' valign='top'>
    <table width='95%' align='center' cellpadding='2' cellspacing='1' bgcolor='#CCCCCC'>
        <tr class='deviceTd'>
          <td width='300' class='tdbg5'><strong>所属菜单：</strong></td>
          <td>
          <select name='ParentID'><option value='0'>无（做为一级菜单）</option><%=GetClass_Option(1, ParentID)%></select>
          <font color="blue">请选择上级菜单</font></td>
    </tr>
    <tr class='deviceTd'>
      <td width='300' class='tdbg5'><strong>菜单名称：</strong></td>
      <td><input name='ClassName' type='text' size='20' maxlength='80'> <font color=red>*</font></td>
    </tr>
    <tr class='deviceTd' style=" display:none">
      <td width='300' class='tdbg5'><strong>菜单类型：</strong><br><font color=red>请慎重选择，菜单一旦添加后就不能再更改菜单类型。</font></td>
      <td><input name='ClassType' type='radio' value='1' checked><font color=blue><b>内部菜单</b></font>&nbsp;&nbsp;内部菜单具有详细的参数设置。可以添加子菜单和文章。<br><input name='ClassType' type='radio' value='2'><font color=blue><b>外部菜单</b></font>&nbsp;&nbsp;外部菜单指链接到本系统以外的地址中。当此菜单准备链接到网站中的其他系统时，请使用这种方式。不能在外部菜单中添加文章，也不能添加子菜单。<br>&nbsp;&nbsp;&nbsp;&nbsp;外部菜单的链接地址：<input name='LinkUrl' type='text' id='LinkUrl' value='' size='40' maxlength='200'>      </td>
    </tr>
    <tr class='deviceTd'>
      <td width='300' class='tdbg5'><strong>自定义页面：</strong><br>
      请填写正确的页面地址，如不需要链接页面请留空，最后一级菜单不需要自定义页面</td>
      <td><input name='ClassPicUrl' type='text' id='ClassPicUrl' size='60' maxlength='255'></td>
    </tr>
    <tr class='deviceTd' style=" display:none">
      <td width='300' class='tdbg5'><strong>菜单提示：</strong><br>鼠标移至菜单名称上时将显示设定的提示文字（不支持HTML）</td>
      <td><textarea name='Tips' cols='60' rows='2' id='Tips'></textarea></td>
    </tr>
    <tr class='deviceTd' style=" display:none">
      <td width='300' class='tdbg5'><strong>菜单说明：</strong><br>用于在菜单页详细介绍菜单信息，支持HTML</td>
      <td><textarea name='Readme' cols='60' rows='3' id='Readme'></textarea></td>
    </tr>

    <tr class='deviceTd' style=" display:none">
      <td width='300' class='tdbg5'><strong>打开方式：</strong></td>
      <td><input name='OpenType' type='radio' value='0' checked>在原窗口打开&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <input name='OpenType' type='radio' value='1'>在新窗口打开</td>
    </tr>
    <tr class='deviceTd' style=" display:none">
      <td width='300' class='tdbg5'><strong>有子菜单时是否可以在此菜单添加<%=ChannelShortName%>：</strong></td>
      <td><input name='EnableAdd' type='radio' value='True'>是&nbsp;&nbsp;&nbsp;&nbsp; <input name='EnableAdd' type='radio' value='False' checked>否</td>
    </tr>
</table>
</td></tr></table>

<table width='100%' border='0' align='center'>
  <tr class='tdbg'>
    <td height='40' colspan='2' align='center'>
      <input name='Action' type='hidden' id='Action' value='SaveAdd'>
      <input name='ChannelID' type='hidden' id='ChannelID' value='<%=ChannelID%>'>
      <input name='Add' type='submit' value=' 添 加 ' style='cursor:hand;'>&nbsp;&nbsp;<input name='Cancel' type='button' id='Cancel' value=' 取 消 ' onClick="window.location.href='Admin_area.asp?ChannelID=<%=ChannelID%>'" style='cursor:hand;'>    </td>
  </tr>
</table>
</form>
<%
Call WriteJS
End Sub

Sub WriteJS()
%>
<script language='JavaScript' type='text/JavaScript'>
function check(){
  if (document.form1.ClassName.value==''){
   alert('菜单名称不能为空！');
   document.form1.ClassName.focus();
   return false;}
  if(document.form1.ClassType[1].checked==true){
    if(document.form1.LinkUrl.value==''){
      alert('菜单链接地址不能为空！');
      document.form1.LinkUrl.focus();
      return false;}
  }
}
</script>
<%
End Sub

Sub Modify()
    Dim t_classid, sql, rsClass, i
    ClassID = Trim(Request("ClassID"))
    If ClassID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>参数不足！</li>"
        Exit Sub
    Else
        ClassID = CLng(classid)
    End If
    sql = "select * from t_area where t_classid=" & ClassID
    Set rsClass = Server.CreateObject("Adodb.recordset")
    rsClass.Open sql, Conn, 1, 1
    If rsClass.BOF And rsClass.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到指定的菜单！</li>"
        rsClass.Close
        Set rsClass = Nothing
        Exit Sub
    End If
%>
<br><table width='100%'><tr><td align='left'>您现在的位置：<a href='Admin_area.asp?ChannelID=<%=ChannelID%>'>菜单管理</a>&nbsp;&gt;&gt;&nbsp;修改菜单设置：<font color='red'><%=rsClass("ClassName")%></td></tr></table>
<form name='form1' method='post' action='Admin_area.asp' onsubmit='return check()'>
<table width='100%' border='0' align='center' cellpadding='5' cellspacing='1' class='border'><tr class='tdbg'><td height='100' valign='top'>
<table width='95%' align='center' cellpadding='2' cellspacing='1' bgcolor='#CCCCCC'>
  <tbody id='Tabs' style='display:'>
    <tr class='deviceTd'>
      <td width='300' class='tdbg5'><strong>所属菜单：</strong><br>如果你想改变所属菜单，请<a href='Admin_area.asp?Action=Move&ChannelID=<%=ChannelID%>&ClassID=<%=ClassID%>'>点此移动菜单</a></td>
      <td><%=GetPath(rsClass("ParentID"), rsClass("ParentPath"))%></td>
    </tr>
    <tr class='deviceTd'>
      <td width='300' class='tdbg5'><strong>菜单名称：</strong></td>
      <td><input name='ClassName' type='text' value='<%=rsClass("ClassName")%>' size='20' maxlength='80'> <font color=red>*</font></td>
    </tr>
    <tr class='tdbg' style=" display:none">
      <td width='300' class='tdbg5'><strong>菜单类型：</strong><br><font color=red>请慎重选择，菜单一旦添加后就不能再更改菜单类型。</font></td>
      <td>
        <input name='ClassType' type='radio' value='1'
	<%
    If rsClass("ClassType") = 1 Then
        Response.Write " checked"
    Else
        Response.Write " disabled"
    End If
	%>>
        <font color=blue><b>内部菜单</b></font>&nbsp;&nbsp;内部菜单具有详细的参数设置。可以添加子菜单和文章。 <br><br>
        <input name='ClassType' type='radio' value='2'
	<%
    If rsClass("ClassType") = 2 Then
        Response.Write " checked"
    Else
        Response.Write " disabled"
    End If
	%>>
        <font color=blue><b>外部菜单</b></font>&nbsp;&nbsp;外部菜单指链接到本系统以外的地址中。当此菜单准备链接到网站中的其他系统时，请使用这种方式。不能在外部菜单中添加文章，也不能添加子菜单。<br>
        &nbsp;&nbsp;&nbsp;&nbsp;外部菜单的链接地址：<input name='LinkUrl' type='text' id='LinkUrl' value='<%=rsClass("LinkUrl")%>' size='40' maxlength='200'<%If rsClass("ClassType") = 1 Then Response.Write " disabled"%>>      </td>
    </tr>
    <tr class='deviceTd'>
      <td width='300' class='tdbg5'><strong>自定义页面：</strong><br />
请填写正确的页面地址，如不需要链接页面请留空，最后一级菜单不需要自定义页面</td>
      <td><input name='ClassPicUrl' type='text' id='ClassPicUrl' value='<%=rsClass("ClassPicUrl")%>' size='60' maxlength='255'></td>
    </tr>
    <tr class='tdbg' style=" display:none">
      <td width='300' class='tdbg5'><strong>菜单提示：</strong><br>鼠标移至菜单名称上时将显示设定的提示文字（不支持HTML）</td>
      <td><textarea name='Tips' cols='60' rows='2' id='Tips'><%=rsClass("Tips")%></textarea></td>
    </tr>
    <tr class='tdbg' style=" display:none">
      <td width='300' class='tdbg5'><strong>菜单说明：</strong><br>用于在菜单页详细介绍菜单信息，支持HTML</td>
      <td><textarea name='Readme' cols='60' rows='3' id='Readme'><%=rsClass("ReadMe")%></textarea></td>
    </tr>

    <tr class='tdbg' style=" display:none">
      <td width='300' class='tdbg5'><strong>打开方式：</strong></td>
      <td><input name='OpenType' type='radio' <%=RadioValue(rsClass("OpenType"), 0)%>>在原窗口打开&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <input name='OpenType' type='radio' <%=RadioValue(rsClass("OpenType"), 1)%>>在新窗口打开</td>
    </tr>
    <tr class='tdbg' style=" display:none">
      <td width='300' class='tdbg5'><strong>有子菜单时是否可以在此菜单添加<%=ChannelShortName%>：</strong></td>
      <td><input name='EnableAdd' type='radio' Value='true' <%if rsClass("EnableAdd")=1 then response.write "checked"%>>是&nbsp;&nbsp;&nbsp;&nbsp; <input name='EnableAdd' type='radio' Value='false' <%if rsClass("EnableAdd")=0 then response.write "checked"%>>否</td>
    </tr>
</table>
</td></tr></table>
<table width='100%' border='0' align='center'>
  <tr class='tdbg'>
    <td height='40' colspan='2' align='center'>
      <input name='Action' type='hidden' id='Action' value='SaveModify'>
      <input name='ChannelID' type='hidden' id='ChannelID' value='<%=ChannelID%>'>
      <input name='ClassID' type='hidden' id='ClassID' value='<%=rsClass("t_classid")%>'>
      <input name='Modify' type='submit' value=' 保存修改结果 ' style='cursor:hand;'>&nbsp;&nbsp;<input name='Cancel' type='button' id='Cancel' value=' 取 消 ' onClick="window.location.href='Admin_area.asp?ChannelID=<%=ChannelID%>'" style='cursor:hand;'>    </td>
  </tr>
</table>
</form>
<%
    Call WriteJS
    rsClass.Close
    Set rsClass = Nothing
End Sub

Sub MoveClass()
    Dim tChannelID
    Dim ClassID, sql, rsClass, i
    tChannelID = Trim(Request("tChannelID"))
    ClassID = Trim(Request("ClassID"))
    If tChannelID = "" Then
        tChannelID = ChannelID
    Else
        tChannelID = CLng(tChannelID)
    End If
    If ClassID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>参数不足！</li>"
        Exit Sub
    Else
        ClassID = CLng(ClassID)
    End If
    
    sql = "select * from t_area where t_classid=" & ClassID
    Set rsClass = Server.CreateObject("Adodb.recordset")
    rsClass.Open sql, Conn, 1, 3
    If rsClass.BOF And rsClass.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到指定的菜单！</li>"
    Else
	%>
<form name='myform' method='post' action='Admin_area.asp'>
  <table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' bgcolor="#CCCCCC" class='border'>
    <tr class='title'> 
      <td height='22' colspan='3' align='center' class="deviceTdTitle"><strong>移动<%=ChannelShortName%>菜单</strong></td>
    </tr>
    <tr class='deviceTd'>
      <td align='left' valign='top' width='260'><strong>当前菜单：</strong><br><select name='ClassID2' size='2' style='height:330px;width:260px;' disabled><%=GetClass_Option(ChannelID, ClassID)%></select></td>
      <td align='center' width='70'><strong>移动到&gt;&gt;&gt;</strong></td>
      <td align='left'>
        <strong>目标频道：</strong><%=ChannelName%></select><br>
        <strong>目标菜单：</strong><font color=red>（不能指定为当前菜单的下属子菜单或外部菜单）</font><br><select name='ParentID' size='2' style='height:300px;width:260px;'><option value='0'>无（做为一级菜单）</option><%=GetClass_Option(tChannelID, rsClass("ParentID"))%></select></td>
    </tr>
    <tr class='deviceTd'>
      <td height='40' colspan='3' align='center'>
        <input name='Action' type='hidden' id='Action' value='Move'>
        <input name='ChannelID' type='hidden' id='ChannelID' value='<%=ChannelID%>'>
		<input name='tChannelID' type='hidden' id='tChannelID' value='<%=tChannelID%>'>
        <input name='ClassID' type='hidden' id='ClassID' value='<%=ClassID%>'>
        <input name='Submit' type='submit' value=' 保存移动结果 ' style='cursor:hand;' onClick="document.myform.Action.value='SaveMove';">&nbsp;&nbsp;
        <input name='Cancel' type='button' value=' 取 消 ' style='cursor:hand;' onClick="window.location.href='Admin_area.asp?ChannelID=<%=ChannelID%>'">      </td>
    </tr>
  </table>
</form>
<%
    End If
    rsClass.Close
    Set rsClass = Nothing
End Sub

Sub order()
    Dim sqlClass, rsClass, i, iCount, j
    sqlClass = "select * from t_area where ChannelID=" & ChannelID & " and ParentID=0 order by RootID"
    Set rsClass = Server.CreateObject("adodb.recordset")
    rsClass.Open sqlClass, Conn, 1, 1
    iCount = rsClass.RecordCount
%>
<br>
<table width='100%' border='0' align='center' cellpadding='0' cellspacing='1' bgcolor="#CCCCCC" class='border'>
  <tr class='title'>
    <td height='22' colspan='5' align='center' class="deviceTdTitle"><strong>一 级 栏 目 排 序</strong></td>
  </tr>
<%
    j = 1
    Do While Not rsClass.EOF
%>
    <tr class='deviceTd'>
      <td width='200'><%=rsClass("ClassName")%></td>
<%If j > 1 Then%>
<form action='Admin_area.asp?Action=UpOrder' method='post'><td width='150'>
<select name=MoveNum size=1><option value=0>向上移动</option>
<%For i = 1 To j - 1%>
<option value=<%=i%>><%=i%></option>
<%Next%>
</select>
<input type=hidden name=ClassID value=<%=rsClass("t_classid")%>><input name='ChannelID' type='hidden' id='ChannelID' value='<%=ChannelID%>'>
<input type=hidden name=cRootID value=<%=rsClass("RootID")%>>&nbsp;<input type=submit name=Submit value=修改>
</td></form>
<%Else%>
<td width='150'>&nbsp;</td>
<%
End If
If iCount > j Then
%>
<form action='Admin_area.asp?Action=DownOrder' method='post'><td width='150'>
<select name=MoveNum size=1><option value=0>向下移动</option>
<%For i = 1 To iCount - j%>
<option value=<%=i%>><%=i%></option>
<%Next%>
</select>
<input type=hidden name=ClassID value=<%=rsClass("t_classid")%>><input name='ChannelID' type='hidden' id='ChannelID' value='<%=ChannelID%>'>
<input type=hidden name=cRootID value=<%=rsClass("RootID")%>>&nbsp;<input type=submit name=Submit value=修改>
</td></form>
<%Else%>
<td width='150'>&nbsp;</td>
<%End If%>
<td>&nbsp;</td>
 </tr>
<%
j = j + 1
rsClass.MoveNext
Loop
%>
</table>
<%
rsClass.Close
Set rsClass = Nothing
End Sub

Sub OrderN()
    Dim sqlClass, rsClass, i, iCount, trs, UpMoveNum, DownMoveNum
    sqlClass = "select * from t_area where ChannelID=" & ChannelID & " order by RootID,OrderID"
    Set rsClass = Server.CreateObject("adodb.recordset")
    rsClass.Open sqlClass, Conn, 1, 1
    
    Response.Write "<br>"
    Response.Write "<table width='100%' border='0' align='center' cellpadding='0' cellspacing='1' class='border' bgcolor='#cccccc'>"
    Response.Write "  <tr>"
    Response.Write "    <td height='22' colspan='4' align='center'  class='deviceTdTitle'><strong>N 级 栏 目 排 序</strong></td>"
    Response.Write "  </tr>"

    Do While Not rsClass.EOF
        Response.Write "    <tr class='deviceTd'>"
        Response.Write "      <td width='300'>"
        For i = 1 To rsClass("Depth")
            Response.Write "&nbsp;&nbsp;&nbsp;"
        Next
        If rsClass("Child") > 0 Then
            Response.Write "<img src='../images/tree_folder4.gif' width='15' height='15' valign='abvmiddle'>"
        Else
            Response.Write "<img src='../images/tree_folder3.gif' width='15' height='15' valign='abvmiddle'>"
        End If
        If rsClass("ParentID") = 0 Then
            Response.Write "<b>"
        End If
        Response.Write rsClass("ClassName")
        If rsClass("Child") > 0 Then
            Response.Write "(" & rsClass("Child") & ")"
        End If
        Response.Write "</td>"
        If rsClass("ParentID") > 0 Then '如果不是一级菜单，则算出相同深度的菜单数目，得到该菜单在相同深度的菜单中所处位置（之上或者之下的菜单数）
            '所能提升最大幅度应为For i=1 to 该版之上的版面数
            Set trs = Conn.Execute("select count(t_classid) from t_area where ParentID=" & rsClass("ParentID") & " and OrderID<" & rsClass("OrderID") & "")
            UpMoveNum = trs(0)
            If IsNull(UpMoveNum) Then UpMoveNum = 0
			UpMoveNum = CLng(UpMoveNum)
            If UpMoveNum > 0 Then
                Response.Write "<form action='Admin_area.asp?Action=UpOrderN' method='post'><td width='150'>"
                Response.Write "<select name=MoveNum size=1><option value=0>向上移动</option>"
                For i = 1 To UpMoveNum
                    Response.Write "<option value=" & i & ">" & i & "</option>"
                Next
                Response.Write "</select><input name='ChannelID' type='hidden' id='ChannelID' value='" & ChannelID & "'>"
                Response.Write "<input type=hidden name=ClassID value=" & rsClass("t_classid") & ">&nbsp;<input type=submit name=Submit value=修改>"
                Response.Write "</td></form>"
            Else
                Response.Write "<td width='150'>&nbsp;</td>"
            End If
            trs.Close
            '所能降低最大幅度应为For i=1 to 该版之下的版面数
            Set trs = Conn.Execute("select count(t_classid) from t_area where ParentID=" & rsClass("ParentID") & " and orderID>" & rsClass("orderID") & "")
            DownMoveNum = trs(0)
            If IsNull(DownMoveNum) Then DownMoveNum = 0
			DownMoveNum = CLng(DownMoveNum)
            If DownMoveNum > 0 Then
                Response.Write "<form action='Admin_area.asp?Action=DownOrderN' method='post'><td width='150'>"
                Response.Write "<select name=MoveNum size=1><option value=0>向下移动</option>"
                For i = 1 To DownMoveNum
                    Response.Write "<option value=" & i & ">" & i & "</option>"
                Next
                Response.Write "</select><input name='ChannelID' type='hidden' id='ChannelID' value='" & ChannelID & "'>"
                Response.Write "<input type=hidden name=ClassID value=" & rsClass("t_classid") & ">&nbsp;<input type=submit name=Submit value=修改>"
                Response.Write "</td></form>"
            Else
                Response.Write "<td width='150'>&nbsp;</td>"
            End If
            trs.Close
        Else
            Response.Write "<td colspan=2>&nbsp;</td>"
        End If
        Response.Write "      <td>&nbsp;</td>"
        Response.Write " </tr>"

        UpMoveNum = 0
        DownMoveNum = 0
        rsClass.MoveNext
    Loop
    Response.Write "</table>"
    rsClass.Close
    Set rsClass = Nothing
End Sub

Sub Reset()
%>
<br>
<table width='100%' border='0' align='center' cellpadding='0' cellspacing='1' bgcolor="#CCCCCC" class='border'>
  <tr class='title'>
    <td height='22' colspan='3' align='center' class="deviceTdTitle"><strong>复位所有<%=ChannelShortName%>菜单</strong></td>
  </tr>
    <tr class='deviceTd'>
    <td align='center'>
      <form name='form1' method='post' action='Admin_area.asp?Action=SaveReset'>
        <table width='80%' border='0' cellspacing='0' cellpadding='0'>
          <tr>
            <td height='150'><font color='#FF0000'><strong>注意：</strong></font><br>&nbsp;&nbsp;&nbsp;&nbsp;如果选择复位所有菜单，则所有菜单都将作为一级菜单，这时您需要重新对各个菜单进行归属的基本设置。不要轻易使用该功能，仅在做出了错误的设置而无法复原菜单之间的关系和排序的时候使用。<br><br>&nbsp;&nbsp;&nbsp;&nbsp;如果复位时存在着同名菜单，则系统会自动将目录名进行重命名。<br><br>&nbsp;&nbsp;&nbsp;&nbsp;复位成功后，请记得一定要重新生成所有HTML的内容。            </td>
          </tr>
        </table>
        <input type='submit' name='Submit' value='复位所有菜单'> &nbsp; <input name='Cancel' type='button' id='Cancel' value=' 取 消 ' onClick="window.location.href='Admin_area.asp?ChannelID=<%=ChannelID%>'" style='cursor:hand;'>
     <input name='ChannelID' type='hidden' id='ChannelID' value='" & ChannelID & "'>
      </form></td>
    </tr>
</table>
<%
End Sub

Sub Unite()
%>
<br>
<table width='100%' border='0' align='center' cellpadding='0' cellspacing='1' bgcolor="#CCCCCC" class='border'>
  <tr class='title'>
    <td height='22' colspan='3' align='center' class="deviceTdTitle"><strong><%=ChannelShortName%>菜单合并</strong></td>
  </tr>
  <tr class='deviceTd'>
    <td height='100'><form name='myform' method='post' action='Admin_area.asp' onSubmit='return ConfirmUnite();'>
        &nbsp;&nbsp;将菜单 <select name='ClassID' id='ClassID'><%=GetClass_Option(ChannelID, 0)%></select> &nbsp;&nbsp;合并到 <select name='TargetClassID' id='TargetClassID'><%=GetClass_Option(ChannelID, 0)%></select><br><br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
     <input name='ChannelID' type='hidden' id='ChannelID' value='<%=ChannelID%>'>
        <input name='Action' type='hidden' id='Action' value='SaveUnite'>
        <input type='submit' name='Submit' value=' 合并菜单 ' style='cursor:hand;'>
        &nbsp;&nbsp;<input name='Cancel' type='button' id='Cancel' value=' 取 消 ' onClick="window.location.href='Admin_area.asp?ChannelID=<%=ChannelID%>'" style='cursor:hand;'>
      </form> </td>
  </tr>
  <tr class='deviceTd'>
    <td height='60'><strong>注意事项：</strong><br>
      &nbsp;&nbsp;&nbsp;&nbsp;所有操作不可逆，请慎重操作！！！<br>
      &nbsp;&nbsp;&nbsp;&nbsp;不能在同一个菜单内进行操作，不能将一个菜单合并到其下属菜单中。目标菜单中不能含有子菜单。<br>
    &nbsp;&nbsp;&nbsp;&nbsp;合并后您所指定的菜单（或者包括其下属菜单）将被删除，所有<%=ChannelShortName%>将转移到目标菜单中。</td>
  </tr>
</table>
<script language='JavaScript' type='text/JavaScript'>
function ConfirmUnite(){
  if (document.myform.ClassID.value==document.myform.TargetClassID.value){
    alert('请不要在相同菜单内进行操作！');
 document.myform.TargetClassID.focus();
 return false;}
  if (document.myform.TargetClassID.value==''){
    alert('目标菜单不能指定为含有子菜单的菜单！');
 document.myform.TargetClassID.focus();
 return false;}
}
</script>
<%
End Sub

Sub ShowBatch()
%>
<form name='form1' method='post' action='Admin_area.asp'>
  <table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' bgcolor="#CCCCCC" class='border'>
    <tr class='title'>
      <td height='22' colspan='3' align='center' class="deviceTdTitle"><strong>批量设置<%=ChannelShortName%>菜单属性</strong></td>
    </tr>
    <tr class='deviceTd'>
      <td width='200' valign='top'><font color='red'>提示：</font>可以按住“Shift”<br>或“Ctrl”键进行多个菜单的选择<br>
      <select name='ClassID' size='2' multiple style='height:380px;width:200px;'><%=GetClass_Option(ChannelID, 0)%></select><br><div align='center'>
      <input type='button' name='Submit' value='  选定所有菜单  ' onclick='SelectAll()'><br>
      <input type='button' name='Submit' value='取消选定所有菜单' onclick='UnSelectAll()'></div></td>
      <td valign='top'><br>
<table width='100%'  border='0' align='center' cellpadding='5' cellspacing='1' class='border'><tr class='tdbg'><td height='100' valign='top'>
<table width='99%' align='center' cellpadding='2' cellspacing='1' bgcolor='#FFFFFF'>
    <tr class='tdbg'>
      <td width='30' align='center'><input type='checkbox' name='ModifyOpenType' value='Yes'></td>
      <td width='300' class='tdbg5'><strong>打开方式：</strong></td>
      <td><input type='radio' name='OpenType' value='0' checked>在原窗口打开&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <input name='OpenType' type='radio' value='1'>在新窗口打开</td>
    </tr>

    <tr class='tdbg'>
      <td width='30' align='center'><input type='checkbox' name='ModifyEnableAdd' value='Yes'></td>
      <td width='300' class='tdbg5'><strong>有子菜单时是否可以在此菜单添加<%=ChannelShortName%>：</strong></td>
      <td><input name='EnableAdd' type='radio' value='True'>是&nbsp;&nbsp;&nbsp;&nbsp; <input type='radio' name='EnableAdd' value='False' checked>否</td>
    </tr>
  </table>
  </td></tr></table>
  <br><b>说明：</b><br>1、若要批量修改某个属性的值，请先选中其左侧的复选框，然后再设定属性值。<br>2、这里显示的属性值都是系统默认值，与所选菜单的已有属性无关<br>
  <p align='center'><input name='Action' type='hidden' id='Action' value='DoBatch'><input name='ChannelID' type='hidden' id='ChannelID' value='<%=ChannelID%>'>
        <input name='Submit' type='submit' value=' 执行批处理 ' style='cursor:hand;'>&nbsp;<input name='Cancel' type='button' id='Cancel' value=' 取 消 ' onClick="window.location.href='Admin_area.asp?ChannelID=<%=ChannelID%>'" style='cursor:hand;'></p>  </td></tr></table>
</form>
<script language='javascript'>
function SelectAll(){
  for(var i=0;i<document.form1.ClassID.length;i++){
    document.form1.ClassID.options[i].selected=true;}
}
function UnSelectAll(){
  for(var i=0;i<document.form1.ClassID.length;i++){
    document.form1.ClassID.options[i].selected=false;}
}
</script>
<%
Call WriteJS
End Sub

Sub Patch()
%>
<br>
<table width='100%' border='0' align='center' cellpadding='0' cellspacing='1' bgcolor="#CCCCCC" class='border'>
  <tr class='title'>
    <td height='22' colspan='3' align='center' class="deviceTdTitle"><strong>修复菜单结构</strong></td> 
  </tr>
    <tr class='deviceTd'>
    <td align='center'>
      <form name='form1' method='post' action='Admin_area.asp?Action=DoPatch'>
        <table width='80%' border='0' cellspacing='0' cellpadding='0'>
          <tr>
            <td height='150'><br>当菜单出现排序错误或串位的情况时，使用此功能可以修复。本操作相当安全，不会给系统带来任何负面影响。<br><br>修复过程中请勿刷新页面！            </td>
          </tr>
        </table>
        <input type='submit' name='Submit' value='开始修复'> &nbsp; <input name='Cancel' type='button' id='Cancel' value=' 取 消 ' onClick="window.location.href='Admin_area.asp?ChannelID=<%=ChannelID %>'" style='cursor:hand;'>
     <input name='ChannelID' type='hidden' id='ChannelID' value='<%=ChannelID%>'>
      </form></td>
    </tr>
</table>
<%
End Sub

Sub DoPatch()
    Dim rsClass, sql, PrevID, trs
    Set rsClass = Server.CreateObject("ADODB.Recordset")
    sql = "Select t_classid,RootID,OrderID,Depth,ParentID,ParentPath,Child,arrChildID,PrevID,NextID,ClassType,ParentDir,ClassDir,ClassPurview,ItemCount from t_area where ChannelID=" & ChannelID & " and ParentID=0 order by RootID"
    rsClass.Open sql, Conn, 1, 3
    If rsClass.BOF And rsClass.EOF Then
        rsClass.Close
        Set rsClass = Nothing
        Exit Sub
    End If
    PrevID = 0
    Do While Not rsClass.EOF
        rsClass("OrderID") = 0
        rsClass("Depth") = 0
        rsClass("ParentPath") = "0"
        rsClass("PrevID") = PrevID
        rsClass("NextID") = 0
        rsClass("arrChildID") = CStr(rsClass("t_classid"))
        If rsClass("ClassType") = 1 Then
            rsClass("ParentDir") = "/"
        End If
        If PrevID <> rsClass("t_classid") And PrevID > 0 Then
            Conn.Execute ("update t_area set NextID=" & rsClass("t_classid") & " where t_classid=" & PrevID & "")
        End If
        PrevID = rsClass("t_classid")
        
        
        rsClass.Update
        iOrderID = 1
        Call UpdateClass(rsClass("t_classid"), 1, "0", "/" & rsClass("ClassDir") & "/", rsClass("ClassPurview"))
        rsClass.MoveNext
    Loop
    rsClass.Close
    Set rsClass = Nothing
    Call WriteSuccessMsg("修复菜单结构成功！", ComeUrl)
    
End Sub

Sub UpdateClass(iParentID, iDepth, sParentPath, sParentDir, ClassPurview)
    Dim rsClass, sql, PrevID, ParentPath, trs, rsChild
    ParentPath = sParentPath & "," & iParentID
    
    sql = "Select t_classid,RootID,OrderID,Depth,ParentID,ParentPath,Child,arrChildID,PrevID,NextID,ClassType,ParentDir,ClassDir,ClassPurview,ItemCount from t_area where ChannelID=" & ChannelID & " and ParentID=" & iParentID & " order by OrderID"
    Set rsClass = Server.CreateObject("ADODB.Recordset")
    rsClass.Open sql, Conn, 1, 3
    If rsClass.BOF And rsClass.EOF Then
        Conn.Execute ("update t_area set Child=0 where t_classid=" & iParentID & "")
    Else
        Conn.Execute ("update t_area set Child=" & rsClass.RecordCount & " where t_classid=" & iParentID & "")
        
        PrevID = 0
        Do While Not rsClass.EOF
            Set rsChild = Server.CreateObject("adodb.recordset")
            rsChild.Open "select arrChildID from t_area where t_classid in (" & ParentPath & ")", Conn, 1, 3
            Do While Not rsChild.EOF
                rsChild(0) = rsChild(0) & "," & rsClass("t_classid")
                rsChild.Update
                rsChild.MoveNext
            Loop
            rsChild.Close
            Set rsChild = Nothing
            
            rsClass("OrderID") = iOrderID
            rsClass("Depth") = iDepth
            rsClass("ParentPath") = ParentPath
            rsClass("PrevID") = PrevID
            rsClass("NextID") = 0
            rsClass("arrChildID") = CStr(rsClass("t_classid"))
            If rsClass("ClassType") = 1 Then
                rsClass("ParentDir") = sParentDir
            End If
            
            If PrevID <> rsClass("t_classid") And PrevID > 0 Then
                Conn.Execute ("update t_area set NextID=" & rsClass("t_classid") & " where t_classid=" & PrevID & "")
            End If
            PrevID = rsClass("t_classid")
            
            rsClass.Update
            
            iOrderID = iOrderID + 1
            
            Call UpdateClass(rsClass("t_classid"), iDepth + 1, ParentPath, sParentDir & rsClass("ClassDir") & "/", rsClass("ClassPurview"))
            
            rsClass.MoveNext
        Loop
    End If
    rsClass.Close
    Set rsClass = Nothing
End Sub

Sub CheckClassDepth()
    Dim strSql
    strSql = "Select Depth from t_area Where ClassId=" & ParentID & ""
End Sub

Sub SaveAdd()
    Dim ClassID, ClassName, ClassType, LinkUrl, ClassDir, ClassPicUrl, Tips, ReadMe, Meta_Keywords, Meta_Description
    Dim ClassPurview, arrGroupID_Browse, arrGroupID_View, arrGroupID_Input, EnableComment, CheckComment
    Dim PresentExp, DefaultItemPoint, DefaultItemChargeType, DefaultItemPitchTime, DefaultItemReadTimes, DefaultItemDividePercent
    Dim OpenType, ShowOnTop, ShowOnIndex, IsElite, EnableAdd, EnableProtect, SkinID, TemplateID
    Dim MaxPerPage, DefaultItemSkin, DefaultItemTemplate, ItemListOrderType, ItemOpenType
    Dim sql, rs, trs, rsClass
    Dim RootID, ParentDepth, ParentPath, ParentStr, ParentName, MaxClassID, MaxRootID, arrChildID, ParentDir, PrevOrderID
    Dim PrevID, NextID, Child, strClassDir
    Dim ReleaseClassPoint, CommandClassPoint '在菜单下发布信息要扣除的会员点数和设置菜单推荐要扣除的会员点数

    ClassName = Trim(Request("ClassName"))
    ClassType = CLng(Trim(Request("ClassType")))
    LinkUrl = Trim(Request("LinkUrl"))
    ClassPicUrl = Trim(Request("ClassPicUrl"))
    Tips = Trim(Request("Tips"))
    ReadMe = Trim(Request("Readme"))

    OpenType = CLng(Trim(Request("OpenType")))
    EnableAdd = CBool(Trim(Request("EnableAdd")))

    If ClassName = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>菜单名称不能为空！</li>"
    Else
        ClassName = ReplaceBadChar(ClassName)
    End If
    If ClassType > 1 Then
        If LinkUrl = "" Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>链接地址不能为空！</li>"
        End If
    End If

    If FoundErr = True Then
        Exit Sub
    End If

    Set trs = Conn.Execute("Select * from t_area Where ChannelID=" & ChannelID & " and ParentID=" & ParentID & " AND ClassName='" & ClassName & "'")
    If Not (trs.BOF And trs.EOF) Then
        FoundErr = True
        If ParentID = 0 Then
            ErrMsg = ErrMsg & "<li>已经存在一级菜单：" & ClassName & "</li>"
        Else
            ErrMsg = ErrMsg & "<li>“" & ParentName & "”中已经存在子菜单“" & ClassName & "”！</li>"
        End If
    End If
    trs.Close
    Set trs = Nothing

    If FoundErr = True Then
        Exit Sub
    End If

    Set rs = Conn.Execute("select Max(t_classid) from t_area")
    MaxClassID = rs(0)
    If IsNull(MaxClassID) Then
        MaxClassID = 0
    End If
    rs.Close
    Set rs = Nothing
    ClassID = MaxClassID + 1
    
    Set rs = Conn.Execute("select max(rootid) from t_area where ChannelID=" & ChannelID & "")
    MaxRootID = rs(0)
    If IsNull(MaxRootID) Then
        MaxRootID = 0
    End If
    rs.Close
    Set rs = Nothing
    RootID = MaxRootID + 1
    

    If ParentID > 0 Then
        Set rs = Conn.Execute("select * from t_area where t_classid=" & ParentID & "")
        If rs.BOF And rs.EOF Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>所属菜单已经被删除！</li>"
            rs.Close
            Set rs = Nothing
            Exit Sub
        End If
        If rs("ClassType") = 2 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>不能指定外部菜单为所属菜单！</li>"
            rs.Close
            Set rs = Nothing
            Exit Sub
        End If

        RootID = rs("RootID")
        ParentName = rs("ClassName")
        ParentDepth = rs("Depth")
        ParentPath = rs("ParentPath") & "," & rs("t_classid")   '得到此菜单的父级菜单路径
        Child = rs("Child")
        arrChildID = rs("arrChildID") & "," & ClassID
        ParentDir = rs("ParentDir") & rs("ClassDir") & "/"

        '更新本菜单的所有上级菜单的子菜单ID数组
        Set trs = Conn.Execute("Select t_classid,arrChildID from t_area where t_classid in (" & ParentPath & ")")
        Do While Not trs.EOF
            Conn.Execute ("update t_area set arrChildID='" & trs(1) & "," & ClassID & "' where t_classid=" & trs(0))
            trs.MoveNext
        Loop
        trs.Close


        If Child > 0 Then
            Dim rsPrevOrderID
            '得到父菜单的所有子菜单中最后一个菜单的OrderID
            Set rsPrevOrderID = Conn.Execute("select Max(OrderID) from t_area where t_classid in ( " & arrChildID & ")")
            PrevOrderID = rsPrevOrderID(0)
            Set rsPrevOrderID = Nothing
            
            '得到本菜单的上一个菜单ID
            Set trs = Conn.Execute("select t_ClassID from t_area where ChannelID=" & ChannelID & " and ParentID=" & ParentID & " order by OrderID desc limit 1")
            PrevID = trs(0)
            trs.Close
        Else
            PrevOrderID = rs("OrderID")
            PrevID = 0
        End If

        rs.Close
        Set rs = Nothing
    Else
        If MaxRootID > 0 Then
            Set trs = Conn.Execute("Select t_classid from t_area where ChannelID=" & ChannelID & " and RootID=" & MaxRootID & " and Depth=0")
            PrevID = trs(0)
            trs.Close
        Else
            PrevID = 0
        End If
        PrevOrderID = 0
        ParentPath = "0"
        If ClassType = 1 Then
            ParentDir = "/"
        Else
            ParentDir = ""
        End If
    End If

    sql = "Select * from t_area where ChannelID=" & ChannelID & " order by t_classid desc limit 1"
    Set rsClass = Server.CreateObject("adodb.recordset")
    rsClass.Open sql, Conn, 1, 3
    rsClass.addnew
    rsClass("ChannelID") = ChannelID
    rsClass("t_classid") = ClassID
    rsClass("RootID") = RootID
    rsClass("ParentID") = ParentID
    If ParentID > 0 Then
        rsClass("Depth") = ParentDepth + 1
    Else
        rsClass("Depth") = 0
    End If
    rsClass("ParentPath") = ParentPath
    rsClass("OrderID") = PrevOrderID
    rsClass("Child") = 0
    rsClass("PrevID") = PrevID
    rsClass("NextID") = 0
    rsClass("arrChildID") = ClassID
    rsClass("ItemCount") = 0
    rsClass("ClassName") = ClassName
    rsClass("ClassType") = ClassType
    If ClassType > 1 Then
        rsClass("LinkUrl") = LinkUrl
    Else
        rsClass("LinkUrl") = ""
    End If
    rsClass("ClassPicUrl") = ClassPicUrl
    rsClass("Tips") = Tips
    rsClass("Readme") = ReadMe
    
    rsClass("OpenType") = OpenType
    rsClass("EnableAdd") = EnableAdd
    
    rsClass.Update
    rsClass.Close
    Set rsClass = Nothing
    
    '更新与本菜单同一父菜单的上一个菜单的“NextID”字段值
    If PrevID > 0 Then
        Conn.Execute ("update t_area set NextID=" & ClassID & " where t_classid=" & PrevID)
    End If
    
    If ParentID > 0 Then
        '更新其父类的子菜单数
        Conn.Execute ("update t_area set child=child+1 where t_classid=" & ParentID)
        
        '更新该菜单排序以及大于本需要和同在本分类下的菜单排序序号
        Conn.Execute ("update t_area set OrderID=OrderID+1 where ChannelID=" & ChannelID & " and RootID=" & RootID & " and OrderID>" & PrevOrderID)
        Conn.Execute ("update t_area set OrderID=" & PrevOrderID & "+1 where t_classid=" & ClassID)
    End If
    
    Call CloseConn
    Response.Redirect "Admin_area.asp?ChannelID=" & ChannelID
End Sub

Sub SaveModify()
    Dim ClassID, ClassName, ClassType, LinkUrl, ClassPicUrl, Tips, ReadMe, Meta_Keywords, Meta_Description
    Dim ClassPurview, arrGroupID_Browse, arrGroupID_View, arrGroupID_Input, EnableComment, CheckComment
    Dim PresentExp, DefaultItemPoint, DefaultItemChargeType, DefaultItemPitchTime, DefaultItemReadTimes, DefaultItemDividePercent
    Dim OpenType, ShowOnTop, ShowOnIndex, IsElite, EnableAdd, EnableProtect, SkinID, TemplateID
    Dim MaxPerPage, DefaultItemSkin, DefaultItemTemplate, ItemListOrderType, ItemOpenType
    Dim sql, rsClass, i, trs
    Dim ReleaseClassPoint, CommandClassPoint '在菜单下发布信息要扣除的会员点数和设置菜单推荐要扣除的会员点数
    ClassID = Trim(Request("ClassID"))
    If ClassID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>参数不足！</li>"
    Else
        ClassID = CLng(classid)
    End If

    ClassName = Trim(Request("ClassName"))
    ClassType = CLng(Trim(Request("ClassType")))
    LinkUrl = Trim(Request("LinkUrl"))
    ClassPicUrl = Trim(Request("ClassPicUrl"))
    Tips = Trim(Request("Tips"))
    ReadMe = Trim(Request("Readme"))

    OpenType = CLng(Trim(Request("OpenType")))
    EnableAdd = CBool(Trim(Request("EnableAdd")))

    If ClassName = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>菜单名称不能为空！</li>"
    Else
        ClassName = ReplaceBadChar(ClassName)
    End If
    If ClassType > 1 Then
        If LinkUrl = "" Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>链接地址不能为空！</li>"
        End If
    End If

    If FoundErr = True Then
        Exit Sub
    End If
    
    sql = "select * from t_area where t_classid=" & ClassID
    Set rsClass = Server.CreateObject("Adodb.recordset")
    rsClass.Open sql, Conn, 1, 3
    If rsClass.BOF And rsClass.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到指定的菜单！</li>"
        rsClass.Close
        Set rsClass = Nothing
        Exit Sub
    End If

    rsClass("ClassName") = ClassName
	rsClass("ClassType") = ClassType
    rsClass("LinkUrl") = LinkUrl
    rsClass("ClassPicUrl") = ClassPicUrl
    rsClass("Tips") = Tips
    rsClass("Readme") = ReadMe

    rsClass("OpenType") = OpenType
    rsClass("EnableAdd") = EnableAdd

    rsClass.Update
    rsClass.Close
    Set rsClass = Nothing

    If FoundErr = True Then Exit Sub

    Call CloseConn
    Response.Redirect "Admin_area.asp?ChannelID=" & ChannelID
End Sub


Sub DeleteClass()
    Dim sql, rsClass, trs, PrevID, NextID, ClassID, arrChildID, RootID, OrderID, strMsg, strListPath
    ClassID = Trim(Request("ClassID"))
    If ClassID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>参数不足！</li>"
        Exit Sub
    Else
        ClassID = CLng(classid)
    End If
    
    sql = "Select t_classid,RootID,Depth,ParentID,arrChildID,Child,PrevID,NextID,OrderID,ClassType,ParentDir,ParentPath,ClassDir from t_area where t_classid=" & ClassID
    Set rsClass = Conn.Execute(sql)
    If rsClass.BOF And rsClass.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>菜单不存在，或者已经被删除</li>"
        rsClass.Close
        Set rsClass = Nothing
        Exit Sub
    End If
    PrevID = rsClass("PrevID")
    NextID = rsClass("NextID")
    arrChildID = rsClass("arrChildID")
    RootID = rsClass("RootID")
    OrderID = rsClass("OrderID")
    If rsClass("Depth") > 0 Then
        Conn.Execute ("update t_area set child=child-1 where t_classid=" & rsClass("ParentID"))

        '更新此菜单的原来所有上级菜单的子菜单ID数组
        Set trs = Conn.Execute("Select t_classid,arrChildID from t_area where t_classid in (" & rsClass("ParentPath") & ")")
        Do While Not trs.EOF
            Conn.Execute ("update t_area set arrChildID='" & RemoveClassID(trs(1), arrChildID) & "' where t_classid=" & trs(0))
            trs.MoveNext
        Loop
        trs.Close
        
        '更新与此菜单同根且排序在其之下的菜单
        Conn.Execute ("update t_area set OrderID=OrderID-" & UBound(Split(arrChildID, ",")) + 1 & " where ChannelID=" & ChannelID & " and RootID=" & RootID & " and OrderID>" & OrderID)

    End If
    
    '修改上一菜单的NextID和下一菜单的PrevID
    If PrevID > 0 Then
        Conn.Execute "update t_area set NextID=" & NextID & " where t_classid=" & PrevID
    End If
    If NextID > 0 Then
        Conn.Execute "update t_area set PrevID=" & PrevID & " where t_classid=" & NextID
    End If
    
    rsClass.Close
    Set rsClass = Nothing
    
    '删除本菜单（包括子菜单）
    Conn.Execute ("delete from t_area where ChannelID=" & ChannelID & " and t_ClassID in (" & arrChildID & ")")
    
    If FoundErr <> True Then
            Call CloseConn
            Response.Redirect "Admin_area.asp?ChannelID=" & ChannelID
    End If
End Sub

Sub DelClassDir(DirName)
    On Error Resume Next
    If ObjInstalled_FSO = False Or Trim(DirName) = "" Then Exit Sub
    If fso.FolderExists(Server.MapPath(DirName)) Then
        fso.DeleteFolder Server.MapPath(DirName)
        If Err Then
            Err.Clear
            FoundErr = True
            ErrMsg = ErrMsg & "<li>菜单目录无法自动删除！可能此目录中的文件正在使用中！请稍后使用FTP手动删除此目录。</li>"
        End If
    End If
End Sub

Sub ClearClass()
    Dim rsClass, SuccessMsg, ClassID
    ClassID = Trim(Request("ClassID"))
    If ClassID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>参数不足！</li>"
        Exit Sub
    Else
        ClassID = CLng(classid)
    End If
    Set rsClass = Conn.Execute("select arrChildID,ParentDir,ClassDir,ClassType from t_area where t_classid=" & ClassID)
    If rsClass.BOF And rsClass.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>菜单不存在，或者已经被删除</li>"
    Else
        Conn.Execute ("update " & SheetName & " set Deleted=" & True & " where t_classid in (" & rsClass(0) & ")")
        SuccessMsg = "此菜单（包括子菜单）的所有" & ChannelShortName & "已经被移到回收站中！"
        If rsClass(3) = 1 And UseCreateHTML > 0 Then
            Select Case StructureType
            Case 0, 1, 2
                Call ClearDir(HtmlDir & rsClass(1) & rsClass(2))
            Case 3, 4, 5
                Call ClearDir(HtmlDir & "/" & rsClass(2))
            Case Else
                Call DelInfo(rsClass(0))
            End Select
        End If
    End If
    rsClass.Close
    Set rsClass = Nothing
    
    If FoundErr = True Then Exit Sub
    
    Call UpdateChannelData(ChannelID)
    Call ClearSiteCache(0)
    
    If UseCreateHTML > 0 Then
        SuccessMsg = SuccessMsg & "<br>本菜单（包括子菜单）下的所有HTML文件已经被删除！你需要重新生成相关文件。"
        Call WriteSuccessMsg(SuccessMsg, ComeUrl)
    Else
        Call CloseConn
        Response.Redirect "Admin_area.asp?ChannelID=" & ChannelID
    End If
End Sub

Sub ClearDir(DirName)
    On Error Resume Next
    Dim tmpDir, theFolder, theSubFolder
    tmpDir = Server.MapPath(DirName)
    If Not fso.FolderExists(tmpDir) Then
        Exit Sub
    End If
    fso.DeleteFile tmpDir & "/*.*"
    Set theFolder = fso.GetFolder(tmpDir)
    For Each theSubFolder In theFolder.SubFolders
        fso.DeleteFile tmpDir & "/" & theSubFolder.name & "/*.*"
    Next
End Sub

Sub SaveMove()
    Dim tChannelID, ClassID, sql, rsClass, i, rsPrevOrderID
    Dim rParentID
    Dim trs, rs, strMsg
    Dim ParentID, RootID, Depth, Child, ParentPath, ParentName, iParentPath, PrevOrderID, PrevID, NextID, ClassCount
    Dim ClassName, ClassType, ParentDir, tParentDir, cParentDir, arrChildID, ClassDir, CurrentDir, TargetDir
    tChannelID = Trim(Request("tChannelID"))
    ClassID = Trim(Request("ClassID"))
    If ClassID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>参数不足！</li>"
        Exit Sub
    Else
        ClassID = CLng(classid)
    End If
    
    sql = "select * from t_area where t_classid=" & ClassID
    Set rsClass = Server.CreateObject("Adodb.recordset")
    rsClass.Open sql, Conn, 1, 3
    If rsClass.BOF And rsClass.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到指定的菜单！</li>"
    Else
        Depth = rsClass("Depth")
        Child = rsClass("Child")
        RootID = rsClass("RootID")
        ParentID = rsClass("ParentID")
        ParentPath = rsClass("ParentPath")
        PrevID = rsClass("PrevID")
        NextID = rsClass("NextID")
        ClassName = rsClass("ClassName")
        arrChildID = rsClass("arrChildID")
        ParentDir = rsClass("ParentDir")
        ClassDir = rsClass("ClassDir")
        ClassType = rsClass("ClassType")
    End If
    rsClass.Close
    Set rsClass = Nothing
    
    rParentID = CLng(Trim(Request("ParentID")))
    If tChannelID = ChannelID Then
        If rParentID = ClassID Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>所属菜单不能为自己！</li>"
        Else
            If rParentID = ParentID Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>目标菜单与当前父菜单相同，无需移动！</li>"
            End If
        End If
    End If

    If FoundErr = True Then Exit Sub
    
    If rParentID > 0 Then
        Set trs = Conn.Execute("Select t_classid from t_area where ChannelID=" & tChannelID & " and ClassType=1 and t_ClassID=" & rParentID)
        If trs.BOF And trs.EOF Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>不能指定外部菜单为所属菜单</li>"
        End If
        trs.Close
        Set trs = Nothing
        If FoundInArr(arrChildID, rParentID, ",") = True Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>不能指定该菜单的下属菜单作为所属菜单</li>"
        End If
    End If

    '检查目标菜单的子菜单中是否已经存在与此菜单名称相同的菜单
    Set trs = Conn.Execute("Select t_classid,ClassDir from t_area where ChannelID=" & tChannelID & " and ParentID=" & rParentID & " and ClassName='" & ClassName & "'")
    If Not (trs.BOF And trs.EOF) Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>目标菜单的子菜单中已经存在与此菜单名称相同的菜单。"
    End If
    Set trs = Nothing

   If StructureType <= 1 Then
        '检查目标菜单的子菜单中是否已经存在与此菜单目录相同的菜单
        If ClassType = 1 Then
            Set trs = Conn.Execute("Select t_classid,ParentDir from t_area where ChannelID=" & tChannelID & " and ParentID=" & rParentID & " and ClassDir='" & ClassDir & "'")
            If Not (trs.BOF And trs.EOF) Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>目标菜单的子菜单中已经存在与此菜单目录相同的菜单。"
            End If
            Set trs = Nothing
        End If
    End If

    If FoundErr = True Then
        Exit Sub
    End If
    ClassCount = UBound(Split(arrChildID, ",")) + 1    '得到要移动的菜单数
    CurrentDir = HtmlDir & ParentDir & ClassDir '得到当前目录
    
    '需要更新其原来所属菜单信息，包括深度、父级ID、菜单数、排序等数据
    '需要更新当前所属菜单信息
    Dim mrs, MaxRootID
    Set mrs = Conn.Execute("select max(rootid) from t_area where ChannelID=" & tChannelID & "")
    MaxRootID = mrs(0)
    Set mrs = Nothing
    If IsNull(MaxRootID) Then
        MaxRootID = 0
    End If

    '更新原来同一父菜单的上一个菜单的NextID和下一个菜单的PrevID
    If PrevID > 0 Then
        Conn.Execute "update t_area set NextID=" & NextID & " where t_classid=" & PrevID
    End If
    If NextID > 0 Then
        Conn.Execute "update t_area set PrevID=" & PrevID & " where t_classid=" & NextID
    End If

    If ParentID = 0 And rParentID = 0 Then  '如果原来是一级分类跨频道移到另一频道一级分类
        '得到上一个一级分类菜单
        sql = "Select t_classid,NextID from t_area where ChannelID=" & tChannelID & " and RootID=" & MaxRootID & " and Depth=0"
        Set rs = Server.CreateObject("Adodb.recordset")
        rs.Open sql, Conn, 1, 3
        If rs.BOF And rs.EOF Then
            PrevID = 0
        Else
            PrevID = rs(0)    '得到新的PrevID
            rs(1) = ClassID   '更新上一个一级分类菜单的NextID的值
            rs.Update
        End If
        rs.Close
        Set rs = Nothing

        MaxRootID = MaxRootID + 1

        '更新当前菜单数据
        Conn.Execute ("update t_area set ChannelID=" & tChannelID & ",rootid=" & MaxRootID & ",PrevID=" & PrevID & ",NextID=0 where t_classid=" & ClassID)
        
        '如果有下属菜单，则更新其下属菜单数据。下属菜单的排序不需考虑，只需更新下属菜单深度和一级排序ID(rootid)数据
        If Child > 0 Then
            Conn.Execute ("update t_area set ChannelID=" & tChannelID & ",rootid=" & MaxRootID & " where t_classid in (" & arrChildID & ")")
        End If

    ElseIf ParentID > 0 And rParentID = 0 Then  '如果原来不是一级分类改成一级分类

        '更新其原来所属菜单的菜单数，排序相当于剪枝而不需考虑
        Conn.Execute ("update t_area set child=child-1 where t_classid=" & ParentID)

        '更新此菜单的原来所有上级菜单的子菜单ID数组
        Set trs = Conn.Execute("Select t_classid,arrChildID from t_area where t_classid in (" & ParentPath & ")")
        Do While Not trs.EOF
            Conn.Execute ("update t_area set arrChildID='" & RemoveClassID(trs(1), arrChildID) & "' where t_classid=" & trs(0))
            trs.MoveNext
        Loop
        trs.Close

        '得到上一个一级分类菜单
        sql = "Select t_classid,NextID from t_area where ChannelID=" & tChannelID & " and RootID=" & MaxRootID & " and Depth=0"
        Set rs = Server.CreateObject("Adodb.recordset")
        rs.Open sql, Conn, 1, 3
        If rs.BOF And rs.EOF Then
            PrevID = 0
        Else
            PrevID = rs(0)    '得到新的PrevID
            rs(1) = ClassID   '更新上一个一级分类菜单的NextID的值
            rs.Update
        End If
        rs.Close
        Set rs = Nothing

        MaxRootID = MaxRootID + 1

        tParentDir = "/"
        '更新当前菜单数据
        Conn.Execute ("update t_area set ChannelID=" & tChannelID & ",depth=0,OrderID=0,rootid=" & MaxRootID & ",parentid=0,ParentPath='0',PrevID=" & PrevID & ",NextID=0,ParentDir='" & tParentDir & "' where t_classid=" & ClassID)

        '如果有下属菜单，则更新其下属菜单数据。下属菜单的排序不需考虑，只需更新下属菜单深度和一级排序ID(rootid)数据
        If Child > 0 Then
            ParentPath = ParentPath & ","
            arrChildID = RemoveClassID(arrChildID, ClassID) '从子菜单数组中去掉当前菜单的ID
            Set rs = Conn.Execute("select * from t_area where t_classid in (" & arrChildID & ")")
            Do While Not rs.EOF
                iParentPath = Replace(rs("ParentPath"), ParentPath, "")
                cParentDir = tParentDir & Right(rs("ParentDir"), Len(rs("ParentDir")) - Len(ParentDir))
                Conn.Execute ("update t_area set ChannelID=" & tChannelID & ",depth=depth-" & Depth & ",rootid=" & MaxRootID & ",ParentPath='0," & iParentPath & "',ParentDir='" & cParentDir & "' where t_classid=" & rs("t_ClassID"))
                rs.MoveNext
            Loop
            rs.Close
            Set rs = Nothing
        End If
        
    ElseIf ParentID > 0 And rParentID > 0 Then '如果是将一个分菜单移动到其他分菜单下

        '更新其原父类的子菜单数
        Conn.Execute ("update t_area set child=child-1 where t_classid=" & ParentID)

        '更新此菜单的原来所有上级菜单的子菜单ID数组
        Set trs = Conn.Execute("Select t_classid,arrChildID from t_area where t_classid in (" & ParentPath & ")")
        Do While Not trs.EOF
            Conn.Execute ("update t_area set arrChildID='" & RemoveClassID(trs(1), arrChildID) & "' where t_classid=" & trs(0))
            trs.MoveNext
        Loop
        trs.Close

        '获得目标菜单的相关信息
        Set trs = Conn.Execute("select * from t_area where t_classid=" & rParentID)
        tParentDir = trs("ParentDir") & trs("ClassDir") & "/"

        If trs("Child") > 0 Then
            '得到在目标菜单中与本菜单同级的最后一个菜单的ClassID，并更新其NextID的指向
            Set rs = Conn.Execute("Select t_classid from t_area where ParentID=" & trs("t_ClassID") & " order by OrderID desc")
            PrevID = rs(0)  '得到新的PrevID
            Conn.Execute ("update t_area set NextID=" & ClassID & " where t_classid=" & rs(0) & "")
            Set rs = Nothing

            '得到目标菜单的子菜单的最大OrderID
            Set rsPrevOrderID = Conn.Execute("select Max(OrderID) from t_area where t_classid in (" & trs("arrChildID") & ")")
            PrevOrderID = rsPrevOrderID(0)
            Set rsPrevOrderID = Nothing
        Else
            PrevID = 0
            PrevOrderID = trs("OrderID")
        End If

        '更新目标菜单的子菜单数
        Conn.Execute ("update t_area set child=child+1 where t_classid=" & rParentID)

        '更新目标菜单及目标菜单的所有上级菜单的子菜单ID数组
        Set rs = Conn.Execute("Select t_classid,arrChildID from t_area where t_classid in (" & trs("ParentPath") & "," & trs("t_ClassID") & ")")
        Do While Not rs.EOF
            Conn.Execute ("update t_area set arrChildID='" & rs(1) & "," & arrChildID & "' where t_classid=" & rs(0))
            rs.MoveNext
        Loop
        rs.Close


        '在获得移动过来的菜单数后更新排序在指定菜单之后的菜单排序数据
        Conn.Execute ("update t_area set OrderID=OrderID+" & ClassCount & "+1 where ChannelID=" & tChannelID & " and rootid=" & trs("rootid") & " and OrderID>" & PrevOrderID)
        
        '更新当前菜单数据
        Conn.Execute ("update t_area set ChannelID=" & tChannelID & ",depth=" & trs("depth") & "+1,OrderID=" & PrevOrderID & "+1,rootid=" & trs("rootid") & ",ParentID=" & rParentID & ",ParentPath='" & trs("ParentPath") & "," & trs("t_ClassID") & "',PrevID=" & PrevID & ",NextID=0,ParentDir='" & tParentDir & "' where t_classid=" & ClassID)

        '如果当前菜单有子菜单则更新子菜单数据，深度为原来的相对深度加上当前所属菜单的深度
        If Child > 0 Then
            i = 1
            arrChildID = RemoveClassID(arrChildID, ClassID) '从子菜单数组中去掉当前菜单的ID
            ParentPath = ParentPath & ","
            Set rs = Conn.Execute("select * from t_area where t_classid in (" & arrChildID & ") order by OrderID")
            Do While Not rs.EOF
                i = i + 1
                iParentPath = trs("ParentPath") & "," & trs("t_ClassID") & "," & Replace(rs("ParentPath"), ParentPath, "")
                cParentDir = tParentDir & Right(rs("ParentDir"), Len(rs("ParentDir")) - Len(ParentDir))
                Conn.Execute ("update t_area set ChannelID=" & tChannelID & ",depth=depth-" & Depth & "+" & trs("depth") & "+1,OrderID=" & PrevOrderID & "+" & i & ",rootid=" & trs("rootid") & ",ParentPath='" & iParentPath & "',ParentDir='" & cParentDir & "' where t_classid=" & rs("t_ClassID"))
                rs.MoveNext
            Loop
            rs.Close
        End If
        Set rs = Nothing
        trs.Close
        Set trs = Nothing
        
        
    Else    '如果原来是一级菜单改成其他菜单的下属菜单
        '获得目标菜单的相关信息
        Set trs = Conn.Execute("select * from t_area where t_classid=" & rParentID)
        tParentDir = trs("ParentDir") & trs("ClassDir") & "/"

        If trs("Child") > 0 Then
            '得到在目标菜单中与本菜单同级的最后一个菜单的ClassID，并更新其NextID的指向
            Set rs = Conn.Execute("Select t_classid from t_area where ParentID=" & trs("t_ClassID") & " order by OrderID desc")
            PrevID = rs(0)  '得到新的PrevID
            Conn.Execute ("update t_area set NextID=" & ClassID & " where t_classid=" & rs(0) & "")
            Set rs = Nothing

            '得到目标菜单的子菜单的最大OrderID
            Set rsPrevOrderID = Conn.Execute("select Max(OrderID) from t_area where t_classid in (" & trs("arrChildID") & ")")
            PrevOrderID = rsPrevOrderID(0)
            Set rsPrevOrderID = Nothing
        Else
            PrevID = 0
            PrevOrderID = trs("OrderID")
        End If

        '更新目标菜单的子菜单数
        Conn.Execute ("update t_area set child=child+1 where t_classid=" & rParentID)

        '更新目标菜单及目标菜单的所有上级菜单的子菜单ID数组
        Set rs = Conn.Execute("Select t_classid,arrChildID from t_area where t_classid in (" & trs("ParentPath") & "," & trs("t_ClassID") & ")")
        Do While Not rs.EOF
            Conn.Execute ("update t_area set arrChildID='" & rs(1) & "," & arrChildID & "' where t_classid=" & rs(0))
            rs.MoveNext
        Loop
        rs.Close
    
        '在获得移动过来的菜单数后更新排序在指定菜单之后的菜单排序数据
        Conn.Execute ("update t_area set OrderID=OrderID+" & ClassCount & "+1 where ChannelID=" & tChannelID & " and rootid=" & trs("rootid") & " and OrderID>" & PrevOrderID)
        
        '更新当前菜单数据
        Conn.Execute ("update t_area set ChannelID=" & tChannelID & ",depth=depth+" & trs("depth") & "+1,OrderID=" & PrevOrderID + 1 & ",rootid=" & trs("rootid") & ",ParentPath='" & trs("ParentPath") & "," & trs("t_ClassID") & "',parentid=" & rParentID & ", PrevID=" & PrevID & ",NextID=0,ParentDir='" & tParentDir & "' where t_classid=" & ClassID & "")

        '如果当前菜单有子菜单则更新子菜单数据，深度为原来的相对深度加上当前所属菜单的深度
        Set rs = Conn.Execute("select * from t_area where ChannelID=" & ChannelID & " and rootid=" & RootID & " and ParentID>0 order by OrderID")
        i = 1
        Do While Not rs.EOF
            i = i + 1
            iParentPath = trs("ParentPath") & "," & trs("t_ClassID") & "," & Replace(rs("ParentPath"), "0,", "")
            cParentDir = tParentDir & Right(rs("ParentDir"), Len(rs("ParentDir")) - Len(ParentDir))
            Conn.Execute ("update t_area set ChannelID=" & tChannelID & ",depth=depth+" & trs("depth") & "+1,OrderID=" & PrevOrderID & "+" & i & ",rootid=" & trs("rootid") & ",ParentPath='" & iParentPath & "',ParentDir='" & cParentDir & "' where t_classid=" & rs("t_ClassID"))
            rs.MoveNext
        Loop
        rs.Close
        Set rs = Nothing
        trs.Close
        Set trs = Nothing
    End If

    Call CloseConn
    Response.Redirect "Admin_area.asp?ChannelID=" & ChannelID
End Sub

Sub MoveUpFilesToOtherChannel(tChannelID, tClassID)
    Dim rsBatchMove, sqlBatchMove, ArticlePath
    Dim rsChannel, tChannelDir, tUploadDir
    Set rsChannel = Conn.Execute("select ChannelDir,UploadDir from Channel where ChannelID=" & tChannelID & "")
    If rsChannel.BOF And rsChannel.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到目标频道！</li>"
    Else
        tChannelDir = rsChannel("ChannelDir")
        tUploadDir = rsChannel("UploadDir")
    End If
    Set rsChannel = Nothing
    If FoundErr = True Then Exit Sub
    Select Case ModuleType
    Case 1
        sqlBatchMove = "select UploadFiles from Article where t_classid in (" & tClassID & ")"
    Case 2
        sqlBatchMove = "select SoftPicUrl,DownloadUrl from Soft where t_classid in (" & tClassID & ")"
    Case 3
        sqlBatchMove = "select PhotoThumb,PhotoUrl from Photo where t_classid in (" & tClassID & ")"
    End Select
    Set rsBatchMove = Conn.Execute(sqlBatchMove)
    Do While Not rsBatchMove.EOF
        Select Case ModuleType
        Case 1
            Call MoveUpFiles(rsBatchMove("UploadFiles") & "", tChannelDir & "/" & tUploadDir)    '移动上传文件
        Case 2
            Call MoveUpPic(rsBatchMove("SoftPicUrl"), tChannelDir)
            Call MoveSoftUpFiles(rsBatchMove("DownloadUrl"), tChannelDir & "/" & tUploadDir)    '移动上传文件
        Case 3
            Call MovePhotoUpFiles("缩略图|" & rsBatchMove("PhotoThumb") & "$$$" & rsBatchMove("PhotoUrl"), tChannelDir & "/" & tUploadDir)    '移动上传文件
        End Select
        rsBatchMove.MoveNext
    Loop
    rsBatchMove.Close
    Set rsBatchMove = Nothing
End Sub


Sub MoveUpFiles(strFiles, strTargetDir)
    On Error Resume Next
    Dim strTrueFile, arrFiles, strTrueDir, i
    If IsNull(strFiles) Or strFiles = "" Or strTargetDir = "" Then Exit Sub
    
    If Not fso.FolderExists(Server.MapPath(InstallDir & strTargetDir)) Then fso.CreateFolder Server.MapPath(InstallDir & strTargetDir)
    arrFiles = Split(strFiles, "|")
    For i = 0 To UBound(arrFiles)
        strTrueDir = Server.MapPath(InstallDir & strTargetDir & "/" & Left(arrFiles(i), InStr(arrFiles(i), "/")))
        If Not fso.FolderExists(strTrueDir) Then fso.CreateFolder strTrueDir
        strTrueFile = Server.MapPath(InstallDir & ChannelDir & "/" & UploadDir & "/" & arrFiles(i))
        If fso.FileExists(strTrueFile) Then
            fso.MoveFile strTrueFile, Server.MapPath(InstallDir & strTargetDir & "/" & arrFiles(i))
        End If
    Next
End Sub

Sub MoveSoftUpFiles(strFiles, strTargetDir)
    On Error Resume Next
    Dim arrSoftUrls, strTrueFile, arrUrls, strTrueDir, iTemp
    If strFiles = "" Or strTargetDir = "" Then Exit Sub
    
    If Not fso.FolderExists(Server.MapPath(InstallDir & strTargetDir)) Then fso.CreateFolder Server.MapPath(InstallDir & strTargetDir)
    
    arrSoftUrls = Split(strFiles, "$$$")
    For iTemp = 0 To UBound(arrSoftUrls)
        arrUrls = Split(arrSoftUrls(iTemp), "|")
        If UBound(arrUrls) = 1 Then
            If Left(arrUrls(1), 1) <> "/" And InStr(arrUrls(1), "://") <= 0 Then
                strTrueDir = Server.MapPath(InstallDir & strTargetDir & "/" & Left(arrUrls(1), InStr(arrUrls(1), "/")))
                If Not fso.FolderExists(strTrueDir) Then fso.CreateFolder strTrueDir
                strTrueFile = Server.MapPath(InstallDir & ChannelDir & "/" & UploadDir & "/" & arrUrls(1))
                If fso.FileExists(strTrueFile) Then
                    fso.MoveFile strTrueFile, Server.MapPath(InstallDir & strTargetDir & "/" & arrUrls(1))
                End If
            End If
        End If
    Next
    
End Sub

Sub MoveUpPic(strFile, strTargetDir)
    On Error Resume Next
    Dim strTrueFile, strTrueDir
    If strFile = "" Or strTargetDir = "" Then Exit Sub
    
    If Not fso.FolderExists(Server.MapPath(InstallDir & strTargetDir)) Then fso.CreateFolder Server.MapPath(InstallDir & strTargetDir)
    
    If Left(strFile, 1) <> "/" And InStr(strFile, "://") <= 0 Then
        strTrueDir = Server.MapPath(InstallDir & strTargetDir & "/" & Left(strFile, InStrRev(strFile, "/")))
        If Not fso.FolderExists(strTrueDir) Then fso.CreateFolder strTrueDir
        strTrueFile = Server.MapPath(InstallDir & ChannelDir & "/" & strFile)
        If fso.FileExists(strTrueFile) Then
            fso.MoveFile strTrueFile, Server.MapPath(InstallDir & strTargetDir & "/" & strFile)
        End If
    End If
End Sub

Sub MovePhotoUpFiles(strFiles, strTargetDir)
    On Error Resume Next
    Dim arrPhotoUrls, strTrueFile, arrUrls, strTrueDir, iTemp
    If strFiles = "" Or strTargetDir = "" Then Exit Sub
    
    If Not fso.FolderExists(Server.MapPath(InstallDir & strTargetDir)) Then fso.CreateFolder Server.MapPath(InstallDir & strTargetDir)
    
    arrPhotoUrls = Split(strFiles, "$$$")
    For iTemp = 0 To UBound(arrPhotoUrls)
        arrUrls = Split(arrPhotoUrls(iTemp), "|")
        If UBound(arrUrls) = 1 Then
            If Left(arrUrls(1), 1) <> "/" And InStr(arrUrls(1), "://") <= 0 Then
                strTrueDir = Server.MapPath(InstallDir & strTargetDir & "/" & Left(arrUrls(1), InStr(arrUrls(1), "/")))
                If Not fso.FolderExists(strTrueDir) Then fso.CreateFolder strTrueDir
                strTrueFile = Server.MapPath(InstallDir & ChannelDir & "/" & UploadDir & "/" & arrUrls(1))
                If fso.FileExists(strTrueFile) Then
                    fso.MoveFile strTrueFile, Server.MapPath(InstallDir & strTargetDir & "/" & arrUrls(1))
                End If
            End If
        End If
    Next
    
End Sub

Sub UpOrder()
    Dim ClassID, sqlOrder, rsOrder, MoveNum, cRootID, i, rs, PrevID, NextID
    ClassID = Trim(Request("ClassID"))
    cRootID = Trim(Request("cRootID"))
    MoveNum = Trim(Request("MoveNum"))
    If ClassID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>参数不足！</li>"
    Else
        ClassID = CLng(classid)
    End If
    If cRootID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>错误参数！</li>"
    Else
        cRootID = CLng(cRootID)
    End If
    If MoveNum = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>错误参数！</li>"
    Else
        MoveNum = CLng(MoveNum)
        If MoveNum = 0 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>请选择要提升的数字！</li>"
        End If
    End If
    If FoundErr = True Then
        Exit Sub
    End If

    Dim mrs, MaxRootID, tRootID, tClassID, tOrderID, tPrevID
    
    '得到本菜单的PrevID,NextID
    Set rs = Conn.Execute("select PrevID,NextID from t_area where t_classid=" & ClassID)
    PrevID = rs(0)
    NextID = rs(1)
    rs.Close
    Set rs = Nothing
    '先修改上一菜单的NextID和下一菜单的PrevID
    If PrevID > 0 Then
        Conn.Execute "update t_area set NextID=" & NextID & " where t_classid=" & PrevID
    End If
    If NextID > 0 Then
        Conn.Execute "update t_area set PrevID=" & PrevID & " where t_classid=" & NextID
    End If

    '得到本频道最大RootID值
    Set mrs = Conn.Execute("select max(rootid) from t_area where ChannelID=" & ChannelID & "")
    MaxRootID = mrs(0) + 1
    '先将当前菜单移至最后，包括子菜单
    Conn.Execute ("update t_area set RootID=" & MaxRootID & " where ChannelID=" & ChannelID & " and RootID=" & cRootID)
    
    '然后将位于当前菜单以上的菜单的RootID依次加一，范围为要提升的数字
    sqlOrder = "select * from t_area where ChannelID=" & ChannelID & " and ParentID=0 and RootID<" & cRootID & " order by RootID desc"
    Set rsOrder = Server.CreateObject("adodb.recordset")
    rsOrder.Open sqlOrder, Conn, 1, 3
    If rsOrder.BOF And rsOrder.EOF Then
        Exit Sub        '如果当前菜单已经在最上面，则无需移动
    End If
    i = 1
    Do While Not rsOrder.EOF
        tRootID = rsOrder("RootID")     '得到要提升位置的RootID，包括子菜单
        Conn.Execute ("update t_area set RootID=RootID+1 where ChannelID=" & ChannelID & " and RootID=" & tRootID)
        i = i + 1
        If i > MoveNum Then
            tClassID = rsOrder("t_ClassID")
            tPrevID = rsOrder("PrevID")
            Exit Do
        End If
        rsOrder.MoveNext
    Loop
    rsOrder.Close
    Set rsOrder = Nothing
        
    '更新移动后本菜单的的PrevID和NextID，以及上一菜单的NextID和下一菜单的PrevID
    Conn.Execute ("update t_area set PrevID=" & tPrevID & " where t_classid=" & ClassID)
    Conn.Execute ("update t_area set NextID=" & tClassID & " where t_classid=" & ClassID)
    Conn.Execute ("update t_area set PrevID=" & ClassID & " where t_classid=" & tClassID)
    If tPrevID > 0 Then
        Conn.Execute ("update t_area set NextID=" & ClassID & " where t_classid=" & tPrevID)
    End If
    
    '然后再将当前菜单从最后移到相应位置，包括子菜单
    Conn.Execute ("update t_area set RootID=" & tRootID & " where ChannelID=" & ChannelID & " and RootID=" & MaxRootID)
    Call CloseConn
    Response.Redirect "Admin_area.asp?ChannelID=" & ChannelID & "&Action=Order"
End Sub

Sub DownOrder()
    Dim ClassID, sqlOrder, rsOrder, MoveNum, cRootID, i, rs, PrevID, NextID
    ClassID = Trim(Request("ClassID"))
    cRootID = Trim(Request("cRootID"))
    MoveNum = Trim(Request("MoveNum"))
    If ClassID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>参数不足！</li>"
    Else
        ClassID = CLng(classid)
    End If
    If cRootID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>错误参数！</li>"
    Else
        cRootID = CLng(cRootID)
    End If
    If MoveNum = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>错误参数！</li>"
    Else
        MoveNum = CLng(MoveNum)
        If MoveNum = 0 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>请选择要提升的数字！</li>"
        End If
    End If
    If FoundErr = True Then
        Exit Sub
    End If

    Dim mrs, MaxRootID, tRootID, tClassID, tOrderID, tNextID
    
    '得到本菜单的PrevID,NextID
    Set rs = Conn.Execute("select PrevID,NextID from t_area where t_classid=" & ClassID)
    PrevID = rs(0)
    NextID = rs(1)
    rs.Close
    Set rs = Nothing
    '先修改上一菜单的NextID和下一菜单的PrevID
    If PrevID > 0 Then
        Conn.Execute "update t_area set NextID=" & NextID & " where t_classid=" & PrevID
    End If
    If NextID > 0 Then
        Conn.Execute "update t_area set PrevID=" & PrevID & " where t_classid=" & NextID
    End If

    '得到本频道最大RootID值
    Set mrs = Conn.Execute("select max(rootid) from t_area where ChannelID=" & ChannelID & "")
    MaxRootID = mrs(0) + 1
    '先将当前菜单移至最后，包括子菜单
    Conn.Execute ("update t_area set RootID=" & MaxRootID & " where ChannelID=" & ChannelID & " and RootID=" & cRootID)
    
    '然后将位于当前菜单以下的菜单的RootID依次减一，范围为要下降的数字
    sqlOrder = "select * from t_area where ChannelID=" & ChannelID & " and ParentID=0 and RootID>" & cRootID & " order by RootID"
    Set rsOrder = Server.CreateObject("adodb.recordset")
    rsOrder.Open sqlOrder, Conn, 1, 3
    If rsOrder.BOF And rsOrder.EOF Then
        Exit Sub        '如果当前菜单已经在最下面，则无需移动
    End If
    i = 1
    Do While Not rsOrder.EOF
        tRootID = rsOrder("RootID")     '得到要提升位置的RootID，包括子菜单
        Conn.Execute ("update t_area set RootID=RootID-1 where ChannelID=" & ChannelID & " and RootID=" & tRootID)
        i = i + 1
        If i > MoveNum Then
            tClassID = rsOrder("t_ClassID")
            tNextID = rsOrder("NextID")
            Exit Do
        End If
        rsOrder.MoveNext
    Loop
    rsOrder.Close
    Set rsOrder = Nothing
    
    '更新移动后本菜单的的PrevID和NextID，以及上一菜单的NextID和下一菜单的PrevID
    Conn.Execute ("update t_area set PrevID=" & tClassID & " where t_classid=" & ClassID)
    Conn.Execute ("update t_area set NextID=" & tNextID & " where t_classid=" & ClassID)
    Conn.Execute ("update t_area set NextID=" & ClassID & " where t_classid=" & tClassID)
    If tNextID > 0 Then
        Conn.Execute ("update t_area set PrevID=" & ClassID & " where t_classid=" & tNextID)
    End If
    
    '然后再将当前菜单从最后移到相应位置，包括子菜单
    Conn.Execute ("update t_area set RootID=" & tRootID & " where ChannelID=" & ChannelID & " and RootID=" & MaxRootID)
    
    Call CloseConn
    Response.Redirect "Admin_area.asp?ChannelID=" & ChannelID & "&Action=Order"
End Sub

Sub UpOrderN()
    Dim sqlOrder, rsOrder, MoveNum, ClassID, i
    Dim ParentID, OrderID, ParentPath, Child, PrevID, NextID
    ClassID = Trim(Request("ClassID"))
    MoveNum = Trim(Request("MoveNum"))
    If ClassID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>错误参数！</li>"
    Else
        ClassID = CLng(classid)
    End If
    If MoveNum = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>错误参数！</li>"
    Else
        MoveNum = CLng(MoveNum)
        If MoveNum = 0 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>请选择要提升的数字！</li>"
        End If
    End If
    If FoundErr = True Then
        Exit Sub
    End If

    Dim sql, rs, trs, AddOrderNum, tClassID, tOrderID, tPrevID
    
    '要移动的菜单信息
    Set rs = Conn.Execute("select ParentID,OrderID,ParentPath,Child,PrevID,NextID from t_area where t_classid=" & ClassID)
    ParentID = rs(0)
    OrderID = rs(1)
    ParentPath = rs(2) & "," & ClassID
    Child = rs(3)
    PrevID = rs(4)
    NextID = rs(5)
    rs.Close
    Set rs = Nothing
    
    '获得要移动的菜单的所有子菜单数，然后加1（菜单本身），得到排序增加数（即其上菜单的OrderID增加数AddOrderNum）
    If Child > 0 Then
        Set rs = Conn.Execute("select count(*) from t_area where ParentPath like '%" & ParentPath & "%'")
        AddOrderNum = CLng(rs(0)) + 1
        rs.Close
        Set rs = Nothing
    Else
        AddOrderNum = 1
    End If
    
    '先修改上一菜单的NextID和下一菜单的PrevID
    If PrevID > 0 Then
        Conn.Execute "update t_area set NextID=" & NextID & " where t_classid=" & PrevID
    End If
    If NextID > 0 Then
        Conn.Execute "update t_area set PrevID=" & PrevID & " where t_classid=" & NextID
    End If
    
    '和该菜单同级且排序在其之上的菜单------更新其排序，范围为要提升的数字AddOrderNum
    sql = "Select t_classid,OrderID,Child,ParentPath,PrevID,NextID from t_area where ParentID=" & ParentID & " and OrderID<" & OrderID & " order by OrderID desc"
    Set rs = Server.CreateObject("adodb.recordset")
    rs.Open sql, Conn, 1, 3
    i = 0
    Do While Not rs.EOF
        tOrderID = rs(1)
        Conn.Execute ("update t_area set OrderID=OrderID+" & AddOrderNum & " where t_classid=" & rs(0))
        If rs(2) > 0 Then
            Set trs = Conn.Execute("Select t_classid,OrderID from t_area where ParentPath like '%" & rs(3) & "," & rs(0) & "%' order by OrderID")
            If Not (trs.BOF And trs.EOF) Then
                Do While Not trs.EOF
                    Conn.Execute ("update t_area set OrderID=OrderID+" & AddOrderNum & " where t_classid=" & trs(0))
                    trs.MoveNext
                Loop
            End If
            trs.Close
            Set trs = Nothing
        End If
        i = i + 1
        If i >= MoveNum Then
            '获得最后一个提升序号的同级菜单信息
            tClassID = rs(0)
            tPrevID = rs(4)
            Exit Do
        End If
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    
    '更新移动后本菜单的的PrevID和NextID，以及上一菜单的NextID和下一菜单的PrevID
    Conn.Execute ("update t_area set PrevID=" & tPrevID & " where t_classid=" & ClassID)
    Conn.Execute ("update t_area set NextID=" & tClassID & " where t_classid=" & ClassID)
    Conn.Execute ("update t_area set PrevID=" & ClassID & " where t_classid=" & tClassID)
    If tPrevID > 0 Then
        Conn.Execute ("update t_area set NextID=" & ClassID & " where t_classid=" & tPrevID)
    End If
        
    '更新所要排序的菜单的序号
    Conn.Execute ("update t_area set OrderID=" & tOrderID & " where t_classid=" & ClassID)
    '如果有下属菜单，则更新其下属菜单排序
    If Child > 0 Then
        i = 1
        Set rs = Conn.Execute("Select t_classid from t_area where ParentPath like '%" & ParentPath & "%' order by OrderID")
        Do While Not rs.EOF
            Conn.Execute ("update t_area set OrderID=" & tOrderID + i & " where t_classid=" & rs(0))
            i = i + 1
            rs.MoveNext
        Loop
        rs.Close
        Set rs = Nothing
    End If
    
    
    Call CloseConn
    Response.Redirect "Admin_area.asp?ChannelID=" & ChannelID & "&Action=OrderN"
End Sub

Sub DownOrderN()
    Dim sqlOrder, rsOrder, MoveNum, ClassID, i
    Dim ParentID, OrderID, ParentPath, Child, PrevID, NextID
    ClassID = Trim(Request("ClassID"))
    MoveNum = Trim(Request("MoveNum"))
    If ClassID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>错误参数！</li>"
        Exit Sub
    Else
        ClassID = CLng(classid)
    End If
    If MoveNum = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>错误参数！</li>"
        Exit Sub
    Else
        MoveNum = CLng(MoveNum)
        If MoveNum = 0 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>请选择要下降的数字！</li>"
            Exit Sub
        End If
    End If

    Dim sql, rs, trs, ii, tClassID, tNextID
    
    '要移动的菜单信息
    Set rs = Conn.Execute("select ParentID,OrderID,ParentPath,child,PrevID,NextID from t_area where t_classid=" & ClassID)
    ParentID = rs(0)
    OrderID = rs(1)
    ParentPath = rs(2) & "," & ClassID
    Child = rs(3)
    PrevID = rs(4)
    NextID = rs(5)
    rs.Close
    Set rs = Nothing

    '先修改上一菜单的NextID和下一菜单的PrevID
    If PrevID > 0 Then
        Conn.Execute "update t_area set NextID=" & NextID & " where t_classid=" & PrevID
    End If
    If NextID > 0 Then
        Conn.Execute "update t_area set PrevID=" & PrevID & " where t_classid=" & NextID
    End If
    
    '和该菜单同级且排序在其之下的菜单------更新其排序，范围为要下降的数字
    sql = "Select t_classid,OrderID,child,ParentPath,PrevID,NextID from t_area where ParentID=" & ParentID & " and OrderID>" & OrderID & " order by OrderID"
    Set rs = Server.CreateObject("adodb.recordset")
    rs.Open sql, Conn, 1, 3
    i = 0    '同级菜单
    ii = 0   '同级菜单和子菜单
    Do While Not rs.EOF
        Conn.Execute ("update t_area set OrderID=" & OrderID + ii & " where t_classid=" & rs(0))
        If rs(2) > 0 Then
            Set trs = Conn.Execute("Select t_classid,OrderID from t_area where ParentPath like '%" & rs(3) & "," & rs(0) & "%' order by OrderID")
            If Not (trs.BOF And trs.EOF) Then
                Do While Not trs.EOF
                    ii = ii + 1
                    Conn.Execute ("update t_area set OrderID=" & OrderID + ii & " where t_classid=" & trs(0))
                    trs.MoveNext
                Loop
            End If
            trs.Close
            Set trs = Nothing
        End If
        ii = ii + 1
        i = i + 1
        If i >= MoveNum Then
            '获得移动后本菜单的上一菜单的信息
            tClassID = rs(0)
            tNextID = rs(5)
            Exit Do
        End If
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
            
    '更新移动后本菜单的的PrevID和NextID，以及上一菜单的NextID和下一菜单的PrevID
    Conn.Execute ("update t_area set PrevID=" & tClassID & " where t_classid=" & ClassID)
    Conn.Execute ("update t_area set NextID=" & tNextID & " where t_classid=" & ClassID)
    Conn.Execute ("update t_area set NextID=" & ClassID & " where t_classid=" & tClassID)
    If tNextID > 0 Then
        Conn.Execute ("update t_area set PrevID=" & ClassID & " where t_classid=" & tNextID)
    End If
    
    '更新所要排序的菜单的序号
    Conn.Execute ("update t_area set OrderID=" & OrderID + ii & " where t_classid=" & ClassID)
    '如果有下属菜单，则更新其下属菜单排序
    If Child > 0 Then
        i = 1
        Set rs = Conn.Execute("Select t_classid from t_area where ParentPath like '%" & ParentPath & "%' order by OrderID")
        Do While Not rs.EOF
            Conn.Execute ("update t_area set OrderID=" & OrderID + ii + i & " where t_classid=" & rs(0))
            i = i + 1
            rs.MoveNext
        Loop
        rs.Close
        Set rs = Nothing
    End If
    
    
    Call CloseConn
    Response.Redirect "Admin_area.asp?ChannelID=" & ChannelID & "&Action=OrderN"
End Sub

Sub SaveReset()
    Dim i, sql, rsClass, SuccessMsg, iCount, PrevID, NextID, ClassDir, trs
    sql = "Select t_classid,ParentID,ClassType,ParentDir,ClassDir from t_area where ChannelID=" & ChannelID & " order by RootID,OrderID"
    Set rsClass = Server.CreateObject("adodb.recordset")
    rsClass.Open sql, Conn, 1, 1
    iCount = rsClass.RecordCount
    i = 1
    PrevID = 0
    Do While Not rsClass.EOF
        rsClass.MoveNext
        If rsClass.EOF Then
            NextID = 0
        Else
            NextID = rsClass(0)
        End If
        rsClass.moveprevious
        Set trs = Conn.Execute("select Count(t_classid) from t_area where ChannelID=" & ChannelID & " and ParentID=0 and t_ClassID<>" & rsClass(0) & " and ClassDir='" & rsClass(4) & "'")
        If trs(0) > 1 Then
            ClassDir = rsClass(4) & rsClass(0)
        Else
            ClassDir = rsClass(4)
        End If
        Set trs = Nothing
        Conn.Execute ("update t_area set RootID=" & i & ",OrderID=0,ParentID=0,Child=0,ParentPath='0',Depth=0,PrevID=" & PrevID & ",NextID=" & NextID & ",arrChildID='" & rsClass(0) & "',ParentDir='/',ClassDir='" & ClassDir & "' where t_classid=" & rsClass(0))
        PrevID = rsClass(0)
        i = i + 1
        rsClass.MoveNext
    Loop
    rsClass.Close
    Set rsClass = Nothing
    If FoundErr = True Then
        Call WriteErrMsg(ErrMsg, ComeUrl)
    Else
        SuccessMsg = "复位成功！请返回<a href='Admin_area.asp'>菜单管理首页</a>做菜单的归属设置。"
        Call WriteSuccessMsg(SuccessMsg, ComeUrl)
    End If
    
End Sub

Sub ResetChildClass()
    Dim ClassID, RootID, ParentPath, ParentDir, ClassDir
    Dim sql, rsClass, SuccessMsg, iCount, PrevID, NextID, i, trs
    ClassID = Trim(Request("ClassID"))
    If ClassID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>参数不足！</li>"
        Exit Sub
    Else
        ClassID = CLng(classid)
    End If
    Set rsClass = Conn.Execute("Select t_classid,RootID,ClassDir from t_area where ChannelID=" & ChannelID & " and ParentID=0 and t_ClassID=" & ClassID)
    If rsClass.BOF And rsClass.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到指定的菜单！</li>"
    Else
        RootID = rsClass(1)
        ParentPath = "0," & rsClass(0)
        ParentDir = "/" & rsClass(2) & "/"
    End If
    Set rsClass = Nothing
    If FoundErr = True Then Exit Sub

    sql = "Select t_classid,ParentID,ClassType,ParentDir,ClassDir from t_area where ChannelID=" & ChannelID & " and RootID=" & RootID & " and ParentID>0 order by OrderID"
    Set rsClass = Server.CreateObject("adodb.recordset")
    rsClass.Open sql, Conn, 1, 1
    iCount = rsClass.RecordCount
    i = 1
    PrevID = 0
    Do While Not rsClass.EOF
        rsClass.MoveNext
        If rsClass.EOF Then
            NextID = 0
        Else
            NextID = rsClass(0)
        End If
        rsClass.moveprevious
        Set trs = Conn.Execute("select Count(t_classid) from t_area where ChannelID=" & ChannelID & " and ParentID=" & ClassID & " and t_ClassID<>" & rsClass(0) & " and ClassDir='" & rsClass(4) & "'")
        If trs(0) > 1 Then
            ClassDir = rsClass(4) & rsClass(0)
        Else
            ClassDir = rsClass(4)
        End If
        Set trs = Nothing
        Conn.Execute ("update t_area set OrderID=" & i & ",ParentID=" & ClassID & ",Child=0,ParentPath='" & ParentPath & "',Depth=1,PrevID=" & PrevID & ",NextID=" & NextID & ",arrChildID='" & rsClass(0) & "',ParentDir='" & ParentDir & "',ClassDir='" & ClassDir & "' where t_classid=" & rsClass(0))
        PrevID = rsClass(0)
        i = i + 1
        rsClass.MoveNext
    Loop
    rsClass.Close
    Set rsClass = Nothing
    Conn.Execute ("update t_area set Child=" & i - 1 & " where t_classid=" & ClassID)
    
    SuccessMsg = "复位成功！请返回<a href='Admin_area.asp'>菜单管理首页</a>做菜单的归属设置。"
    
    Call WriteSuccessMsg(SuccessMsg, ComeUrl)
End Sub

Sub SaveUnite()
    Dim ClassID, TargetClassID, ParentID, ParentPath, Depth, Child, PrevID, NextID, arrChildID
    Dim rsClass, trs, i, SuccessMsg
    ClassID = Trim(Request("ClassID"))
    TargetClassID = Trim(Request("TargetClassID"))
    If ClassID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要合并的菜单！</li>"
    Else
        ClassID = CLng(classid)
    End If
    If TargetClassID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定目标菜单！</li>"
    Else
        TargetClassID = CLng(TargetClassID)
    End If
    If ClassID = TargetClassID Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请不要在相同菜单内进行操作</li>"
    End If
    If FoundErr = True Then
        Exit Sub
    End If
    '判断目标菜单是否为外部菜单及是否有子菜单
    Set rsClass = Conn.Execute("Select t_classid,Child,ClassType from t_area where t_classid=" & TargetClassID)
    If rsClass.BOF And rsClass.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>目标菜单不存在，可能已经被删除！</li>"
    Else
        If rsClass(1) > 0 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>目标菜单中含有子菜单，不能合并！</li>"
        End If
        If rsClass(2) = 2 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>目标菜单是外部菜单，不能合并！</li>"
        End If
    End If
    Set rsClass = Nothing
    If FoundErr = True Then
        Exit Sub
    End If
    '得到当前菜单信息
    Set rsClass = Conn.Execute("Select t_classid,ParentID,ParentPath,Depth,PrevID,NextID,arrChildID,ParentDir,ClassDir,ClassType from t_area where t_classid=" & ClassID)
    If rsClass.BOF And rsClass.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到指定的菜单，可能已经被删除！</li>"
        rsClass.Close
        Set rsClass = Nothing
        Exit Sub
    End If
    ParentID = rsClass(1)
    ParentPath = rsClass(2)
    Depth = rsClass(3)
    PrevID = rsClass(4)
    NextID = rsClass(5)
    arrChildID = rsClass(6)

    '判断是否是合并到其下属菜单中
    Set trs = Conn.Execute("Select t_classid from t_area where t_classid=" & TargetClassID & " and t_ClassID in (" & arrChildID & ")")
    If Not (trs.BOF And trs.EOF) Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>不能将一个菜单合并到其下属子菜单中</li>"
    End If
    Set trs = Nothing
    
    If FoundErr = True Then
        Set rsClass = Nothing
        Exit Sub
    End If
    Set rsClass = Nothing
	
	Conn.Execute ("update t_dev_property set areaid = '" & TargetClassID & "' where areaid in (" & arrChildID & ")")

    
    '先修改上一菜单的NextID和下一菜单的PrevID
    If PrevID > 0 Then
        Conn.Execute "update t_area set NextID=" & NextID & " where t_classid=" & PrevID
    End If
    If NextID > 0 Then
        Conn.Execute "update t_area set PrevID=" & PrevID & " where t_classid=" & NextID
    End If
    
    
    '删除被合并菜单及其下属菜单
    Conn.Execute ("delete from t_area where ChannelID=" & ChannelID & " and  t_ClassID in (" & arrChildID & ")")
    
    '更新其原来所属菜单的子菜单数，排序相当于剪枝而不需考虑
    If ParentID > 0 Then
        Conn.Execute ("update t_area set Child=Child-1 where t_classid=" & ParentID)

        '更新此菜单的原来所有上级菜单的子菜单ID数组
        Set trs = Conn.Execute("Select t_classid,arrChildID from t_area where t_classid in (" & ParentPath & ")")
        Do While Not trs.EOF
            Conn.Execute ("update t_area set arrChildID='" & RemoveClassID(trs(1), arrChildID) & "' where t_classid=" & trs(0))
            trs.MoveNext
        Loop
        trs.Close
        Set trs = Nothing
    End If


    SuccessMsg = "菜单合并成功！已经将被合并菜单及其下属子菜单的所有数据转入目标菜单中。<br><br>同时删除了被合并的菜单及其子菜单。"
    Call WriteSuccessMsg(SuccessMsg, ComeUrl)
End Sub

Sub DoBatch()
    Dim ClassID, ClassPurview, arrGroupID_Browse, arrGroupID_View, arrGroupID_Input, EnableComment, CheckComment
    Dim PresentExp, DefaultItemPoint, DefaultItemChargeType, DefaultItemPitchTime, DefaultItemReadTimes, DefaultItemDividePercent
    Dim OpenType, ShowOnTop, ShowOnIndex, IsElite, EnableAdd, EnableProtect, SkinID, TemplateID
    Dim MaxPerPage, DefaultItemSkin, DefaultItemTemplate, ItemListOrderType, ItemOpenType
    Dim sql, rsClass, i
    Dim CommandClassPoint, ReleaseClassPoint
    ClassID = Trim(Request("ClassID"))

    OpenType = CLng(Trim(Request("OpenType")))
    EnableAdd = CBool(Trim(Request("EnableAdd")))

    If IsValidID(t_classid) = False Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请先选定要批量修改设置的菜单！</li>"
    Else
        ClassID = ReplaceBadChar(t_classid)
    End If
    If FoundErr = True Then
        Exit Sub
    End If

    sql = "select * from t_area where ChannelID=" & ChannelID & " and t_ClassID in (" & ClassID & ")"
    Set rsClass = Server.CreateObject("Adodb.recordset")
    rsClass.Open sql, Conn, 1, 3
    Do While Not rsClass.EOF
        If Trim(Request("ModifyOpenType")) = "Yes" Then rsClass("OpenType") = OpenType
        If Trim(Request("ModifyEnableAdd")) = "Yes" Then rsClass("EnableAdd") = EnableAdd
        rsClass.Update
        rsClass.MoveNext
    Loop
    rsClass.Close
    Set rsClass = Nothing
    
    
    Dim msg
    msg = "批量设置菜单属性成功！"
    Call WriteSuccessMsg(msg, ComeUrl)
End Sub

Function RemoveClassID(ByVal arrClassID_Parent, ByVal arrClassID_Child)
    Dim arrClassID, arrClassID2, arrClassID3, i, j, bFound
    If IsNull(arrClassID_Parent) Then
        RemoveClassID = ""
        Exit Function
    End If
    If IsNull(arrClassID_Parent) Then
        RemoveClassID = arrClassID_Parent
        Exit Function
    End If
    If Trim(arrClassID_Parent) = Trim(arrClassID_Child) Then
        RemoveClassID = ""
        Exit Function
    End If
    arrClassID = Split(arrClassID_Parent, ",")
    arrClassID3 = ""
    If InStr(arrClassID_Child, ",") > 0 Then
        arrClassID2 = Split(arrClassID_Child, ",")
        For i = 0 To UBound(arrClassID)
            bFound = False
            For j = 0 To UBound(arrClassID2)
                If CLng(arrClassID(i)) = CLng(arrClassID2(j)) Then
                    bFound = True
                    Exit For
                End If
            Next
            If bFound = False Then
                If arrClassID3 = "" Then
                    arrClassID3 = arrClassID(i)
                Else
                    arrClassID3 = arrClassID3 & "," & arrClassID(i)
                End If
            End If
        Next
    Else
        For i = 0 To UBound(arrClassID)
            If CLng(arrClassID(i)) <> CLng(arrClassID_Child) Then
                If arrClassID3 = "" Then
                    arrClassID3 = arrClassID(i)
                Else
                    arrClassID3 = arrClassID3 & "," & arrClassID(i)
                End If
            End If
        Next
    End If
    RemoveClassID = arrClassID3
End Function

Sub CreateJS_Class()
    If ObjInstalled_FSO = False Then
        Exit Sub
    End If
    
    Dim hf, strTopMenu, strClassTree, strNavigation, strOption, strForm, TopMenuType

    Select Case TopMenuType
    Case 0, 1
        strTopMenu = GetRootClass_Menu()
    Case 2
        strTopMenu = "var h,w,l,t;" & vbCrLf
        strTopMenu = strTopMenu & "var topMar = 1;" & vbCrLf
        strTopMenu = strTopMenu & "var leftMar = -2;" & vbCrLf
        strTopMenu = strTopMenu & "var space = 1;" & vbCrLf
        strTopMenu = strTopMenu & "var isvisible;" & vbCrLf
        strTopMenu = strTopMenu & "var MENU_SHADOW_COLOR='#999999';" & vbCrLf
        strTopMenu = strTopMenu & "var global = window.document" & vbCrLf
        strTopMenu = strTopMenu & "global.fo_currentMenu = null" & vbCrLf
        strTopMenu = strTopMenu & "global.fo_shadows = new Array" & vbCrLf
 
        strTopMenu = strTopMenu & GetJS_ClassMenu() & vbCrLf
        strTopMenu = strTopMenu & "document.write(" & Chr(34) & GetRootClass(1) & Chr(34) & ");"
    Case 3
        strTopMenu = "document.write(" & Chr(34) & GetRootClass(2) & Chr(34) & ");"
    End Select
    If Not fso.FolderExists(Server.MapPath(InstallDir & ChannelDir & "/js")) Then
        fso.CreateFolder Server.MapPath(InstallDir & ChannelDir & "/js")
    End If
    Call WriteToFile(InstallDir & ChannelDir & "/js/ShowClass_Menu.js", strTopMenu)
    
    strClassTree = GetClass_Tree()
    Call WriteToFile(InstallDir & ChannelDir & "/js/ShowClass_Tree.js", "document.write(""" & strClassTree & """);")


    Select Case ClassGuideType
    Case 1
        strNavigation = "document.write(""" & GetClass_Navigation(1, 0, 2) & """);"
    Case 2
        strNavigation = "document.write(""" & GetClass_Navigation(1, 0, 3) & """);"
    Case 3
        strNavigation = "document.write(""" & GetClass_Navigation(1, 0, 4) & """);"
    Case 4
        strNavigation = "document.write(""" & GetClass_Navigation(1, 0, 5) & """);"
    Case 5
        strNavigation = "document.write(""" & GetClass_Navigation(1, 0, 6) & """);"
    Case 6
        strNavigation = "document.write(""" & GetClass_Navigation(1, 0, 7) & """);"
    Case 7
        strNavigation = "document.write(""" & GetClass_Navigation(1, 0, 8) & """);"
    Case 8
        strNavigation = "document.write(""" & GetClass_Navigation(2, 1, 2) & """);"
    Case 9
        strNavigation = "document.write(""" & GetClass_Navigation(2, 1, 3) & """);"
    Case 10
        strNavigation = "document.write(""" & GetClass_Navigation(2, 1, 4) & """);"
    Case 11
        strNavigation = "document.write(""" & GetClass_Navigation(2, 1, 5) & """);"
    Case 12
        strNavigation = "document.write(""" & GetClass_Navigation(2, 1, 6) & """);"
    Case 13
        strNavigation = "document.write(""" & GetClass_Navigation(2, 1, 7) & """);"
    Case 14
        strNavigation = "document.write(""" & GetClass_Navigation(2, 1, 8) & """);"
    Case 15
        strNavigation = "document.write(""" & GetClass_Navigation(2, 2, 2) & """);"
    Case 16
        strNavigation = "document.write(""" & GetClass_Navigation(2, 2, 3) & """);"
    Case 17
        strNavigation = "document.write(""" & GetClass_Navigation(2, 2, 4) & """);"
    Case 18
        strNavigation = "document.write(""" & GetClass_Navigation(2, 2, 5) & """);"
    Case 19
        strNavigation = "document.write(""" & GetClass_Navigation(2, 2, 6) & """);"
    End Select
    Call WriteToFile(InstallDir & ChannelDir & "/js/ShowClass_Navigation.js", strNavigation)

    strOption = GetClass_Option(ChannelID, 0)
    Call WriteToFile(InstallDir & ChannelDir & "/js/ShowClass_Option.js", "document.write(""" & strOption & """);")
    
    strForm = ShowSearchForm(2, 0)
    Call WriteToFile(InstallDir & ChannelDir & "/js/ShowSearchForm.js", "document.write(""" & strForm & """);")
End Sub

Function GetClass_Option(iChannelID, CurrentID)
    Dim rsClass, sqlClass, strTemp, tmpDepth, i
    Dim arrShowLine(20)
    For i = 0 To UBound(arrShowLine)
        arrShowLine(i) = False
    Next
    sqlClass = "Select t_classid,ClassName,ClassType,Depth,NextID from t_area where ChannelID=" & iChannelID & " order by RootID,OrderID"
    Set rsClass = Conn.Execute(sqlClass)
    If rsClass.BOF And rsClass.EOF Then
        strTemp = "<option value=''>请先添加菜单</option>"
    Else
        strTemp = ""
        Do While Not rsClass.EOF
            tmpDepth = rsClass(3)
            If rsClass(4) > 0 Then
                arrShowLine(tmpDepth) = True
            Else
                arrShowLine(tmpDepth) = False
            End If
            strTemp = strTemp & "<option value='" & rsClass(0) & "'"
            If CurrentID > 0 And rsClass(0) = CurrentID Then
                 strTemp = strTemp & " selected"
            End If
            strTemp = strTemp & ">"
            
            If tmpDepth > 0 Then
                For i = 1 To tmpDepth
                    strTemp = strTemp & "&nbsp;&nbsp;"
                    If i = tmpDepth Then
                        If rsClass(4) > 0 Then
                            strTemp = strTemp & "├&nbsp;"
                        Else
                            strTemp = strTemp & "└&nbsp;"
                        End If
                    Else
                        If arrShowLine(i) = True Then
                            strTemp = strTemp & "│"
                        Else
                            strTemp = strTemp & "&nbsp;"
                        End If
                    End If
                Next
            End If
            strTemp = strTemp & rsClass(1)
            If rsClass(2) = 2 Then
                strTemp = strTemp & "(外)"
            End If
            strTemp = strTemp & "</option>"
            rsClass.MoveNext
        Loop
    End If
    rsClass.Close
    Set rsClass = Nothing

    GetClass_Option = strTemp
End Function


Function GetOrderTyOption(OrderType)
    Dim strOrderType
    strOrderType = strOrderType & "<option value='1'"
    If OrderType = 1 Then strOrderType = strOrderType & " selected"
    strOrderType = strOrderType & ">" & ChannelShortName & "ID（降序）</option>"
    strOrderType = strOrderType & "<option value='2'"
    If OrderType = 2 Then strOrderType = strOrderType & " selected"
    strOrderType = strOrderType & ">" & ChannelShortName & "ID（升序）</option>"
    strOrderType = strOrderType & "<option value='3'"
    If OrderType = 3 Then strOrderType = strOrderType & " selected"
    strOrderType = strOrderType & ">更新时间（降序）</option>"
    strOrderType = strOrderType & "<option value='4'"
    If OrderType = 4 Then strOrderType = strOrderType & " selected"
    strOrderType = strOrderType & ">更新时间（升序）</option>"
    strOrderType = strOrderType & "<option value='5'"
    If OrderType = 5 Then strOrderType = strOrderType & " selected"
    strOrderType = strOrderType & ">点击次数（降序）</option>"
    strOrderType = strOrderType & "<option value='6'"
    If OrderType = 6 Then strOrderType = strOrderType & " selected"
    strOrderType = strOrderType & ">点击次数（升序）</option>"
    GetOrderTyOption = strOrderType
End Function

Function GetOpenTyOption(OpenType)
    Dim strOpenType
    strOpenType = "<option value='0'"
    If OpenType = 0 Then
        strOpenType = strOpenType & " selected"
    End If
    strOpenType = strOpenType & ">" & "在原窗口打开</option><option value='1'"
    If OpenType = 1 Then
        strOpenType = strOpenType & " selected"
    End If
    strOpenType = strOpenType & ">" & "在新窗口打开</option>"
    GetOpenTyOption = strOpenType
End Function

Function GetPath(ParentID, ParentPath)
    Dim strPath, i
    If ParentID <= 0 Then
        GetPath = "无（作为一级菜单）"
        Exit Function
    End If
    Dim rsParent, sqlParent
    sqlParent = "Select * from t_area where t_classid in (" & ParentPath & ") order by Depth"
    Set rsParent = Conn.Execute(sqlParent)
    Do While Not rsParent.EOF
        For i = 1 To rsParent("Depth")
            strPath = strPath & "&nbsp;&nbsp;&nbsp;"
        Next
        If rsParent("Depth") > 0 Then
            strPath = strPath & "└&nbsp;"
        End If
        strPath = strPath & rsParent("ClassName") & "<br>"
        rsParent.MoveNext
    Loop
    rsParent.Close
    Set rsParent = Nothing
    GetPath = strPath
End Function

'=================================================
'函数名：GetRootClass_Menu
'作  用：得到菜单无级下拉菜单效果的HTML代码
'参  数：无
'返回值：菜单无级下拉菜单效果的HTML代码
'=================================================
Function GetRootClass_Menu()
    Dim Class_MenuTitle, strJS, strClassUrl, XmlText
    ClassLink = XmlText("BaseText", "ClassLink", "|")
    pNum = 1
    pNum2 = 0
    strJS = "stm_bm(['uueoehr',400,'','" & strInstallDir & "images/blank.gif',0,'','',0,0,0,0,0,1,0,0]);" & vbCrLf
    strJS = strJS & "stm_bp('p0',[0,4,0,0,2,2,0,0,100,'',-2,'',-2,90,0,0,'#000000','transparent','',3,0,0,'#000000']);" & vbCrLf
    strJS = strJS & "stm_ai('p0i0',[0,'" & ClassLink & "','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','#000000','#000000','9pt 宋体','9pt 宋体',0,0]);" & vbCrLf
    If UseCreateHTML > 0 Then
        strClassUrl = ChannelUrl & "/Index" & FileExt_Index
    Else
        strClassUrl = ChannelUrl & "/Index.asp"
    End If
    strJS = strJS & "stm_aix('p0i1','p0i0',[0,'" & ChannelName & "首页','','',-1,-1,0,'" & strClassUrl & "','_self','" & strClassUrl & "','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体','9pt 宋体']);" & vbCrLf
    strJS = strJS & "stm_aix('p0i2','p0i0',[0,'" & ClassLink & "','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','#000000','#000000','9pt 宋体','9pt 宋体',0,0]);" & vbCrLf

    Dim sqlRoot, rsRoot, j
    sqlRoot = "select * from t_area where ChannelID=" & ChannelID & " and Depth=0 and ShowOnTop=" & True & " order by RootID"
    Set rsRoot = Conn.Execute(sqlRoot)
    If Not (rsRoot.BOF And rsRoot.EOF) Then
        j = 3
        Do While Not rsRoot.EOF
            If rsRoot("OpenType") = 0 Then
                OpenTyClass = "_self"
            Else
                OpenTyClass = "_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
                strClassUrl = GetClassUrl(rsRoot("ParentDir"), rsRoot("ClassDir"), rsRoot("ClassID"), rsRoot("ClassPurview"))
                strJS = strJS & "stm_aix('p0i" & j & "','p0i0',[0,'" & rsRoot("ClassName") & "','','',-1,-1,0,'" & strClassUrl & "','" & OpenTyClass & "','" & strClassUrl & "','" & Class_MenuTitle & "','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体','9pt 宋体']);" & vbCrLf
                If rsRoot("Child") > 0 Then
                    strJS = strJS & GetClassMenu(rsRoot("ClassID"), 0)
                End If
            Else
                strJS = strJS & "stm_aix('p0i" & j & "','p0i0',[0,'" & rsRoot("ClassName") & "','','',-1,-1,0,'" & rsRoot("LinkUrl") & "','" & OpenTyClass & "','" & rsRoot("LinkUrl") & "','" & Class_MenuTitle & "','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体','9pt 宋体']);" & vbCrLf
            End If
            strJS = strJS & "stm_aix('p0i2','p0i0',[0,'" & ClassLink & "','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','#000000','#000000','9pt 宋体','9pt 宋体',0,0]);" & vbCrLf
            j = j + 1
            rsRoot.MoveNext
            If MaxPerLine > 0 Then
                If (j - 2) Mod MaxPerLine = 0 And Not rsRoot.EOF Then
                    strJS = strJS & "stm_em();" & vbCrLf
                    strJS = strJS & "stm_bm(['uueoehr',400,'','" & strInstallDir & "images/blank.gif',0,'','',0,0,0,0,0,1,0,0]);" & vbCrLf
                    strJS = strJS & "stm_bp('p0',[0,4,0,0,2,2,0,0,100,'',-2,'',-2,90,0,0,'#000000','transparent','',3,0,0,'#000000']);" & vbCrLf
                    strJS = strJS & "stm_ai('p0i0',[0,'" & ClassLink & "','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','#000000','#000000','9pt 宋体','9pt 宋体',0,0]);" & vbCrLf
                End If
            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, strClassUrl
    strJS = ""
    If pNum = 1 Then
        strJS = strJS & "stm_bp('p" & pNum & "',[1,4,0,0,2,3,6,7,100,'progid:DXImageTransform.Microsoft.Fade(overlap=.5,enabled=0,Duration=0.43)',-2,'',-2,67,2,3,'#999999','#ffffff','',3,1,1,'#aca899']);" & vbCrLf
    Else
        If ShowType = 0 Then
            strJS = strJS & "stm_bpx('p" & pNum & "','p" & pNum2 & "',[1,4,0,0,2,3,6]);" & vbCrLf
        Else
            strJS = strJS & "stm_bpx('p" & pNum & "','p" & pNum2 & "',[1,2,-2,-3,2,3,0]);" & vbCrLf
        End If
    End If
    
    k = 0
    sqlClass = "select * from t_area where ChannelID=" & ChannelID & " and ParentID=" & ID & " order by OrderID asc"
    Set rsClass = Conn.Execute(sqlClass)
    'set rsClass=conn.execute("GetChildClass_Article_Menu " & ID)
    Do While Not rsClass.EOF
        If rsClass("OpenType") = 0 Then
            OpenTyClass = "_self"
        Else
            OpenTyClass = "_blank"
        End If
        If Trim(rsClass("Tips")) <> "" Then
            Sub_MenuTitle = Replace(Replace(Replace(Replace(rsClass("Tips"), "'", ""), """", ""), Chr(10), ""), Chr(13), "")
        Else
            Sub_MenuTitle = ""
        End If
        If rsClass("ClassType") = 1 Then
            strClassUrl = GetClassUrl(rsClass("ParentDir"), rsClass("ClassDir"), rsClass("t_classid"), rsClass("ClassPurview"))
            If rsClass("Child") > 0 Then
                strJS = strJS & "stm_aix('p" & pNum & "i" & k & "','p" & pNum2 & "i0',[0,'" & rsClass("ClassName") & "','','',-1,-1,0,'" & strClassUrl & "','" & OpenTyClass & "','" & strClassUrl & "','" & Sub_MenuTitle & "','','',6,0,0,'" & strInstallDir & "images/arrow_r.gif','" & strInstallDir & "images/arrow_w.gif',7,7,0,0,1,'#ffffff',0,'#cccccc',0,'','',3,3,0,0,'#fffff7','#000000','#000000','#ffffff','9pt 宋体']);" & vbCrLf
                pNum = pNum + 1
                pNum2 = pNum2 + 1
                strJS = strJS & GetClassMenu(rsClass("t_classid"), 1)
            Else
                strJS = strJS & "stm_aix('p" & pNum & "i" & k & "','p" & pNum2 & "i0',[0,'" & rsClass("ClassName") & "','','',-1,-1,0,'" & strClassUrl & "','" & OpenTyClass & "','" & strClassUrl & "','" & Sub_MenuTitle & "','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',0,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体']);" & vbCrLf
            End If
        Else
            strJS = strJS & "stm_aix('p" & pNum & "i" & k & "','p" & pNum2 & "i0',[0,'" & rsClass("ClassName") & "','','',-1,-1,0,'" & rsClass("LinkUrl") & "','" & OpenTyClass & "','" & rsClass("LinkUrl") & "','" & Sub_MenuTitle & "','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',0,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体']);" & vbCrLf
        End If
        k = k + 1
        rsClass.MoveNext
    Loop
    rsClass.Close
    Set rsClass = Nothing
    strJS = strJS & "stm_ep();" & vbCrLf

    GetClassMenu = strJS
End Function

Function GetJS_ClassMenu()
    Dim sqlMenu, rsMenu, strMenu, PrevRootID, tmpDepth, i, strClassUrl
    sqlMenu = "select * from t_area where ChannelID=" & ChannelID & " and Depth=1 order by RootID,OrderID"
    Set rsMenu = Conn.Execute(sqlMenu)
    If rsMenu.BOF And rsMenu.EOF Then
        strMenu = "var menu0='没有任何子菜单';"
    Else
        strMenu = "var menu" & rsMenu("RootID") & "=" & Chr(34)
        If rsMenu("ClassType") = 2 Then
            strClassUrl = rsMenu("LinkUrl")
        Else
            strClassUrl = GetClassUrl(rsMenu("ParentDir"), rsMenu("ClassDir"), rsMenu("ClassID"), rsMenu("ClassPurview"))
        End If
        strMenu = strMenu & "&nbsp;<a style=font-size:9pt;line-height:14pt; href='" & strClassUrl & "'>" & rsMenu("ClassName") & "</a><br>"
        PrevRootID = rsMenu("RootID")
        rsMenu.MoveNext
        Do While Not rsMenu.EOF
            If rsMenu("RootID") <> PrevRootID Then
                strMenu = strMenu & Chr(34) & ";" & vbCrLf & "var menu" & rsMenu("RootID") & "=" & Chr(34)
            End If
            If rsMenu("ClassType") = 2 Then
                strClassUrl = rsMenu("LinkUrl")
            Else
                strClassUrl = GetClassUrl(rsMenu("ParentDir"), rsMenu("ClassDir"), rsMenu("ClassID"), rsMenu("ClassPurview"))
            End If
            strMenu = strMenu & "&nbsp;<a style=font-size:9pt;line-height:14pt; href='" & strClassUrl & "'>" & rsMenu("ClassName") & "</a><br>"
            
            PrevRootID = rsMenu("RootID")
            rsMenu.MoveNext
        Loop
        strMenu = strMenu & Chr(34) & ";" & vbCrLf
    End If
    rsMenu.Close
    Set rsMenu = Nothing
    GetJS_ClassMenu = strMenu
End Function

'=================================================
'函数名：GetRootClass
'作  用：显示一级菜单（无特殊效果）
'参  数：ShowType   ----显示方式，1为普通下拉菜单式，2为纯文字式，无菜单效果
'=================================================
Function GetRootClass(ShowType)
    Dim sqlRoot, rsRoot, strRoot, strClassUrl, iCount
    ClassLink = XmlText("BaseText", "ClassLink", "|")
    sqlRoot = "select * from t_area where ChannelID=" & ChannelID & " and ParentID=0 and ShowOnTop=" & True & " order by RootID"
    Set rsRoot = Conn.Execute(sqlRoot)
    If rsRoot.BOF And rsRoot.EOF Then
        strRoot = "还没有任何菜单，请首先添加菜单。"
    Else
        If UseCreateHTML > 0 Then
            strRoot = strRoot & "" & ClassLink & "<a href='" & ChannelUrl & "/Index" & FileExt_Index & "'>&nbsp;" & ChannelName & "首页&nbsp;</a>" & ClassLink & ""
        Else
            strRoot = strRoot & "" & ClassLink & "<a href='" & ChannelUrl & "/Index.asp'>&nbsp;" & ChannelName & "首页&nbsp;</a>" & ClassLink & ""
        End If
        Do While Not rsRoot.EOF
            If rsRoot("ClassType") = 2 Then
                strRoot = strRoot & "<a href='" & rsRoot("LinkUrl") & "' target='_blank'>&nbsp;" & rsRoot("ClassName") & "&nbsp;</a>" & ClassLink & ""
            Else
                strClassUrl = GetClassUrl(rsRoot("ParentDir"), rsRoot("ClassDir"), rsRoot("ClassID"), rsRoot("ClassPurview"))
                strRoot = strRoot & "<a href='" & strClassUrl & "'"
                If rsRoot("Child") > 0 And ShowType = 1 Then
                    strRoot = strRoot & " onMouseOver='ShowMenu(menu" & rsRoot("RootID") & ",100)'"
                End If
                strRoot = strRoot & ">&nbsp;" & rsRoot("ClassName") & "&nbsp;</a>" & ClassLink & ""
            End If
            rsRoot.MoveNext
            iCount = iCount + 1
            If iCount Mod MaxPerLine = 0 And Not rsRoot.EOF Then
                strRoot = strRoot & "<br>" & ClassLink & ""
            End If
        Loop
    End If
    rsRoot.Close
    Set rsRoot = Nothing
    GetRootClass = strRoot
End Function


'=================================================
'函数名：GetClass_Tree
'作  用：得到所有菜单的树形目录效果的HTML代码
'参  数：无
'返回值：菜单的树形目录效果的HTML代码
'=================================================
Function GetClass_Tree()
    Dim arrShowLine(20), Class_MenuTitle, i, strClassUrl
    For i = 0 To UBound(arrShowLine)
        arrShowLine(i) = False
    Next
    Dim rsClass, sqlClass, tmpDepth, strClassTree
    sqlClass = "Select t_classid,ClassName,Depth,ParentID,NextID,LinkUrl,Child,Readme,ClassType,ParentDir,ClassDir,OpenType,ClassPurview from t_area where ChannelID=" & ChannelID & " order by RootID,OrderID"
    Set rsClass = Conn.Execute(sqlClass)
    If rsClass.BOF And rsClass.EOF Then
        strClassTree = "没有任何菜单"
    Else
        strClassTree = ""
        Do While Not rsClass.EOF
            tmpDepth = rsClass(2)
            If rsClass(4) > 0 Then
                arrShowLine(tmpDepth) = True
            Else
                arrShowLine(tmpDepth) = False
            End If
            If Trim(rsClass(7)) <> "" Then
                Class_MenuTitle = Replace(Replace(Replace(Replace(rsClass(7), "'", ""), """", ""), Chr(10), ""), Chr(13), "")
            Else
                Class_MenuTitle = ""
            End If
            If tmpDepth > 0 Then
                For i = 1 To tmpDepth
                    If i = tmpDepth Then
                        If rsClass(4) > 0 Then
                            strClassTree = strClassTree & "<img src='../images/tree_line1.gif' width='17' height='16' valign='abvmiddle'>"
                        Else
                            strClassTree = strClassTree & "<img src='../images/tree_line2.gif' width='17' height='16' valign='abvmiddle'>"
                        End If
                    Else
                        If arrShowLine(i) = True Then
                            strClassTree = strClassTree & "<img src='../images/tree_line3.gif' width='17' height='16' valign='abvmiddle'>"
                        Else
                            strClassTree = strClassTree & "<img src='../images/tree_line4.gif' width='17' height='16' valign='abvmiddle'>"
                        End If
                    End If
                Next
            End If
            If rsClass(6) > 0 Then
                strClassTree = strClassTree & "<img src='../Images/tree_folder4.gif' width='15' height='15' valign='abvmiddle'>"
            Else
                strClassTree = strClassTree & "<img src='../Images/tree_folder3.gif' width='15' height='15' valign='abvmiddle'>"
            End If
            
            If rsClass("ClassType") = 2 Then
                strClassUrl = rsClass("LinkUrl")
            Else
                strClassUrl = GetClassUrl(rsClass("ParentDir"), rsClass("ClassDir"), rsClass("t_classid"), rsClass("ClassPurview"))
            End If
            strClassTree = strClassTree & "<a href='" & strClassUrl & "' title='" & Class_MenuTitle & "'"
            If rsClass(11) = 0 Then
                strClassTree = strClassTree & " target='_top'"
            Else
                strClassTree = strClassTree & " target='_blank'"
            End If
            If rsClass(2) = 0 Then
                strClassTree = strClassTree & "><b>" & rsClass(1) & "</b>"
            Else
                strClassTree = strClassTree & ">" & rsClass(1)
            End If
            If rsClass(8) = 2 Then
                strClassTree = strClassTree & "(外)"
            End If
            strClassTree = strClassTree & "</a>"
            If rsClass(6) > 0 Then
                strClassTree = strClassTree & "（" & rsClass(6) & "）"
            End If
            strClassTree = strClassTree & "<br>"
            rsClass.MoveNext
        Loop
    End If
    rsClass.Close
    Set rsClass = Nothing
    GetClass_Tree = strClassTree
End Function

'==================================================
'函数名：ShowSearchForm
'作  用：显示搜索表单
'参  数：ShowType ----显示方式。1为简洁模式，2为标准模式，3为高级模式
'        CurrentID ----当前菜单ID
'返回值：搜索表单的HTML代码
'==================================================
Function ShowSearchForm(ShowType, CurrentID)
    Dim strForm
    If ShowType <> 1 And ShowType <> 2 And ShowType <> 3 Then
        ShowType = 1
    End If
    strForm = "<table border='0' cellpadding='0' cellspacing='0'>"
    strForm = strForm & "<form method='Get' name='SearchForm' action='" & ChannelUrl & "/Search.asp'>"
    strForm = strForm & "<tr><td height='28' align='center'>"
    If ShowType = 1 Then
        Select Case ModuleType
        Case 1
            strForm = strForm & "<input type='hidden' name='field' value='Title'>"
        Case 2
            strForm = strForm & "<input type='hidden' name='field' value='SoftName'>"
        Case 3
            strForm = strForm & "<input type='hidden' name='field' value='PhotoName'>"
        Case 5
            strForm = strForm & "<input type='hidden' name='field' value='ProductName'>"
        End Select
        strForm = strForm & "<input type='text' name='keyword'  size='15' value='关键字' maxlength='50' onFocus='this.select();'>&nbsp;"
        strForm = strForm & "<input type='submit' name='Submit'  value='搜索'>"
    ElseIf ShowType = 2 Then
        strForm = strForm & "<select name='Field' size='1'>"
        Select Case ModuleType
        Case 1
            strForm = strForm & "<option value='Title' selected>" & ChannelShortName & "标题</option>"
        Case 2
            strForm = strForm & "<option value='SoftName' selected>" & ChannelShortName & "名称</option>"
        Case 3
            strForm = strForm & "<option value='PhotoName' selected>" & ChannelShortName & "名称</option>"
        Case 5
            strForm = strForm & "<option value='ProductName' selected>" & ChannelShortName & "名称</option>"
        End Select
        If SearchContent = True Then
            Select Case ModuleType
            Case 1
                strForm = strForm & "<option value='Content'>" & ChannelShortName & "内容</option>"
            Case 2
                strForm = strForm & "<option value='SoftIntro'>" & ChannelShortName & "简介</option>"
            Case 3
                strForm = strForm & "<option value='PhotoIntro'>" & ChannelShortName & "简介</option>"
            Case 5
                strForm = strForm & "<option value='ProductIntro'>" & ChannelShortName & "简介</option>"
            End Select
        End If
        If ModuleType = 1 Or ModuleType = 2 Or ModuleType = 3 Then
            strForm = strForm & "<option value='Author'>" & ChannelShortName & "作者</option>"
            strForm = strForm & "<option value='Inputer'>录 入 者</option>"
        ElseIf ModuleType = 5 Then
            strForm = strForm & "<option value='ProducerName'>厂商</option>"
            strForm = strForm & "<option value='TrademarkName'>品牌/商标</option>"
        End If
        strForm = strForm & "<option value='Keywords'>关键字</option>"
        strForm = strForm & "</select>&nbsp;"
        strForm = strForm & "<select name='ClassID'><option value=''>所有菜单</option>" & GetClass_Option(ChannelID, 0) & "</select>&nbsp;"
        strForm = strForm & "<input type='text' name='keyword'  size='20' value='关键字' maxlength='50' onFocus='this.select();'>&nbsp;"
        strForm = strForm & "<input type='submit' name='Submit'  value=' 搜索 '>"
    ElseIf ShowType = 3 Then
    
    End If
    strForm = strForm & "</td></tr></form></table>"
    ShowSearchForm = strForm
End Function


Sub DelInfo(arrClassID)
    'On Error Resume Next
    Dim sqlDel, rsDel
    Dim InfoPath, FileExt

    If IsValidID(arrClassID) = False Then Exit Sub
    Select Case ModuleType
    Case 1
        sqlDel = "select ArticleID as InfoID,UpdateTime,Inputer,Deleted,PaginationType from Article"
    Case 2
        sqlDel = "select SoftID as InfoID,UpdateTime,Inputer,Deleted from Soft"
    Case 3
        sqlDel = "select PhotoID as InfoID,UpdateTime,Inputer,Deleted from Photo"
    Case 5
        sqlDel = "select ProductID as InfoID,UpdateTime,Inputer,Deleted from Product"
    End Select
    If InStr(arrClassID, ",") > 0 Then
        sqlDel = sqlDel & " where t_classid in (" & arrClassID & ")"
    Else
        sqlDel = sqlDel & " where t_classid=" & arrClassID & ""
    End If
    Set rsDel = Server.CreateObject("ADODB.Recordset")
    rsDel.Open sqlDel, Conn, 1, 3
    Do While Not rsDel.EOF
        InfoPath = HtmlDir & GetItemPath(StructureType, "", "", rsDel("UpdateTime")) & GetItemFileName(FileNameType, ChannelDir, rsDel("UpdateTime"), rsDel("InfoID"))
        If fso.FileExists(Server.MapPath(InfoPath & FileExt_Item)) Then
            fso.DeleteFile Server.MapPath(InfoPath & FileExt_Item)
        End If
        If ModuleType = 1 Then
            If rsDel("PaginationType") > 0 Then
                DelSerialFiles (Server.MapPath(InfoPath) & "_*" & FileExt_Item)
            End If
        End If

        rsDel("Deleted") = True
        rsDel.Update
        rsDel.MoveNext
    Loop
    rsDel.Close
    Set rsDel = Nothing
End Sub

Function GetClassUrl(sParentDir, sClassDir, iClassID, iClassPurview)
    Dim strClassUrl
    If (UseCreateHTML = 1 Or UseCreateHTML = 3) And iClassPurview < 2 Then
        strClassUrl = ChannelUrl & GetListPath(StructureType, ListFileType, sParentDir, sClassDir) & GetListFileName(ListFileType, iClassID, 1, 1) & FileExt_List
    Else
        strClassUrl = ChannelUrl & "/ShowClass.asp?ClassID=" & iClassID
    End If
    GetClassUrl = strClassUrl
End Function

Function UpdateClassPurview(arrClassID)
    Dim rsClass, sqlClass, rsPurview, iClassPurview
    sqlClass = "select ClassPurview,ParentID,ParentPath,Child,arrChildID from t_area where t_classid in (" & arrClassID & ")"
    Set rsClass = Server.CreateObject("Adodb.recordset")
    rsClass.Open sqlClass, Conn, 1, 3
    Do While Not rsClass.EOF
        iClassPurview = rsClass("ClassPurview")
        If iClassPurview < 2 And rsClass("ParentID") > 0 Then
            Set rsPurview = Conn.Execute("select max(ClassPurview) from t_area where t_classid in (" & rsClass("ParentPath") & ")")
            If rsPurview(0) > iClassPurview Then iClassPurview = rsPurview(0)
            rsPurview.Close
            Set rsPurview = Nothing
            If iClassPurview > rsClass("ClassPurview") Then
                rsClass("ClassPurview") = iClassPurview
                rsClass.Update
            End If
        End If
        If iClassPurview > 0 And rsClass("Child") > 0 Then
            Conn.Execute ("update t_area set ClassPurview=" & iClassPurview & " where t_classid in (" & rsClass("arrChildID") & ") and ClassPurview<" & iClassPurview & "")
        End If
        rsClass.MoveNext
    Loop
    rsClass.Close
    Set rsClass = Nothing
End Function

Function GetChannel_Option(iModuleType, iChannelID)
    Dim rsGetAdmin, rsChannel
    Dim strChannel
    Set rsGetAdmin = Conn.Execute("select * from Admin where AdminName='" & AdminName & "'")
    Set rsChannel = Conn.Execute("select ChannelID,ChannelName,ChannelDir from Channel  where ModuleType=" & iModuleType & " and Disabled=" & False & " and ChannelType<=1 order by OrderID")
    Do While Not rsChannel.EOF
        If AdminPurview = 1 Or rsGetAdmin("AdminPurview_" & rsChannel("ChannelDir")) = 1 Then
            If rsChannel(0) = iChannelID Then
                strChannel = strChannel & "<option value='" & rsChannel(0) & "' selected>" & rsChannel(1) & "</option>"
            Else
                strChannel = strChannel & "<option value='" & rsChannel(0) & "'>" & rsChannel(1) & "</option>"
            End If
        End If
        rsChannel.MoveNext
    Loop
    rsChannel.Close
    Set rsChannel = Nothing
    rsGetAdmin.Close
    Set rsGetAdmin = Nothing
    GetChannel_Option = strChannel
End Function
%>
            </p>
            <p>&nbsp;            </p>          </td>
        </tr>
    </table></td>
  </tr>
  <tr>
    <td>&nbsp;</td>
  </tr>
</table>
</body>
</html>
<%
	Call CloseConn
%>