<![CDATA[
<%
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' *TEST MATERIAL*
' Use this code to test the functionality if you so desire.
' You can delete any of the code between the +++ lines without
' affecting the functionality. Uncomment the code you want to try.
' WARNING: when testing, remember that IE can have problems
' switching between HTML & XML content types. Use 2 different browser
' windows to be sure it works properly. A good indication of a problem
' is if you load XML, and the browser window is blank.
'++ Testing the two included functions
'These functions assume the files are in the same directory
'as the asp being used.
'Response.Write(TransformXMLWithXSL("<YOURXMLDOC>", "<YOURXSLDOC>"))
'Response.Write(ReturnXMLWithXSL("<YOURXMLDOC>", "<YOURXSLDOC>"))
'++
'++ Test full functionality
' Dim cls_XML ' As New XML_Handler
' Dim strParameter ' As String
' Dim strValue ' As String
' Dim strXMLDoc ' As String
' Dim strXSLDoc ' As String
' Dim strStyleSheet ' As String
' strParameter = "" '**PUT YOUR PARAMETER HERE
' strValue = "" '**PUT YOUR VALUE HERE
' strXMLDoc = Server.MapPath("news.xml") '**PUT FULL PATH TO DOC HERE (Use Server.MapPath)
' strXSLDoc = Server.MapPath("news.xsl") '**PUT FULL PATH TO DOC HERE (Use Server.MapPath)
' strStyleSheet = "foobar" '**PUT YOUR STYLESHEET NAME HERE
' Set cls_XML = New XML_Handler
'
'Remember, only uncomment what you need. For example, if you only
'want to return XML you do not need to load an XSL doc, or run
'the AssignParameter Function. Or, if you want to transform into
'HTML, then call both load functions, and the AssignParameter function
'if needed, then the Execut. Also, be sure to only uncomment one of the
'Execute functions.
' cls_XML.LoadXML strXMLDoc
' cls_XML.LoadXSL strXSLDoc
'cls_XML.AssignParameter strParameter, strValue '--Change Parameter in XSL DOC
'cls_XML.AddStyleSheet (strStyleSheet) '--Add's Stylesheet to XML DOC
' Response.Write(cls_XML.Execute("HTML")) '--Transforms XML/XSL
'Response.Write(cls_XML.Execute("XML")) '--Returns XML
' Set cls_XML = Nothing
'Response.Write TransformXMLWithXSL("news.xml", "news.xsl")
'END TEST MATERIAL
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'---------------------------------------------------------------
'These functions act as a wrappers for the Transformation class
'---------------------------------------------------------------
'************************************************************
Function TransformXMLWithXSL(strXMLDoc, strXSLDoc)
Dim cls_XML
Set cls_XML = New XML_Handler
cls_XML.LoadXML Server.MapPath(strXMLDoc)
cls_XML.LoadXSL Server.MapPath(strXSLDoc)
TransformXMLWithXSL = Reformat(cls_XML.Execute("HTML"))
Set cls_XML = Nothing
End Function
'************************************************************
'************************************************************
Function ReturnXMLWithXSL(strXMLDoc, strXSLDoc)
Dim cls_XML
Set cls_XML = New XML_Handler
cls_XML.LoadXML Server.MapPath(strXMLDoc)
cls_XML.AddStyleSheet strXSLDoc
ReturnXMLWithXSL = (cls_XML.Execute("XML"))
Set cls_XML = Nothing
End Function
'************************************************************
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'This class will handle the XML/XSL Transformation into HTML.
'The publicly accessible properties/functions are:
'1. XMLDocument - object reference for the XML document
'2. XSLDocument - Same as above, but for the XSL
'3. LoadMSXML2() - private function that creates as MSXML2.DOMDocument object
' for:
'4. LoadXML/LoadXSL - takes full location and filename (ie use Server.MapPath or
' hard code, calls LoadMSXML2 to get the object, then loads the file into
' memory
'5. AssignParameter function - Used to assign the values of parameters
' and their values. This is optional, and when run will access
' AN EXISTING xsl parameter in the stylesheet and change the value.
' Can be called as many times as needed
'6. Execute function - Performs the translation and returns text/html or xml.
' However, in some cases it is not formated properly so the
' Reformat() function may need to be called afterwards
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Class XML_Handler
Private XMLDocument 'As MSXML2.DOMDocument
Private XSLDocument 'As MSXML2.DOMDocument
'************************************************************
Public Function LoadXML(oXMLDoc)
Set XMLDocument = Server.CreateObject("MSXML2.DOMDocument")
'Set XMLDocument = LoadMSXML2()
XMLDocument.load(oXMLDoc)
End Function
Public Function LoadXSL(oXSLDoc)
Set XSLDocument = LoadMSXML2()
XSLDocument.load(oXSLDoc)
End Function
'************************************************************
'************************************************************
Private Function LoadMSXML2()
Dim objXML 'As MSXML2.DOMDocument
Set objXML = Server.CreateObject("MSXML2.DOMDocument")
With objXML
.async = False 'We do not want asynchronous downloads
.validateOnParse = False 'don't want to validate against a schema
.preserveWhiteSpace = True 'preserve white space
.resolveExternals = False 'do not resolve external DTDs, etc
End With
Set LoadMSXML2 = objXML
Set objXML = Nothing
End Function
'************************************************************
'************************************************************
Public Function AssignParameter(strParameter, strValue)
Dim XSLParam
strParameter = Trim(strParameter)
strValue = Trim(strValue)
'First checks the parameter/value to be sure they aren't Null b4
'processing the names into the proper command text, which is
'like this: <xsl:param name="ParameterName">VALUE</xsl:param>
'The command text uses XPath, and would look like
'"//xsl:param[@name='ParameterName]". It is also CASE-SENSITIVE
If Not IsNull(strParameter) AND Not IsNull(strValue) Then
strParameter = "//xsl:param[@name='" & strParameter & "']"
Set XSLParam = XSLDocument.selectSingleNode(strParameter)
XSLParam.childNodes(0).nodeValue = strValue
Set XSLParam = Nothing
End If
End Function
'************************************************************
'************************************************************
Public Function AddStyleSheet(strStyleSheet)
Dim topNode ' AS
Dim XMLInstruct 'As Processing instruction
strStyleSheet = Trim(strStyleSheet)
'Create processing instruction
Set XMLInstruct = XMLDocument.createProcessingInstruction ("xml:stylesheet", _
"type=""text/xsl"" href=" & chr(34) & strStyleSheet & chr(34) & "")
'Find root element, then insert instruction BEFORE it.
'The If statement checks for the <?xml... instruction tag to be
'sure that the stylesheet instruction is correctly placed.
If Instr(1,XMLDocument.childNodes(0).xml, "?xml") Then
Set topNode = XMLDocument.childNodes(1)
Else
Set topNode = XMLDocument.childNodes(0)
End If
XMLDocument.insertBefore XMLInstruct, topNode
Set XMLInstruct = Nothing
Set topNode = Nothing
End Function
'************************************************************
'************************************************************
Public Function Execute(iMethod)
If iMethod = "HTML" Then
'Returns HTML for client side transformations
Execute = XMLDocument.transformNode(XSLDocument)
End If
If iMethod = "XML" Then
'Returns XML for use with IE
Execute = XMLDocument.xml
End If
'Destroy XML objects created
Set XMLDocument = Nothing
Set XSLDocument = Nothing
End Function
'************************************************************
End Class
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'************************************************************
Function Reformat(vTemp)
'This function is used to replace certain chars that need to
'be converted
If Instr(1,vtemp,"&apos;") Then
'Replace fixes every item in the string
vTemp = Replace(vTemp,"&apos;","'")
'The string "&apos;" must be searched for b/c the replacement
'of an apostrophe in XML is ', but this is not recognized
'as valid HTML so it gets interpreted as an ampersand + apos;,
'and doesn't render properly
End If
If Instr(1,vTemp,"&lt;") Then
vTemp = Replace(vTemp,"&lt;","<")
End If
If Instr(1,vTemp,"&gt;") Then
vTemp = Replace(vTemp,"&gt;",">")
End If
If Instr(1,vTemp,"&amp;") Then
vTemp = Replace(vTemp,"&amp;","&")
End If
If Instr(1,vTemp,"&quot;") Then
vTemp = Replace(vTemp,"&quot;",""")
End If
Reformat = vTemp
End Function
'************************************************************
%>
]]>