admin_createxml.asp

来自「本程序系统完全实现了医院网站程序的全部功能的前台和后台程序」· ASP 代码 · 共 1,083 行 · 第 1/4 页

        Set FsNodeTemp = XMLDOM.createNode(2, "SiteName", "")
        FsNodeTemp.text = xml_nohtml(rsSite("SiteName"))
        FsNode2.Attributes.setNamedItem (FsNodeTemp)
        
        Set FsNodeTemp = XMLDOM.createNode(2, "SiteUrl", "")
        FsNodeTemp.text = rsSite("SiteUrl")
        FsNode2.Attributes.setNamedItem (FsNodeTemp)
        
        Set FsNodeTemp = XMLDOM.createNode(2, "LogoUrl", "")
        If Not (rsSite("LogoUrl") = "" Or IsNull(rsSite("LogoUrl"))) Then FsNodeTemp.text = rsSite("LogoUrl")
        FsNode2.Attributes.setNamedItem (FsNodeTemp)
        
        Set FsNodeTemp = XMLDOM.createNode(2, "SiteAdmin", "")
        If Not (rsSite("SiteAdmin") = "" Or IsNull(rsSite("SiteAdmin"))) Then FsNodeTemp.text = xml_nohtml(rsSite("SiteAdmin"))
        FsNode2.Attributes.setNamedItem (FsNodeTemp)
        
        Set FsNodeTemp = XMLDOM.createNode(2, "SiteEmail", "")
        If Not (rsSite("SiteEmail") = "" Or IsNull(rsSite("SiteEmail"))) Then FsNodeTemp.text = rsSite("SiteEmail")
        FsNode2.Attributes.setNamedItem (FsNodeTemp)
        
        Set FsNodeTemp = XMLDOM.createNode(2, "Hits", "")
        FsNodeTemp.text = PE_CLng(rsSite("Hits"))
        FsNode2.Attributes.setNamedItem (FsNodeTemp)
        
        Set FsNodeTemp = XMLDOM.createNode(2, "Time", "")
        If Not (rsSite("UpdateTime") = "" Or IsNull(rsSite("UpdateTime"))) Then FsNodeTemp.text = rsSite("UpdateTime")
        FsNode2.Attributes.setNamedItem (FsNodeTemp)
        
        FsNode2.text = xml_nohtml(rsSite("SiteIntro"))
        
        rsSite.MoveNext
    Loop
    
    Set rsSiteClass = Conn.Execute("select KindID,KindName,Readme,KindType from PE_FsKind order by KindID")
    If Not (rsSiteClass.BOF And rsSiteClass.EOF) Then
        Do While Not rsSiteClass.EOF
            Set FsNode = Node.appendChild(XMLDOM.createElement("FriendSiteClass"))
            
            Set FsNodeTemp = XMLDOM.createNode(2, "ClassID", "")
            FsNodeTemp.text = rsSiteClass("KindID")
            FsNode.Attributes.setNamedItem (FsNodeTemp)
            
            Set FsNodeTemp = XMLDOM.createNode(2, "ClassName", "")
            FsNodeTemp.text = xml_nohtml(rsSiteClass("KindName"))
            FsNode.Attributes.setNamedItem (FsNodeTemp)
            
            Set FsNodeTemp = XMLDOM.createNode(2, "Readme", "")
            If Not (rsSiteClass("Readme") = "" Or IsNull(rsSiteClass("Readme"))) Then FsNodeTemp.text = xml_nohtml(rsSiteClass("Readme"))
            FsNode.Attributes.setNamedItem (FsNodeTemp)
            
            Set FsNodeTemp = XMLDOM.createNode(2, "KindType", "")
            FsNodeTemp.text = rsSiteClass("KindType")
            FsNode.Attributes.setNamedItem (FsNodeTemp)
           
            Set rsSite = Conn.Execute("select top 20 * from PE_FriendSite Where KindID=" & rsSiteClass("KindID") & " and Passed = " & PE_True & " order by OrderID")
            Do While Not rsSite.EOF
                Set FsNode2 = FsNode.appendChild(XMLDOM.createElement("FriendSite"))
                
                Set FsNodeTemp = XMLDOM.createNode(2, "SiteID", "")
                FsNodeTemp.text = rsSite("ID")
                FsNode2.Attributes.setNamedItem (FsNodeTemp)
                
                Set FsNodeTemp = XMLDOM.createNode(2, "SiteName", "")
                FsNodeTemp.text = xml_nohtml(rsSite("SiteName"))
                FsNode2.Attributes.setNamedItem (FsNodeTemp)
                
                Set FsNodeTemp = XMLDOM.createNode(2, "SiteUrl", "")
                FsNodeTemp.text = rsSite("SiteUrl")
                FsNode2.Attributes.setNamedItem (FsNodeTemp)
                
                Set FsNodeTemp = XMLDOM.createNode(2, "LogoUrl", "")
                If Not (rsSite("LogoUrl") = "" Or IsNull(rsSite("LogoUrl"))) Then FsNodeTemp.text = rsSite("LogoUrl")
                FsNode2.Attributes.setNamedItem (FsNodeTemp)
                
                Set FsNodeTemp = XMLDOM.createNode(2, "SiteAdmin", "")
                FsNodeTemp.text = xml_nohtml(rsSite("SiteAdmin"))
                FsNode2.Attributes.setNamedItem (FsNodeTemp)
                
                Set FsNodeTemp = XMLDOM.createNode(2, "SiteEmail", "")
                If Not (rsSite("SiteEmail") = "" Or IsNull(rsSite("SiteEmail"))) Then FsNodeTemp.text = rsSite("SiteEmail")
                FsNode2.Attributes.setNamedItem (FsNodeTemp)
                
                Set FsNodeTemp = XMLDOM.createNode(2, "Hits", "")
                FsNodeTemp.text = PE_CLng(rsSite("Hits"))
                FsNode2.Attributes.setNamedItem (FsNodeTemp)
                
                Set FsNodeTemp = XMLDOM.createNode(2, "Time", "")
                FsNodeTemp.text = rsSite("UpdateTime")
                FsNode2.Attributes.setNamedItem (FsNodeTemp)
                
                FsNode2.text = xml_nohtml(rsSite("SiteIntro"))
                
                rsSite.MoveNext
            Loop

            rsSiteClass.MoveNext
        Loop
    End If
    rsSiteClass.Close
    rsSite.Close
    Set rsSiteClass = Nothing
    Set rsSite = Nothing
    Set FsNode = Nothing
    Set FsNodeTemp = Nothing
End Sub


Sub ShowAnnounce()
    Dim rsAnnounce, AnnounceNode, AnnounceNodeTemp
    
    Set Node = XMLDOM.createNode(1, "AnnounceList", "")
    XMLDOM.documentElement.appendChild (Node)
    
    Set rsAnnounce = Conn.Execute("select * from PE_Announce Where IsSelected = " & PE_True & " order by ID")
    Do While Not rsAnnounce.EOF
        Set AnnounceNode = Node.appendChild(XMLDOM.createElement("Announce"))
        
        Set AnnounceNodeTemp = XMLDOM.createNode(2, "ID", "")
        AnnounceNodeTemp.text = rsAnnounce("ID")
        AnnounceNode.Attributes.setNamedItem (AnnounceNodeTemp)
        
        Set AnnounceNodeTemp = XMLDOM.createNode(2, "Title", "")
        AnnounceNodeTemp.text = xml_nohtml(rsAnnounce("Title"))
        AnnounceNode.Attributes.setNamedItem (AnnounceNodeTemp)
        
        Set AnnounceNodeTemp = XMLDOM.createNode(2, "Author", "")
        AnnounceNodeTemp.text = xml_nohtml(rsAnnounce("Author"))
        AnnounceNode.Attributes.setNamedItem (AnnounceNodeTemp)
        
        Set AnnounceNodeTemp = XMLDOM.createNode(2, "Time", "")
        AnnounceNodeTemp.text = rsAnnounce("DateAndTime")
        AnnounceNode.Attributes.setNamedItem (AnnounceNodeTemp)
        
        Set AnnounceNodeTemp = XMLDOM.createNode(2, "ChannelID", "")
        AnnounceNodeTemp.text = rsAnnounce("ChannelID")
        AnnounceNode.Attributes.setNamedItem (AnnounceNodeTemp)
        
        Set AnnounceNodeTemp = XMLDOM.createNode(2, "ShowType", "")
        AnnounceNodeTemp.text = rsAnnounce("ShowType")
        AnnounceNode.Attributes.setNamedItem (AnnounceNodeTemp)
        
        AnnounceNode.text = xml_nohtml(rsAnnounce("Content"))
        rsAnnounce.MoveNext
    Loop
    rsAnnounce.Close
    Set rsAnnounce = Nothing
    Set AnnounceNode = Nothing
    Set AnnounceNodeTemp = Nothing
End Sub


Sub ShowNav(ByVal iChannelID)
    Dim rsClass, sqlClass, preDepth, i, UrlTemp
    sqlClass = "select ClassID,ClassName,Depth,ParentID,NextID,LinkUrl,Child,ClassType,ParentDir,ClassDir,OpenType,ClassPurview from PE_Class where ChannelID=" & iChannelID & " order by RootID,OrderID"
    Set rsClass = Conn.Execute(sqlClass)
    If Not (rsClass.BOF And rsClass.EOF) Then
            preDepth = 0
        Do While Not rsClass.EOF
            If rsClass("ClassPurview") < 2 And (UseCreateHTML = 1 Or UseCreateHTML = 3) Then
                Select Case ListFileType
                Case 0
                    If FileExt_List = 0 Then
                        UrlTemp = SiteUrl & "/" & ChannelDir & rsClass("ParentDir") & rsClass("ClassDir") & "/index.html"
                    ElseIf FileExt_List = 1 Then
                        UrlTemp = SiteUrl & "/" & ChannelDir & rsClass("ParentDir") & rsClass("ClassDir") & "/index.htm"
                    ElseIf FileExt_List = 2 Then
                        UrlTemp = SiteUrl & "/" & ChannelDir & rsClass("ParentDir") & rsClass("ClassDir") & "/index.shtml"
                    ElseIf FileExt_List = 3 Then
                        UrlTemp = SiteUrl & "/" & ChannelDir & rsClass("ParentDir") & rsClass("ClassDir") & "/index.shtm"
                    ElseIf FileExt_List = 4 Then
                        UrlTemp = SiteUrl & "/" & ChannelDir & rsClass("ParentDir") & rsClass("ClassDir") & "/index.asp"
                    Else
                        UrlTemp = SiteUrl & "/" & ChannelDir & "/ShowClass.asp?ClassID=" & rsClass("ClassID")
                    End If
                Case 1
                    If FileExt_List = 0 Then
                        UrlTemp = SiteUrl & "/" & ChannelDir & "/List/List_" & rsClass("ClassID") & ".html"
                    ElseIf FileExt_List = 1 Then
                        UrlTemp = SiteUrl & "/" & ChannelDir & "/List/List_" & rsClass("ClassID") & ".htm"
                    ElseIf FileExt_List = 2 Then
                        UrlTemp = SiteUrl & "/" & ChannelDir & "/List/List_" & rsClass("ClassID") & ".shtml"
                    ElseIf FileExt_List = 3 Then
                        UrlTemp = SiteUrl & "/" & ChannelDir & "/List/List_" & rsClass("ClassID") & ".shtm"
                    ElseIf FileExt_List = 4 Then
                        UrlTemp = SiteUrl & "/" & ChannelDir & "/List/List_" & rsClass("ClassID") & ".asp"
                    Else
                        UrlTemp = SiteUrl & "/" & ChannelDir & "/ShowClass.asp?ClassID=" & rsClass("ClassID")
                    End If
                Case 2
                    If FileExt_List = 0 Then
                        UrlTemp = SiteUrl & "/" & ChannelDir & "/List_" & rsClass("ClassID") & ".html"
                    ElseIf FileExt_List = 1 Then
                        UrlTemp = SiteUrl & "/" & ChannelDir & "/List_" & rsClass("ClassID") & ".htm"
                    ElseIf FileExt_List = 2 Then
                        UrlTemp = SiteUrl & "/" & ChannelDir & "/List_" & rsClass("ClassID") & ".shtml"
                    ElseIf FileExt_List = 3 Then
                        UrlTemp = SiteUrl & "/" & ChannelDir & "/List_" & rsClass("ClassID") & ".shtm"
                    ElseIf FileExt_List = 4 Then
                        UrlTemp = SiteUrl & "/" & ChannelDir & "/List_" & rsClass("ClassID") & ".asp"
                    Else
                        UrlTemp = SiteUrl & "/" & ChannelDir & "/ShowClass.asp?ClassID=" & rsClass("ClassID")
                    End If
                Case Else
                    UrlTemp = SiteUrl & "/" & ChannelDir & "/ShowClass.asp?ClassID=" & rsClass("ClassID")
                End Select
            Else
                UrlTemp = SiteUrl & "/" & ChannelDir & "/ShowClass.asp?ClassID=" & rsClass("ClassID")
            End If
            If Not IsNull(rsClass("LinkUrl")) Then UrlTemp = rsClass("LinkUrl")
            If preDepth - rsClass("Depth") > 0 Then
                For i = 1 To (preDepth - rsClass("Depth"))
                    strHTML = strHTML & ("</item>" & vbCrLf)
                Next
            End If
            If rsClass("Child") = 0 Then
                strHTML = strHTML & ("<item label=""" & rsClass("ClassName") & """ url=""" & UrlTemp & """ target=""_Self"" />" & vbCrLf)
            Else
                strHTML = strHTML & ("<item label=""" & rsClass("ClassName") & """ url=""" & UrlTemp & """ target=""_Self"">" & vbCrLf)
            End If
            preDepth = rsClass("Depth")
            rsClass.MoveNext
        Loop
        If preDepth > 0 Then
            For i = 1 To preDepth
                strHTML = strHTML & ("</item>" & vbCrLf)
            Next
        End If
    End If
    rsClass.Close
    Set rsClass = Nothing
End Sub

Sub ShowGuestNav()
    Dim rsGuest, sqlGuest
    strHTML = strHTML & ("<item label=""留言板首页"" url=""" & SiteUrl & "/GuestBook/index.asp""  target=""_Self"" />" & vbCrLf)
    sqlGuest = "select KindID,KindName,OrderID from PE_GuestKind order by KindID"
    Set rsGuest = Conn.Execute(sqlGuest)
    If Not (rsGuest.BOF And rsGuest.EOF) Then
        Do While Not rsGuest.EOF
            strHTML = strHTML & ("<item label=""" & ReplaceBadChar(rsGuest("KindName")) & """ url=""" & SiteUrl & "/GuestBook/index.asp?KindID=" & rsGuest("KindID") & """  target=""_Self"" />" & vbCrLf)
            rsGuest.MoveNext
        Loop
    End If
    rsGuest.Close
    Set rsGuest = Nothing
End Sub

Function xml_nohtml(ByVal fString)
    If IsNull(fString) Or Trim(fString) = "" Then
        xml_nohtml = ""
        Exit Function
    End If
    Dim str
    str = Replace(fString, "&gt;", ">")
    str = Replace(str, "&lt;", "<")
    str = Replace(str, "&nbsp;", "")
    str = Replace(str, "&quot;", "")
    str = Replace(str, "&#39;", "")
    regEx.Pattern = "(\<.[^\<]*\>)"
    str = regEx.Replace(str, "")
    regEx.Pattern = "(\<\/[^\<]*\>)"
    str = regEx.Replace(str, "")
    
    str = Replace(str, "'", "")
    str = Replace(str, Chr(34), "")
    str = Replace(Replace(str, "<![CDATA[", ""), "]]>", "")
    xml_nohtml = str
End Function
%>