在Classic ASP中选择XML中的特定节点到HtmlEntityDecode(unescape)

时间:2015-04-09 17:18:43

标签: xml vbscript asp-classic

我得到一个soap响应,它给我看起来像这样的XML(来自Web服务的所有信息都以字符串格式提供并放入节点中):

<?xml version="1.0" encoding="utf-8"?><soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema">
<soap:Body>
<GetAllBookingsResponse xmlns="http://DEA.EMS.API.Web.Service/">
<GetAllBookingsResult>&lt
    ;Bookings&gt;
      &lt;Data&gt;
        &lt;BookingDate&gt;2015-04-09T00:00:00&lt;/BookingDate&gt;
    &lt;/Data&gt;
    &lt;/Bookings&gt;
</GetAllBookingsResult>
</GetAllBookingsResponse>
</soap:Body>
</soap:Envelope>

我使用“替换”将&lt;&gt;替换为适当的&lt;和&gt;但是我被告知这不是最好的方法。

我找到了HtmlEntityDecode - 但我似乎无法选择合适的节点在字符串上使用该函数。

我的代码如下所示:

<%
Dim objXMLHTTP : set objXMLHTTP = Server.CreateObject("MSXML2.XMLHTTP")

Dim strRequest, strResult, strFunction, strURL, strNamespace

'URL to SOAP namespace and connection URL
strNamespace = "http://DEA.EMS.API.Web.Service/"
strURL = "http://myserver/EMSAPI/"

'function you want to call
strFunction = "GetBuildings"
'strFunction = "test" 'no parameters required

strRequest ="<?xml version=""1.0"" encoding=""utf-8""?>" &_
      "<soap:Envelope" &_
      " xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance""" &_
      " xmlns:api=""http://127.0.0.1/Integrics/Enswitch/API""" &_
      " xmlns:xsd=""http://www.w3.org/2001/XMLSchema""" &_
      " xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"">" &_
        "<soap:Body>" &_
                "<GetBuildings xmlns=""http://DEA.EMS.API.Web.Service/"">" &_
                    "<UserName>Myusername</UserName>" &_
                    "<Password>mypassword</Password>" &_
                "</GetBuildings>" &_
        "</soap:Body>" &_
      "</soap:Envelope>"


objXMLHTTP.open "POST", ""& strURL &"", True

objXMLHTTP.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
objXMLHTTP.setRequestHeader "Content-Length", Len(strRequest) 
objXMLHTTP.setRequestHeader "SOAPAction", strNamespace & strFunction


'send the request and capture the result
objXMLHTTP.send(strRequest)

'Set a timer to wait for response
set shell = CreateObject("WScript.Shell")
 t1 = timer()
 sleep(1)
 t2 = timer()
 response.write "waited "& t2-t1 &" secs"

 function sleep(seconds)
    if seconds>=1 then shell.popup "pausing",seconds,"pause",64
 end function


strResult = objXMLHTTP.responseText
'strResult = Replace(strResult, "&lt;", "<")
'strResult = Replace(strResult, "&gt;", ">")


'display the XML
response.write strResult

%>

2 个答案:

答案 0 :(得分:0)

锦兴,

我最近不得不在旧的经典ASP网站上做类似的事情。这是我写的一个函数,用于处理我的特定情况,但适用于你的:

Function xmlNodeReturn(inXMLStr, NodePattern)
    'Err will help us detect failure to find the correct Node in the XMLResponse
    On Error Resume Next
    Dim xmlDoc, rtnHolder

    'Need to work with XML Object to properly access the data contained
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    xmlDoc.async = false
    xmlDoc.loadXML inXMLStr

    'Identify Parent and Target Node for which you need data and place it's text contents in a holder...
    rtnHolder = xmlDoc.selectSingleNode(NodePattern).text
    Set xmlDoc = Nothing

    'If the identified node is NOT found Err will result...
    If Err <> 0 Then
        rtnHolder = False
        Err.Clear
    End If
    xmlNodeReturn = rtnHolder
End Function

getResults = xmlNodeReturn(strResult, "//GetAllBookingsResponse/GetAllBookingsResult")

希望这有帮助!

答案 1 :(得分:0)

或者,您可以删除所有换行符并使用正则表达式或VBScript Mid(字符串,开始[,长度])来获取内容。

Function RegExpReturnPart(ValTest, PartToReturn, ContentBody)
    Dim regEx, theMatches, theMatch
    Set regEx = New RegExp
    regEx.Pattern = ValTest
    regEx.IgnoreCase = True

    ContentBody = Replace(ContentBody, vbNewline, "[NEWLINE]")

    Set theMatches = regEx.Execute(ContentBody)

    'This is admittedly sloppy, but I assume you have one result that you care about
    If theMatches.Count > 0 Then
        RegExpReturnPart = Replace(theMatches(0).SubMatches(PartToReturn - 1), "[NEWLINE]", vbNewLine)
    Else
        RegExpReturnPart = "NOT RETURNED"
    End If
    Set regEx = Nothing
End Function

getResults = RegExpReturnPart("<GetAllBookingsResult>(.*)</GetAllBookingsResult>", "$1", strResult)

希望其中一个有用。