<%@ Language="VBScript" %> <% ' ***************************************************************************** ' ' info/xml.info6.asp ' ' GoLive design-time support for XML. ' ' ' COPYRIGHT (c) 1999-2000 Adobe Systems Incorporated. All rights reserved. ' ----------------------------------------------------------------------------- ' Return an XML document containing information about the datasources available ' for binding via XML. Valid requests are: ' ' xml.info6.asp?datasources= ' return a list available XML applications ' ex) .../xml.info6.asp?datasources=all ' ex) .../xml.info6.asp?datasources=distinct ' ' xml.info6.asp?dstype= return the structure of a given datasource ' xml.info6.asp?xml=&xsl= return default structure for source ' xml.info6.asp?get= return the contents of the XDS file ' xml.info6.asp?put=&data= write the contents of the XDS file ' xml.info6.asp?delete= delete the XDS file ' xml.info6.asp?dstype=&xml=&test=whatever return the first record RejectUnauthorizedCallers response.contenttype = "text/xml" if False = RuntimeDebug then on error resume next end if if Len(Request("dstype")) > 0 then WriteDataSourceSchema Request("dstype") elseif Len(Request("get")) > 0 then GetRaw Request("get") elseif Len(Request("put")) > 0 then PutRaw Request("put"), Request("data") elseif Len(Request("xsl")) > 0 then TransformAndAnalyze Request("xml"), Request("xsl") elseif Len(Request("xml")) > 0 then Analyze Request("xml") elseif Request("datasources") = "all" then WriteDataSources true elseif Len(Request("delete")) = 0 then 'this makes this the default if we don't recognize anything WriteDataSources false end if ' this can appear together with any of the others if Len(Request("delete")) > 0 then DeleteRaw Request("delete") end if if Err then WriteError end if sub RaiseError(number, description) Err.Raise number, "xml.info6.asp", description end sub ' ----------------------------------------------------------------------------- ' Write out the list of available datasources. XML format: ' ' ' [...]* sub WriteDataSources(all) dim fileSystem dim folder dim file dim baseName dim prevName set fileSystem = CreateObject("Scripting.FileSystemObject") set folder = fileSystem.GetFolder(GetDataSourcePath()) Response.Write "" & vbCrLf for each file in folder.files if ucase(fileSystem.GetExtensionName(file)) = "XDS" then baseName = fileSystem.GetBaseName(file) if all then Response.Write " " & baseName & ".xds" & vbCrLf elseif baseName <> prevName then Response.Write " " & baseName & "" & vbCrLf prevName = baseName end if end if next Response.Write "" & vbCrLf end sub ' ----------------------------------------------------------------------------- ' Write out raw datasource file. sub GetRaw(dstype) dsfilename = GetDataSourcePath() & dstype set doc = getLatestXML() doc.async = false doc.load dsfilename Response.Write doc.xml end sub ' ----------------------------------------------------------------------------- ' Write into raw datasource file. sub PutRaw(dstype, data) dsfilename = GetDataSourcePath() & dstype set doc = getLatestXML() doc.async = false doc.loadxml data doc.save dsfilename end sub ' ----------------------------------------------------------------------------- ' Delete raw datasource file. sub DeleteRaw(dstype) dsfilename = GetDataSourcePath() & dstype set fileSystem = CreateObject("Scripting.FileSystemObject") fileSystem.DeleteFile dsfilename, true end sub ' ----------------------------------------------------------------------------- ' Write out datasource schema as XML. sub WriteDataSourceSchema(dstype) dsfilename = GetDataSourcePath() & dstype & ".XDS" set doc = getLatestXML() doc.async = false doc.load dsfilename if Len(Request("test")) > 0 then xslurl = doc.documentElement.getAttribute("xslurl") if doc.documentElement.getAttribute("single") = "true" then firstRecord = "/*[0]" else firstRecord = "/*/*[0]" end if xmlurl = Request("xml") if Len(xmlurl) = 0 then xmlurl = doc.documentElement.getAttribute("xmlurl") else xmlurl = AbsolutePath(Request("test"), xmlurl) end if set xml = SafeLoad(xmlurl) set fields = doc.documentElement.childNodes if Len(xslurl) > 0 then xml.transformNodeToObject SafeLoad(xslurl), doc else set doc = xml end if set data = doc.selectSingleNode(firstRecord) Response.Write "" & vbCrLf Response.Write " " & vbCrLf DisplayValues fields, data Response.Write " " & vbCrLf Response.Write "" & vbCrLf else Response.Write "" & vbCrLf DisplayRowset doc.documentElement, 1 Response.Write "" & vbCrLf end if end sub ' ----------------------------------------------------------------------------- ' Analyze documents and write out the default datasource document. sub Analyze(xmlurl) DisplayDoc SafeLoad(xmlurl) end sub sub TransformAndAnalyze(xmlurl, xslurl) set xml = SafeLoad(xmlurl) set xsl = SafeLoad(xslurl) set doc = getLatestXML() doc.async = False xml.transformNodeToObject xsl, doc DisplayDoc doc end sub sub DisplayDoc(doc) Response.Write "" & vbCrLf if Request("single") = "true" then Display doc, "/*", 1 else Display doc, "/*/*", 1 end if Response.Write "" & vbCrLf end sub sub Display(doc, path, depth) depthstring = String(depth * 4, " ") set attribs = doc.selectNodes(path & "/@*") set children = doc.selectNodes(path & "/*") if (attribs.length + children.length) > 0 then Response.Write depthstring & "" & vbCrLf set fields = GetSet() for each attrib in attribs fields.Add attrib.nodeName next for each field in fields.Members Response.Write depthstring & "" & vbCrLf next set childNames = GetSet() for each child in children childNames.Add child.nodeName next for each name in childNames.Members Response.Write depthstring & "" & vbCrLf Display doc, path & "/" & name, depth + 1 Response.Write depthstring & "" & vbCrLf next else Response.Write depthstring & "" & vbCrLf end if end sub ' ----------------------------------------------------------------------------- ' Write out an error message as XML. sub WriteError dim qt qt = chr(34) Response.Write "" & vbCrLf end sub %>