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")
%>
<%
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
%>