<%@ language = "VBScript" %> <% option explicit %> ASP Project Parser <% handleParserOutput %> <% sub handleParserOutput dim topPath dim projectTitle dim prePath dim maxDepth projectTitle = request.queryString("title") topPath = request.queryString("path") prePath = request.queryString("prePath") maxDepth = request.queryString("maxDepth") if cStr(maxDepth) = "" then maxDepth = -1 %>

<% = projectTitle %>
Path: <% = topPath %>

<% if cStr(topPath) <> "" then showAspsFromPath topPath, prePath, maxDepth end if end sub sub showAspsFromPath(topPath, prePath, maxDepth) dim fileSystemTree dim fileTree dim asps dim asp dim xPath dim localPath server.ScriptTimeOut = 40 set fileSystemTree = new classFileSystemTree fileSystemTree.url = topPath fileSystemTree.prePath = prePath fileSystemTree.maxDepth = maxDepth fileSystemTree.create set fileTree = fileSystemTree.getTree xPath = "//file[@type = 'asp']" set asps = fileTree.selectNodes(xPath) for each asp in asps localPath = asp.getAttribute("localPath") %>
 Toggle ASP display  <% = cutExtension( asp.getAttribute("name") ) %> | Folder: " ><% = asp.parentNode.getAttribute("name") %> | File: Open... | Last modified: <% = asp.getAttribute("dateLastModified") %> | <% = asp.getAttribute("sizeKB") %> KB |
<% = getParsedAsp(localPath) %>
<% next end sub function getParsedAsp(aspPath) const xmlAspTemplate = "" dim xmlAsp dim aspText dim xhtml set xmlAsp = getXmlString(xmlAspTemplate) aspText = getFileTextAbsolute(aspPath) collectSubFunctions xmlAsp, aspText, "function" collectSubFunctions xmlAsp, aspText, "sub" adaptSubFunctions xmlAsp breakUpParameters xmlAsp xhtml = transformScript(xmlAsp) xhtml = replace(xhtml, "[[[", "<") xhtml = replace(xhtml, "]]]", ">") xhtml = replace(xhtml, "<", "<") xhtml = replace(xhtml, ">", ">") xhtml = replace(xhtml, "&", "&") xhtml = xhtml & vbNewline & vbNewline getParsedAsp = xhtml end function function transformScript(xmlAsp) const xsltPath = "xhtml.xsl" dim xslt dim xhtml set xslt = getXml(xsltPath) xhtml = xmlAsp.transformNode(xslt) transformScript = xhtml end function sub breakUpParameters(xmlAsp) dim functionNodes dim functionNode dim parameters dim parameterArray dim i dim parameterNode dim parametersNode set functionNodes = xmlAsp.selectNodes("//function") for each functionNode in functionNodes parameters = functionNode.getAttribute("parameters") if not isNull(parameters) then parameterArray = split(parameters, ",") if uBound(parameterArray) >= 0 then set parametersNode = xmlAsp.createElement("parameters") for i = lBound(parameterArray) to uBound(parameterArray) set parameterNode = xmlAsp.createElement("parameter") parameterNode.text = trim( parameterArray(i) ) parametersNode.appendChild parameterNode next functionNode.appendChild parametersNode functionNode.removeAttribute "parameters" end if end if next end sub sub adaptSubFunctions(xmlAsp) dim functionNodes dim functionNode dim text dim functionName dim startsAt dim endsAt dim parameters dim nameOf dim contentNode dim nextLineBreak set functionNodes = xmlAsp.selectNodes("//function") for each functionNode in functionNodes text = functionNode.text functionNode.text = "" startsAt = instr(1, text, "(") nextLineBreak = instr(1, text, chr(10) ) if startsAt >= 1 and startsAt < nextLineBreak then endsAt = instr(startsAt + 1, text, ")") if endsAt >= 1 then nameOf = mid(text, 1, startsAt - 1) functionNode.setAttribute "name", trim(nameOf) startsAt = startsAt + 1 parameters = mid(text, startsAt, endsAt - startsAt) functionNode.setAttribute "parameters", trim(parameters) end if else endsAt = instr( 1, text, chr(10) ) if endsAt >= 1 then nameOf = mid(text, 1, endsAt - 1) functionNode.setAttribute "name", trim(nameOf) endsAt = endsAt - 1 end if end if set contentNode = xmlAsp.createElement("content") if len(endsAt + 2) < len(text) then contentNode.text = mid(text, endsAt + 2) end if contentNode.text = formatContentNode(contentNode) functionNode.appendChild contentNode next end sub function formatContentNode(contentNode) dim keywords dim keyword dim text dim nameOf dim keywordType text = contentNode.xml text = replace(text, "", "") text = replace(text, "", "") text = replace(text, " ", " ") text = text & chr(13) set keywords = getXml("keywords.xml").selectNodes("//keyword") for each keyword in keywords nameOf = keyword.getAttribute("name") keywordType = keyword.parentNode.nodeName text = alterKeyword(text, nameOf, keywordType) next text = left( text, len(text) - len( chr(13) ) ) formatContentNode = text end function function alterKeyword(parText, keyword, parKeywordType) dim text dim keywordType keywordType = toProperCase(parKeywordType) text = parText text = replaceByContext(text, keyword, keywordType, " ", " ") if keywordType = "Structure" then text = replaceByContext(text, keyword, keywordType, " ", chr(13)) elseif keywordType = "Function" then text = replaceByContext(text, keyword, keywordType, " ", "(") elseif keywordType = "Object" then text = replaceByContext(text, keyword, keywordType, " ", ".") end if alterKeyword = text end function function replaceByContext(parText, keyword, keywordType, before, after) const textCompare = 1 dim spanStart dim spanEnd dim text spanStart = "[[[span class=""keyword" & keywordType & """" & _ " onclick=""clickKeyword('" & keyword & "')""]]]" spanEnd = "[[[/span]]]" text = parText text = replace(text, before & keyword & after, _ before & spanStart & keyword & spanEnd & after, 1, -1, textCompare) replaceByContext = text end function sub collectSubFunctions(xmlAsp, aspText, stringOf) const subString = "function " dim functionElement dim functionText dim startsAt dim endsAt dim foundOne dim startString dim endString dim lowerAspText lowerAspText = lCase(aspText) startString = stringOf & " " endString = "end " & stringOf startsAt = 0 do foundOne = false startsAt = instr(startsAt + 1, lowerAspText, startString) if startsAt >= 1 then endsAt = instr(startsAt + 1, lowerAspText, endString) if endsAt >= 1 then startsAt = startsAt + len(startString) functionText = mid(aspText, startsAt, endsAt - startsAt) set functionElement = xmlAsp.createElement("function") functionElement.setAttribute "type", toProperCase(stringOf) functionElement.text = functionText xmlAsp.documentElement.appendChild functionElement foundOne = true end if end if loop until not foundOne end sub %>