Source of XMLlibrary.asp

<%
Const DOMClass = "MSXML2.DOMDocument.3.0"
Const xmlPrefix = "<?xml version='1.0' encoding='utf-8' ?>"
 
Sub rw(t)   : Response.write t : End Sub
Sub rwbr(t) : response.Write t & "<br />" : End Sub
Function e(t) : e = Server.HTMLEncode(t) : End Function
 
'
' OutputXMLResponse - outputs XML document
'
' If XML is enabled changes ASP output to text/xml and prints the XML document to the output. Optionally adds XSL stylesheet to the XML document
' If XML is disabled, transforms XML to HTML and outputs HTML
'
' Input: 
'   XDoc     - XML document
'   StyleURL - URL string of the XSL stylesheet (Null if none)
'
' Output:
'   Content-type is changed to text/xml
'   XML document is dumped to the output stream
'
' Note:
'   If successful, the subroutine does not return
 
Sub OutputXMLResponse(XDoc,StyleURL)
  Dim XSLT,HText
  
  If UseXMLOutput Or IsNull(StyleURL) Then
    OutputXMLDocument XDoc,StyleURL
  Else
    HText = LocalXSLTransform(XDoc,StyleURL)
    OutputUTFtext HText, "text/html"
  End If
End Sub
 
'
' UseXMLOutput - decides whether to output the response in XML format or translated into HTML
'
 
Function UseXMLOutput
  UseXMLOutput = False
  If InStr(Request ("HTTP_USER_AGENT"),"MSIE 5") > 0 Then Exit Function
  UseXMLOutput = Request.Cookies("XML") = "1"
End Function
 
'
' OutputXMLDocument - Attaches the stylesheet URL into the document as a processing instruction and
'                     outputs the resulting UTF8 text
'
' Input: 
'   XDoc     - XML document
'   StyleURL - URL string of the XSL stylesheet (Null if none)
'
 
Sub OutputXMLDocument(XDoc,StyleURL)
  Dim XPI,xmlText
  If Not IsNull(StyleURL) Then 
    Set XPI = XDoc.createProcessingInstruction("xml-stylesheet","href='" & StyleURL & "' type='text/xsl'")
    XDoc.insertBefore XPI, XDoc.documentElement
  End If
 
  xmlText = XDoc.xml
  If InStr(xmlText,"<?xml") <> 1 Then xmlText = xmlPrefix & xmlText
  OutputUTFtext xmlText,"text/xml"
End Sub
 
'
' LocalXSLTransform - performs server-side XML-to-HTML transformation and
'                     returns the resulting HTML string
'
' Input: 
'   XDoc     - XML document
'   StyleURL - URL string of the XSL stylesheet (Null if none)
'
 

Top

Function LocalXSLTransform(XDoc,StyleURL)
  Dim XSLT,XTransform
  
  Set XSLT = Server.CreateObject(DOMClass)
  SetXMLOptions XDoc : SetXMLOptions XSLT
  If Not XSLT.Load (Server.MapPath(StyleURL)) Then RaiseError "XSL stylesheet load failed " & StyleURL 
  If XSLT.parseError.errorCode <> 0 Then RaiseError "XML parsing failed: " & XSLT.parseError.reason
  
' set a parameter in the root XML element to indicate the transform is done on the web server
  XDoc.documentElement.setAttribute "onServer","yes"
    
' the Replace function is called to fix a MSXML "design feature" in MSXML 4.0 and lower where the XSLT transform inserts an unwanted meta tag
' setting the output character set to UTF-16 ???
 
  Const MSBugText = "<META http-equiv=""Content-Type"" content=""text/html; charset=UTF-16"">"
'  rw Server.HTMLEncode(XSlt.xml) & "<br />" & Server.HTMLEncode(XDoc.xml) : response.End
  XTransform = XDoc.transformNode(XSLT)
  LocalXSLTransform = Replace(XTransform,MSBugText,"")
End Function
 
Sub SetXMLOptions (XD)
  XD.Async = False
  XD.setProperty "ServerHTTPRequest",true
  XD.setProperty "AllowDocumentFunction",true
  XD.resolveExternals = True
End Sub
 
Sub RaiseError(Txt)
  Err.Raise vbObjectError+1, "XML library",Txt
End Sub
 
'
' OutputUTFtext - clears the output butter, sets the content type, charset & codepage to UTF-8 and 
'                 writes the specified text to the output stream
'
' Input: 
'   txt         - output text
'   contentType - response MIME type (text/html or text/xml)
'
 
Sub OutputUTFtext (txt,contentType)
  Response.Clear
  Response.ContentType = contentType
  Response.Charset = "utf-8"
  Response.Codepage = 65001
  Response.Write txt
  Response.End
End Sub
 
'
' CreateXMLDocument - creates XML DOM document with specified root node
'
Function CreateXMLDocument(rootNode)
  Dim XD,XE
  Set XD = Server.CreateObject(DOMClass)
  Set XE = XD.createElement("root")
  XD.insertBefore XE,Null
  Set CreateXMLDocument = XD
End Function
 
'
' AppendChildTextNode - creates a document node, sets its text value and inserts it as the last
'                       child of the specified parent node
'
Function AppendChildTextNode(nodeName,textValue,parentNode)
  Dim CX
  Set CX = parentNode.ownerDocument.createElement(nodeName)
  CX.text = textValue
  parentNode.insertBefore CX,Null
  Set AppendChildTextNode = CX
End Function
%>