<% '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' *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,"&amp;apos;") Then 'Replace fixes every item in the string vTemp = Replace(vTemp,"&amp;apos;","'") 'The string "&amp;apos;" must be searched for b/c the replacement 'of an apostrophe in XML is &apos;, 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,"&amp;lt;") Then vTemp = Replace(vTemp,"&amp;lt;","&lt;") End If If Instr(1,vTemp,"&amp;gt;") Then vTemp = Replace(vTemp,"&amp;gt;","&gt;") End If If Instr(1,vTemp,"&amp;amp;") Then vTemp = Replace(vTemp,"&amp;amp;","&amp;") End If If Instr(1,vTemp,"&amp;quot;") Then vTemp = Replace(vTemp,"&amp;quot;","&quot;") End If Reformat = vTemp End Function '************************************************************ %>