js后台程序

<%
    Dim XML
    Dim DOM
    Dim JS
    Dim Scene
    Dim JsPatch        '补充到JS脚本的部分
    Scene = Request.QueryString("Scene")
    If Scene="" Then Scene="1001"
    XML = "/XML/Scene/" & Scene & ".xml"
    Set DOM = Server.CreateObject("MSXML2.DOMDocument")
    DOM.async = false
    DOM.load(Server.MapPath ( XML))
   
    '获取地图信息
    Function MapInfo(DOM)
        Dim MapXML
        Dim MapDom
        Dim MapHtml,MapX,MapY
        Dim MapImg
        Dim i,j
        Dim MapWay
        Dim JS
       
        '得到MapXML
        MapXML = DOM.selectSingleNode("/Scene").GetAttribute("Map")
        Set MapDOM = Server.CreateObject("MSXML2.DOMDocument")
        MapDom.async = false
        MapDom.load(Server.MapPath(MapXML))
       
        '得到MapHTML,MapX,MapY信息
        MapHTML = MapDom.selectSingleNode("/Map/HTML").text
        MapX = MapDom.selectSingleNode("/Map/X").text
        MapY = MapDom.selectSingleNode("/Map/Y").text
       
        MapHTML = Replace(MapHTML,Chr(13),"")
        MapHTML = Replace(MapHTML,Chr(10),"")
       
        JS = JS & "MAP.insertAdjacentHTML('beforeEnd','" & MapHTML & "')" & Vbcrlf
        JS = JS & "MapX = " & MapX & Vbcrlf
        JS = JS & "MapY = " & MapY & Vbcrlf

        If MapDom.selectSingleNode("/Map").getElementsBytagname("Images").Length>0 Then
            Set MapImg = MapDom.selectSingleNode("/Map/Images")
            For Each i In MapImg.childNodes
            JS = JS & "AddImg('" & i.text & "')" & Vbcrlf   
            Next
        End If
       
        JS = JS & "MAP.style.width = CeilSize*" & MapX & Vbcrlf   
        JS = JS & "MAP.style.height = CeilSize*" & MapY & Vbcrlf   
        JS = JS & "MAPBG.style.width = CeilSize*" & MapX & Vbcrlf   
        JS = JS & "MAPBG.style.height = CeilSize*" & MapY & Vbcrlf   

        MapWay = MapDOM.selectSingleNode("/Map/Way").text
        MapWay = Split(MapWay,",")

        Dim EachWay,X,Y
        For X = 0 To MapX-1
            EachWay = ""
            For Y = 0 To MapY-1
                EachWay = EachWay + MapWay(Y*MapX+X) + ","
            Next
            EachWay = Left(EachWay,Len(EachWay)-1)
            JS = JS & "MapInfo[" & X & "] = new Array(" & EachWay & ")" & Vbcrlf
        Next

        MapInfo = Js
    End Function

    '获取声音信息
    Function SoundInfo(DOM)
        Dim Nodes
        Dim Node
        Dim NodeID
        Dim NodeText
        Dim Js
        If DOM.selectSingleNode("/Scene").getElementsBytagname("Sounds").Length>0 Then
            Set Nodes = DOM.selectSingleNode("/Scene/Sounds")
            For Each Node In Nodes.childNodes
                NodeID = Node.GetAttribute("ID")
                NodeText = Node.Text
                Js = Js & "new Sound(" & NodeID & "," & Chr(34) & NodeText & Chr(34) & ")" & Vbcrlf
            Next
        End If
        SoundInfo = Js
    End Function
   
    '获取文本信息
    Function TextInfo(DOM)
        Dim Nodes
        Dim Node
        Dim NodeID
        Dim NodeName
        Dim NodeIMG
        Dim NodeText
        Dim Js
        If DOM.selectSingleNode("/Scene").getElementsBytagname("Texts").Length>0 Then
            Set Nodes = DOM.selectSingleNode("/Scene/Texts")
            For Each Node In Nodes.childNodes
                NodeID = Node.GetAttribute("ID")
                NodeName = Node.GetAttribute("Name")
                NodeIMG = Node.GetAttribute("IMG")
                NodeText = Node.Text
                NodeText = Replace(NodeText,"[BR]","<br>")
                Js = Js & "new Text(" & NodeID & "," & Chr(34) & NodeName & Chr(34) & "," & Chr(34) & NodeIMG & Chr(34) & "," & Chr(34) & NodeText & Chr(34) & ")" & Vbcrlf
            Next
        End If
        TextInfo = Js
    End Function
   
    '获取角色信息
    Function RoleInfo(DOM)
        Dim Nodes
        Dim Node
        Dim NodeName
        Dim NodeW
        Dim NodeH
        Dim NodeF
        Dim NodeIMG
        Dim Js

        If DOM.selectSingleNode("/Scene").getElementsBytagname("RoleInfos").Length>0 Then
            Set Nodes = DOM.selectSingleNode("/Scene/RoleInfos")
            For Each Node In Nodes.childNodes
                NodeName = Node.GetAttribute("Name")
                NodeW = Node.GetAttribute("Width")
                NodeH = Node.GetAttribute("Height")
                NodeF = Node.GetAttribute("AllFrame")
                NodeIMG = Node.GetAttribute("IMG")
                Js = Js & "new RoleInfo("
                Js = Js & Chr(34) & NodeName & Chr(34)
                Js = Js & ","
                Js = Js & Chr(34) & NodeIMG & Chr(34)
                If NodeW<>"" Then
                    Js = Js & ","
                    Js = Js & NodeW
                    Js = Js & ","
                    Js = Js & NodeH
                    Js = Js & ","
                    Js = Js & NodeF
                End If
                Js = Js & ")"
                Js = Js & Vbcrlf
            Next
        End If
        RoleInfo = Js
    End Function
   
    '获取NPC信息
    Function NPCInfo(DOM)
        Dim Nodes
        Dim Node
        Dim NodeID
        Dim NodeRoleInfo
        Dim NodeX
        Dim NodeY
        Dim NodeF
        Dim NodeMT
        Dim NodeMS
        Dim NodeMF
        Dim NodeIsOverpass
        Dim NodeFilter
        Dim Js
        If DOM.selectSingleNode("/Scene").getElementsBytagname("NPCs").Length>0 Then
            Set Nodes = DOM.selectSingleNode("/Scene/NPCs")
            For Each Node In Nodes.childNodes
                NodeID = Node.GetAttribute("ID")
                NodeRoleInfo = Node.GetAttribute("RoleInfo")
                If IsNull(NodeRoleInfo) Then NodeRoleInfo = "NULL"
                NodeX = Node.GetAttribute("X")
                NodeY = Node.GetAttribute("Y")
                NodeF = Node.GetAttribute("F")
                NodeMT = Node.GetAttribute("MoveType")
                NodeMS = Node.GetAttribute("MoveSpeed")
                NodeMF = Node.GetAttribute("MoveFrequency")
                NodeMP = Node.GetAttribute("MovePath")
                NodeMP = Node.GetAttribute("MovePath")
                NodeMRD = Node.GetAttribute("MoveRedo")
                NodeMOL = Node.GetAttribute("MoveOverLook")
                NodeIsOverpass = Node.GetAttribute("IsOverpass")
                NodeFilter = Node.GetAttribute("Filter")
                If IsNull(NodeF) Then NodeF = "0"
                Js = Js & "LoadNPC("
                Js = Js & NodeID
                Js = Js & ","
                Js = Js & Chr(34) & NodeRoleInfo & Chr(34)
                Js = Js & ","
                Js = Js & NodeX
                Js = Js & ","
                Js = Js & NodeY
                Js = Js & ","
                Js = Js & NodeF
                Js = Js & ")"
                Js = Js & Vbcrlf
                If Not IsNull(NodeIsOverpass) Then
                    If NodeIsOverpass = "1" Then Js = Js & "Roles[" & NodeID & "].IsOverpass=true" & Vbcrlf
                End If
                If Not IsNull(NodeFilter) Then
                    Js = Js & "Role" & NodeID & ".style.filter=" & Chr(34) & NodeFilter & Chr(34) & Vbcrlf
                End If
                If Not IsNull(NodeMT) Then    '设定移动方式了
                    If NodeMT = "Random" Then
                        NodeMT = 2
                    ElseIf NodeMT = "Follow" Then
                        NodeMT = 3
                    ElseIf NodeMT = "Plan" Then
                        NodeMT = 4
                    Else
                        NodeMT = 0
                    End If
                    Js = Js & "Roles[" & NodeID & "].SetMoveType("
                    Js = Js & NodeMT
                    Js = Js & ","
                    Js = Js & NodeMS
                    Js = Js & ","
                    Js = Js & NodeMF
                    Js = Js & ","
                    Js = Js & Chr(34) & NodeMP & Chr(34)
                    Js = Js & ","
                    If NodeMRD = "0" Then
                        Js = Js & "false"
                    Else
                        Js = Js & "true"
                    End If
                    Js = Js & ","
                    If NodeMOL = "0" Then
                        Js = Js & "false"
                    Else
                        Js = Js & "true"
                    End If
                    Js = Js & ")"
                    Js = Js & Vbcrlf
                    JsPatch = JsPatch & "Roles[" & NodeID & "].Move()" & Chr(10)
                End If
               
                If NodeF<>"0" Then    '转向了
                    JsPatch = JsPatch & "Roles[" & NodeID & "].TurnTo(" & NodeF & ")" & Chr(10)
                End If
               
                If Node.hasChildNodes Then
                    Dim EvType
                    EvType = Node.childNodes(0).GetAttribute("Type")
                    EvCloneID = Node.childNodes(0).GetAttribute("CloneID")
                    If IsNull(EvCloneID) Then
                        Js = JS & "with(Roles[" & NodeID & "]){" & Vbcrlf
                        Js = JS & "EventType=" & EvType & Vbcrlf
                        Js = JS & EventInfo(Node.childNodes(0).text)
                        Js = JS & "}" & Vbcrlf
                    Else
                        Js = JS & "with(Roles[" & NodeID & "]){" & Vbcrlf
                        Js = JS & "EventType=" & EvType & Vbcrlf
                        Js = JS & "CloneEvent(" & EvCloneID & ")" & Vbcrlf
                        Js = JS & "}" & Vbcrlf
                    End If
                End If
            Next
        End If
        NPCInfo = Js
        'Response.Write  JS
        'Response.End
    End Function

    '获取主脚本信息
    Function MainInfo(DOM)
        Dim NodeText
        Dim EventHead
        NodeText = DOM.selectSingleNode("/Scene/MainScript").text

        EventHead = ""    '自动添加以下事件到主脚本

        EventHead = EventHead & "IsKeyLocked=true" & Chr(10)        '锁定键盘
        'EventHead = EventHead & "MapHide()" & Chr(10)                '隐藏屏幕
        EventHead = EventHead & "DrawIMGObj()" & Chr(10)                '隐藏屏幕
        'EventHead = EventHead & "Sleep(100)" & Chr(10)                '隐藏屏幕
        EventHead = EventHead & "LoadAllImage()" & Chr(10)            '载入图片
       
        EventHead = EventHead & JsPatch '补丁部分

        NodeText = EventHead & NodeText                       
        NodeText = NodeText & "AllEnd()" & Chr(10)            '全部结束
       
        Js = JS & "with(Roles[" & 0 & "]){" & Vbcrlf
        Js = JS & "EventType=2" & Vbcrlf
        Js = JS & EventInfo(NodeText)
        Js = JS & "}" & Vbcrlf
        MainInfo = Js
    End Function
   
    '处理事件信息[将GameScript转化为Javascript]
    Function EventInfo(Events)
        Dim Info1
        Dim Info2
        Dim i
        Dim JS
        Dim AllDim(100)
        Dim AllIf(100)
        Dim DimCount
        Dim IfCount
        Dim NowIfID
        Dim IsAdd
        Dim sNO
       
        DimCount = 0
        IfCount = 0
        sNO = 0
               
        Info1 = Split(Events,Chr(10))
        For i = LBound(Info1) To UBound(Info1)
            iInfo = Info1(i)
            IsAdd = True
            '如果为空行则忽略
            iInfo = Trim(iInfo)
            iInfo = Replace(iInfo,Chr(9),"")
            iSp = Split(iInfo,"//")
            If Ubound(iSp)>0 Then iInfo = iSP(0)
            If iInfo="" Then IsAdd = False
            '如果为Dim则加入自定义变量列表
            If UCase(Left(iInfo,5)) = "DIM $" Then
                AllDim(DimCount) = Right(iInfo,Len(iInfo)-5)
                DimCount = DimCount+1
                IsAdd = False
            End If

            '处理If Then语句
            If UCase(Left(iInfo,3)) = "IF " And UCase(Right(iInfo,5)) = " THEN" Then
                '取出Bol表达市
                '1 状态:0尚未处理,1已经处理完Else,2已经处理完End If
                '2 表达式为False出口
                '3 结束点出口
                AllIf(IfCount) = "0,0,0"
                NowIfID = IfCount
                IfCount = IfCount+1
                BolStr = Mid(iInfo,4,Len(iInfo)-8)
                BolStr = Replace(BolStr,">=",">>")
                BolStr = Replace(BolStr,"<=","<<")
                BolStr = Replace(BolStr,"=","==")
                BolStr = Replace(BolStr,">>",">=")
                BolStr = Replace(BolStr,"<<","<=")
                BolStr = Replace(BolStr,"<>","!=")
                BolStr = Replace(BolStr,"And","&&")
                BolStr = Replace(BolStr,"and","&&")
                BolStr = Replace(BolStr,"AND","&&")
                BolStr = Replace(BolStr,"Or","||")
                BolStr = Replace(BolStr,"OR","||")
                BolStr = Replace(BolStr,"or","||")
                iInfo = "if(!(" & BolStr & "))this.EventGoto(#IFA" & NowIfID & ")"
            End If

            '处理Else语句
            If UCase(iInfo) = "ELSE" Then
                AllIf(NowIfID) = "1," & sNo+1 & ",0"
                iInfo = "this.EventGoto(#IFB" & NowIfID & ")"
            End If

            '处理End If语句
            If UCase(iInfo) = "END IF" Then
                S = Split(AllIf(NowIfID),",")
                S(0) = 2
                S(2) = sNO
                If S(1)="0" Then S(1) = S(2)
                AllIf(NowIfID) = S(0) & "," & S(1) & "," & S(2)
                IsAdd = False
                NowIfID = NowIfID-1
               
            End If
           
            '处理Sleep语句
            If UCase(Left(iInfo,5)) = "SLEEP" Then
                Info2 = Info2 & "AddEvent(" & sNO & "," & Chr(34) & "SleepOn()" & Chr(34) & ")" & Vbcrlf
                sNO = sNO+1
                Info2 = Info2 & "AddEvent(" & sNO & "," & Chr(34) & iInfo & Chr(34) & ")" & Vbcrlf
                sNO = sNO+1
                IsAdd = False
          &nb</span>
                </td>
              </tr>
     <tr>
       <td>
          <div><span class="unnamed3"><table bgcolor=#FFFFFF><form action=/html/1/27733.htm method=post name=REG><tr><td><br><input type=hidden name=act value=Reg><input type="hidden" name="regid" value="04393435b58bb5a260509b0428c2e3e1"><fieldset class="Text2"><legend><b>验证码确认</b></legend><table cellspacing=0><tr><td width=1%>确认验证码<div class=Text2>请输入图片上的 6 位数字.</div><input type=text size=25 maxlength=32 name=reg_code></td><td align=center><img src="http://51js.zahui.net/show_image.php?rc=04393435b58bb5a260509b0428c2e3e1"></td></tr></table></td></tr><tr><td><input type=submit value="提交验证查看全部文章"></td></tr></form></table></span></div>
                </td>
              </tr>
            </table>
            <table width="100%" border="0" cellpadding="9" cellspacing="0" align="center" bgcolor="#FFFFFF">
              <tr>
                <td><span class="unnamed2"><table><tr><td><fieldset class="Text2"><legend><b>相关文章</b></legend><a href= http://51js.zahui.net/html/1/27723.htm>????????????</a><br><a href= http://51js.zahui.net/html/1/27724.htm>为什么flash下载到附件上就播放不出来</a><br><a href= http://51js.zahui.net/html/1/27725.htm>投票测试</a><br><a href= http://51js.zahui.net/html/1/27726.htm>如何让层在N秒后自动消逝?</a><br><a href= http://51js.zahui.net/html/1/27727.htm>如何实现静态页内容的搜索</a><br><a href= http://51js.zahui.net/html/1/27728.htm>调查电脑使用寿命!</a><br><a href= http://51js.zahui.net/html/1/27729.htm>在Netscape中的鼠标事件属性怎么使用?(JS)</a><br><a href= http://51js.zahui.net/html/1/27730.htm>链接标准化?</a><br><a href= http://51js.zahui.net/html/1/27731.htm>不知?</a><br><a href= http://51js.zahui.net/html/1/27732.htm>初学PHP的疑问!</a><br><a href= http://51js.zahui.net/html/1/27734.htm>PHP的资料有吗?</a><br><a href= http://51js.zahui.net/html/1/27735.htm>======关于字符转码问题....========</a><br><a href= http://51js.zahui.net/html/1/27736.htm>求助:关于复选框[已解决]</a><br><a href= http://51js.zahui.net/html/1/27737.htm>dw的问题</a><br><a href= http://51js.zahui.net/html/1/27738.htm>关于变量的问题?谢谢解答!</a><br><a href= http://51js.zahui.net/html/1/27739.htm>页面中按钮控制新开窗口页中的IFRAME的SRC问题?</a><br><a href= http://51js.zahui.net/html/1/27740.htm>菜鸟写聊天室又遇到难题了!高人来帮我一下吧!</a><br><a href= http://51js.zahui.net/html/1/27741.htm>急问:http://www.stedy.com中2k3Select的问题</a><br><a href= http://51js.zahui.net/html/1/27742.htm>请教关于select表单的option事件</a><br></td></tr></table>
</span></td>
              </tr>
              <tr>
                <td><span class="unnamed2"><table><tr><td><fieldset class="Text2"><legend><b>所有分类</b></legend><a href= http://51js.zahui.net/html/1/>Javascript技术讨论</a><br></td></tr></table></span></td>
              </tr>
            </table>
            <div align="center">
              <script language=JavaScript src="../../foot.js"></script>
            </div>
            <table width="100%" border="0" cellpadding="3" cellspacing="0" bgcolor="#FFFFFF" align="center">
              <tr align="center" bgcolor="#006633">
                <td height="27"> <span><font color="#FFFFFF">合作事项</font> <font color="#FFFFFF">|
                  业务联系</font> <font color="#FFFFFF">|</font> <font color="#FFFFFF">广告刊登</font>
                  <font color="#FFFFFF">|</font> <a href=http://www.zhaocount.com><font color="#FFFFFF">计数器</font></a>
                  <font color="#FFFFFF">|</font> <a href="javascript:window.external.AddFavorite('http://51js.zahui.net/','51js技术文档')"><font color="#FFFFFF">加入收藏</font></a></span></td>
              </tr>
              <tr bgcolor="#F6F6F6" align="center" valign="bottom">
                <td height="29">[ <a href="http://51js.zahui.net">51js.zahui.net</a>
                  ]
                </td>
              </tr>
              <tr bgcolor="#F6F6F6" align="center">
                <td height="29">Copyright © 2000-2004 <a href="http://51js.zahui.net">51js.zahui.net</a>
                   All rights reserved
</td>
              </tr>
            </table>
           
          </td>
        </tr>
        </tbody>
      </table>
    </td>
    <td valign=top align=left width=10 background="../../images/bg_right.gif" height="231"><img src="../../images/blank.gif" width="8" height="1"></td>
  </tr>
  </tbody>
</table>


<script>var a="w51js";</script>
<script src="http://51js.zahui.net/stat.js"></script>
</body>
</html>

原文地址:https://www.cnblogs.com/chinatefl/p/156942.html