<!-- METADATA TYPE="typelib" FILE="c:\program files\common files\system\ado\msado15.dll" -->
<%
Const DOMClass = "MSXML2.DOMDocument.4.0"
Sub rw(t) : Response.write(t) : End Sub
Sub rwbr(t) : Response.Write(t & "<br />") : End Sub
Sub PrintError(t) : rw "<p class='error'>" & t & "</p>" : Response.End : End Sub
'
' Open database connection
'
Dim DB
Set DB = Server.CreateObject("ADODB.Connection")
DB.Mode = adModeRead
DB.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath("faq.mdb")
Response.CodePage = 65001
'
' AddXMLStylesheet - adds xml-stylesheet processing instruction to the XML document
'
' Input:
' XDoc - XML document
' StyleURL - URL string to the XSL file
'
Sub AddXMLStylesheet(XDoc,StyleURL)
Dim XPI
Set XPI = XDoc.createProcessingInstruction("xml-stylesheet","href=""" & StyleURL & """ type=""text/xsl""")
XDoc.insertBefore XPI, XDoc.documentElement
End Sub
Function UseXMLOutput
UseXMLOutput = Request.QueryString("XML") <> "" Or InStr(Request.ServerVariables("HTTP_ACCEPT"),"x-ajax") > 0
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 SetXMLOptions (XD)
XD.Async = False
XD.setProperty "ServerHTTPRequest",true
XD.setProperty "AllowDocumentFunction",true
XD.resolveExternals = True
End Sub
Function LocalXSLTransform(XDoc,StyleURL)
Dim XSLT
Set XSLT = Server.CreateObject(DOMClass)
SetXMLOptions XDoc : SetXMLOptions XSLT
If Not XSLT.Load (Server.MapPath(StyleURL)) Then PrintError "XSL stylesheet load failed " & StyleURL
if XSLT.parseError.errorCode <> 0 Then PrintError "XML parsing failed: " & XSLT.parseError.reason
LocalXSLTransform = XDoc.transformNode(XSLT)
End Function
Sub OutputXMLDocument(XDoc,StyleURL)
If Not IsNull(StyleURL) Then AddXMLStylesheet XDoc,StyleURL
Response.Clear
Response.ContentType = "text/xml"
Response.Charset = "utf-8"
Response.Write XDoc.xml
Response.End
End Sub
Sub OutputXMLResponse(XDoc,StyleURL)
Dim XSLT,HText
If UseXMLOutput Or IsNull(StyleURL) Then
OutputXMLDocument XDoc,Null
Else
Response.Clear
Response.ContentType = "text/html"
Response.Write LocaLXSLTransform(XDoc,StyleURL)
Response.End
End If
End Sub
'
' NewXMLObject - creates new XML object and inserts XML PI
'
' Input:
' RNode - root node name
' Enc - encoding, windows-1250 if empty
'
' Returns: empty XML document with specified encoding and root node
Function NewXMLObject (RootNode)
Dim XO,XPI
Set XO = Server.CreateObject(DOMClass)
Set XPI = XO.createProcessingInstruction("xml","version='1.0'")
XO.insertBefore XPI,XO.documentElement
Set XPI = XO.createElement(RootNode)
XO.insertBefore XPI,Null
Set NewXMLObject = XO
End Function
Function NewXMLElement (XDoc,EName,XParent)
Dim XE
Set XE = XDoc.createElement(EName)
Set NewXMLElement = XE
If IsNull(XParent) Then
XDoc.lastChild.insertBefore XE,Null
Else
XParent.insertBefore XE,Null
End If
End Function
Function NewXMLTextElement (XDoc,EName,EText,XParent)
Dim XE
Set XE = NewXMLElement (XDoc,EName,XParent)
XE.text = EText
Set NewXMLTextElement = XE
End Function
'
' InsertHTMLFragment: parses text into XML tree, copies all children to the target XML element
'
' Input:
' HText - HTML markup
' XElem - target XML element
Dim XFrag
Sub InsertHTMLFragment(XElem,HText)
Dim CX
If Not IsObject(XFrag) Then Set XFrag = Server.CreateObject(DOMClass) ' Cache DOM object between calls
If Not XFrag.loadXML ("<html>" + HText + "</html>") Then PrintError "Not a valid XML fragment: " & Server.HTMLEncode(HText)
For Each CX In XFrag.documentElement.childNodes
XFrag.documentElement.removeChild CX
XElem.appendChild CX
Next
End Sub
%>