>Source code for http://<%=Request.ServerVariables("SERVER_NAME") %>/<%=Request.QueryString("source") %>
COLOR LEGEND
| ") Response.Write(" | " & arrColorLegend(iCounter,0)) Response.Write(" |
View Active Server Page Source-- Access Denied
The code you have attempted to view has been placed in a secure directory and is Not
viewable. <%
End If
End If
%>
<% '------------------------------------------------------------------------------------ 'This function maps the source file and initialize the file reading Sub InitFileReading(fScript, fObjectFile, fFileError) On Error Resume Next strVirtualPath = Request.QueryString("source") If strVirtualPath <> "" Then fScript = FALSE fObjectFile = FALSE 'Mapping the virtual file path to its physical full path strFilename = Server.MapPath(strVirtualPath) If err.number <> 0 Then Response.Write("
")
'the two blocks in the following If-Else statements are containing the same
'codes except for calling either PrintObjectLine or FPrintASPLine.
'The reason I do Not merge the two blocks into one by using a flag is because
'it would be too expensive to determine every time which functions to call according
'to the flag when this needs to be executed numerous times.
strNumbered = Request.QueryString("numbered")
If fObjectFile Then
Do Until oInStream.AtEndOfStream
strOutput = oInStream.ReadLine
If err.number <> 0 Then
Response.Write("
Error Processing File!
")
exit Sub
End If
If strNumbered<>"" Then
iLineCount = iLineCount + 1
Response.Write("" & FmtdLineNum(iLineCount))
End If
Call PrintObjectLine(strOutput)
Response.Write("
")
Loop
Else
Do Until oInStream.AtEndOfStream
strOutput = oInStream.ReadLine
If err.number <> 0 Then
Response.Write("
Error Processing File!
")
exit Sub
End If
If strNumbered<>"" Then
iLineCount = iLineCount + 1
Response.Write("" & FmtdLineNum(iLineCount))
End If
fScript = FPrintASPLine(strOutput, fScript)
Response.Write("
")
Loop
End If
Response.Write("")
End Sub
'------------------------------------------------------------------------------------
' The security is currently set to the second method,
' with the directory /Secure/ as our private directory.
' You can either keep this method, keep this method and
' change the private directory, or add an additional directory.
'
' You can also switch security methods by changing the
' "= 0" to "<> 0", and the pointing to the directory
' that you want to be viewable.
Function FValidPath (ByVal strPath)
FValidPath = (InStr(1, strPath, "/SECURE/", 1) = 0)
End Function
'------------------------------------------------------------------------------------
'Returns the minimum number greater than 0
'If both are 0, returns -1
'this Function is used to get the precedence of keywords
Function IMin (iNum1, iNum2)
If iNum1 = 0 AND iNum2 = 0 Then
IMin = -1
ElseIf iNum2 = 0 Then
IMin = iNum1
ElseIf iNum1 = 0 Then
IMin = iNum2
ElseIf iNum1 < iNum2 Then
IMin = iNum1
Else
IMin = iNum2
End If
End Function
'------------------------------------------------------------------------------------
'This Function returns the number of occurrence of strToken within the string strInString
Function CTokenOccurrence(ByVal strInString, ByVal strToken)
Dim iPos 'temporary index for doing the counting
CTokenOccurrence = 0
iPos = InStr(1, strInString, strToken, 1)
If iPos <> 0 Then
do until iPos = 0
CTokenOccurrence = CTokenOccurrence + 1
iPos = InStr(iPos + 1, strInString, strToken, 1)
loop
End If
End Function
'------------------------------------------------------------------------------------
'Finding the virtual path excluding the filename
Function StrGetFullRelativePath(ByVal strVirtualFileName)
Dim iPos 'temporary index for doing the mapping
iPos = InStrRev(strVirtualFileName, "/", -1)
If iPos <> 0 Then
StrGetFullRelativePath = Left(strVirtualFileName, iPos)
Else
StrGetFullRelativePath = ""
End If
End Function
'------------------------------------------------------------------------------------
'this function retrieves the hyperlink of a string and breaks down the string
'into 3 parts: strLeftString storing the thing left to the hyperlink
' strRightString storing the thing right to teh hyperlink
' strHyperLink storing the HTML tagged hyperlink
Sub GetHyperLink(ByVal strFullString, strHyperLink, strLeftString, strRightString)
Dim strPageLink 'temporary string storing the hyperlink location
Dim iStartPos 'index indicating the beginning of the hyperlink
Dim iEndPos 'index indicating the Ending of the hyperlink
strHyperLink = ""
strLeftString = ""
strRightString = ""
iStartPos = InStr(1, strFullString, chDoubleQuote, 1)
strLeftString = Left(strFullString, iStartPos)
strFullString = Right(strFullString, Len(strFullString) - iStartPos)
iEndPos = InStr(1, strFullString, chDoubleQuote, 1)
strPageLink = Left(strFullString, iEndPos - 1)
'check to see If we are dealing with full relative link or Not
If Left(strPageLink,1) <> "/" Then
strHyperLink = StrGetFullRelativePath(strVirtualPath)
If strHyperLink = "" Then
strHyperLink = "/"
End If
strHyperLink = strHyperLink & strPageLink
Else
strHyperLink = strPageLink
End If
strRightString = Right(strFullString, Len(strFullString) - iEndPos + 1)
strHyperLink = Request.ServerVariables("SCRIPT_NAME") & "?source=" & strHyperLink
strHyperLink = "" & strPageLink & ""
End Sub
'------------------------------------------------------------------------------------
'This Function parse a line (or a Sub-line) in asp files and look for
'keywords and set the precedence for them from left to right.
'In aNother word, the leftmost keyword found will have the highest
'precedence. This Function is returning the code which determines which
'keyword that we are working on.
Function ICheckASPLineForKeyWords (ByVal strLine, ByVal fInScript, iCurrentIndex)
Dim iPos 'variable that holds the offset of keywords in the string
Dim iKeyWord 'variable that holds the index of the keyword
ICheckASPLineForKeyWords = 0
iCurrentIndex = 0
for iKeyWord = LBound(arrASPKeyWordList) to UBound(arrASPKeyWordList)
iPos = InStr(1, strLine, arrASPKeyWordList(iKeyWord), 1)
If IMin(iCurrentIndex, iPos) = iPos Then
iCurrentIndex = iPos
'Both IFRAME and FRAME have the same index
If ((iKeyWord + 1) = IFRAMEOpen) Or ((iKeyWord - 1) = IFRAMEOpen) Then
ICheckASPLineForKeyWords = IFRAMEOpen
ElseIf ((iKeyWord + 1) = IFRAMEClose) Or ((iKeyWord - 1) = IFRAMEClose) Then
ICheckASPLineForKeyWords = IFRAMEClose
Else
ICheckASPLineForKeyWords = iKeyWord + 1
End If
End If
next
'We are treating comments in a special way.
'We will only work on them If there's no other keywords found
'in the current line or Sub-line. This gurantee that no keyword
'will be omitted If they are after the comment tag.
iPos = InStr(1, strLine, "REM", 1) 'Testing of quote checking
If (iCurrentIndex = 0 And iPos <> 0 And fInScript) Then
iCurrentIndex = iPos
ICheckASPLineForKeyWords = iComment
End If
iPos = InStr(strLine, "'") REM Testing of quote checking
'fInScript tells If the current line is within a scripting tag
If (iCurrentIndex = 0 And iPos <> 0 And fInScript) Then
iCurrentIndex = iPos
ICheckASPLineForKeyWords = iComment
End If
End Function
'------------------------------------------------------------------------------------
'This Function encodes and print out a HTML line
Sub PrintHTML (ByVal strLine)
Dim cSpaces 'number of spaces
Dim iPos 'index for doing the encoding
Dim iLooper 'index for doing the looping
cSpaces = Len(strLine) - Len(LTrim(strLine))
iLooper = 1
'handling tabs and we make it equal to 2 spaces
While Mid(Strline, iLooper, 1) = chTab
cSpaces = cSpaces + 2
iLooper = iLooper + 1
WEnd
If cSpaces > 0 Then
For iLooper = 1 to cSpaces
Response.Write(" ")
Next
End If
iPos = InStr(strLine, "<")
If iPos Then
Response.Write(Left(strLine, iPos - 1))
Response.Write("<")
strLine = Right(strLine, Len(strLine) - iPos)
Call PrintHTML(strLine)
Else
Response.Write(Server.HTMLEncode(strLine))
End If
End Sub
'------------------------------------------------------------------------------------
'we are dealing with the open asp tag here
Function FHandleASPOpen(ByVal strLine, ByVal iPos)
Call PrintHTML(Left(strLine, iPos - 1))
Response.Write("")
Response.Write("<%")
FHandleASPOpen = FPrintASPLine(Right(strLine, Len(strLine) - (iPos + 1)), TRUE)
End Function
'------------------------------------------------------------------------------------
'we are dealing with the closing asp tag here
Function FHandleASPClose(ByVal strLine, ByVal iPos)
Call FPrintASPLine(Left(strLine, iPos - 1), TRUE)
Response.Write("%>")
Response.Write("")
FHandleASPClose = FPrintASPLine(Right(strLine, Len(strLine) - (iPos + 1)), FALSE)
End Function
'------------------------------------------------------------------------------------
'we are dealing with the open script tag here
Function FHandleScriptOpen(ByVal strLine, ByVal iPos)
Dim iTempPos1 'temporary index for checking client or server script
Dim iTempPos2 'temporary index for checking client or server script
Dim strRightString 'stores the chopped part to the right of the string
Call PrintHTML(Left(strLine, iPos - 1))
strRightString = Right(strLine, Len(strLine) - (iPos + 6))
'checking to see If the SCRIPT tag is for client side
'or for server side
iTempPos1 = InStr(1, strRightString, "server", 1)
iTempPos2 = InStr(strRightString, ">")
'determining whether we are handling server side scripting or
'client side scripting, and rEnder the corresponding color
If iTempPos1 <> 0 Then
If iTempPos2 <> 0 Then
If iTempPos1 < iTempPos2 Then
Response.Write("")
Else
Response.Write("")
End If
Else
Response.Write("")
End If
Else
Response.Write("")
End If
Response.Write("<SCRIPT")
FHandleScriptOpen = FPrintASPLine(strRightString, TRUE)
End Function
'------------------------------------------------------------------------------------
'we are dealing with the closing script tag here
Function FHandleScriptClose(ByVal strLine, ByVal iPos)
Call FPrintASPLine(Left(strLine, iPos - 1), TRUE)
Response.Write("</SCRIPT>")
Response.Write("")
FHandleScriptClose = FPrintASPLine(Right(strLine, Len(strLine) - (iPos + 8)), FALSE)
End Function
'------------------------------------------------------------------------------------
'we are dealing with the include tag here
Function HandleIncludeTag(ByVal strLine, ByVal iPos, ByVal fInScript)
Dim strHyperLink 'stores the HTML tagged hyperlink
Dim strLeftString 'stores the chopped part to the left of the string
Dim strRightString 'stores the chopped part to the right of the string
Call PrintHTML(Left(strLine, iPos - 1))
Response.Write("")
Response.Write("<!--#INCLUDE")
'finding the hyperlink of the INCLUDE by trapping for the two double quotes around it
Call GetHyperLink(Right(strLine, Len(strLine) - iPos - 11), strHyperLink, strLeftString, strRightString)
Call FPrintASPLine(strLeftString, fInScript)
Response.Write(strHyperLink)
iPos = InStr(1, strRightString, "-->", 1)
Call FPrintASPLine(Left(strRightString, iPos - 1), fInScript)
Response.Write("-->")
Response.Write("")
If len(strRightString) - iPos > 3 Then
HandleIncludeTag = FPrintASPLine(Right(strRightString, Len(strRightString) - iPos - 3), fInScript)
End If
End Function
'------------------------------------------------------------------------------------
'we are dealing with the FRAME and IFRAME tags here
Function HandleFrameOpen(ByVal strLine, ByVal fInScript)
Dim iPos 'temporary index for parsing the (sub) string
Dim strHyperLink 'stores the HTML tagged hyperlink
Dim strLeftString 'stores the chopped part to the left of the string
Dim strRightString 'stores the chopped part to the right of the string
iPos = InStr(1, strLine, "<" & "IFRAME", 1)
If iPos <> 0 Then
'we have a IFRAME tag
Call PrintHTML(Left(strLine, iPos - 1))
Response.Write("")
Response.Write("<IFRAME")
strLine = Right(strLine, Len(strLine) - iPos - 6)
Else
'we have a FRAME tag
iPos = InStr(1, strLine, "<" & "FRAME", 1)
Call PrintHTML(left(strLine, iPos - 1))
Response.Write("")
Response.Write("<FRAME")
strLine = Right(strLine, Len(strLine) - iPos - 5)
End If
iPos = InStr(1, strLine, "SRC", 1)
Call FPrintASPLine(Left(strLine, iPos - 1), fInScript)
'finding the hyperlink of the FRAME/IFRAME by trapping for the two double quotes around it
Call GetHyperLink(Right(strLine, Len(strLine) - iPos + 1), strHyperLink, strLeftString, strRightString)
Call FPrintASPLine(strLeftString, fInScript)
Response.Write(strHyperLink)
HandleFrameOpen = FPrintASPLine(strRightString, fInScript)
End Function
'------------------------------------------------------------------------------------
'we are dealing with the FRAME and IFRAME tags here
Function HandleFrameClose(ByVal strLine, ByVal fInScript)
Dim iPos 'temporary index for parsing the (sub) string
Dim strHyperLink 'stores the HTML tagged hyperlink
Dim strLeftString 'stores the chopped part to the left of the string
Dim strRightString 'stores the chopped part to the right of the string
iPos = InStr(1, strLine, "<" & "/IFRAME>", 1)
If iPos <> 0 Then
'we have a IFRAME tag
Call PrintHTML(Left(strLine, iPos - 1))
Response.Write("</IFRAME>")
Response.Write("")
HandleFrameClose = FPrintASPLine(Right(strLine, Len(strLine) - (iPos + 8)), FALSE)
Else
'we have a FRAME tag
iPos = InStr(1, strLine, "<" & "/FRAME>", 1)
Call PrintHTML(Left(strLine, iPos - 1))
Response.Write("</FRAME>")
Response.Write("")
HandleFrameClose = FPrintASPLine(Right(strLine, Len(strLine) - (iPos + 7)), FALSE)
End If
End Function
'------------------------------------------------------------------------------------
'we are dealing with commenting here
Sub HandleCommentTag(ByVal strLine, ByVal iPos, ByVal fInScript)
Dim strHyperLink 'stores the HTML tagged hyperlink
Dim strLeftString 'stores the chopped part to the left of the string
Dim strRightString 'stores the chopped part to the right of the string
strLeftString = Left(strLine, iPos - 1)
Call FPrintASPLine(strLeftString, fInScript)
strRightString = Right(strLine, Len(strLine) - iPos + 1)
'checking to see If we are inside a string bounded by 2 double quotes
If ((CTokenOccurrence(strLeftString, """") mod 2) = 0) And fInScript Then
Response.Write("")
iPos = InStr(1, strRightString, "OBJECTCODE", 1)
If iPos <> 0 Then
CAll PrintHTML(Left(strRightString, iPos - 1))
Response.Write("")
'finding the hyperlink of the VB object by trapping for the two double quotes
'around it
Call FindHyperLink(Right(strRightString, Len(strRightString) - iPos + 1), strHyperLink, strLeftString, strRightString)
Call PrintHTML(strLeftString)
Response.Write(strHyperLink)
Response.Write("")
End If
Call PrintHTML(strRightString)
Response.Write("")
Else
'Jump over the void quote or void REM in the string and to check to
'see If there's commenting further down the string
iPos = InStr(strRightString, chDoubleQuote)
If iPos = 0 Then
Call FPrintASPLine(strRightString, fInScript)
Else
Call PrintHTML(Left(strRightString, iPos - 1))
Response.Write("""")
Call FPrintASPLine(Right(strRightString, Len(strRightString) - iPos), fInScript)
End If
End If
End Sub
'------------------------------------------------------------------------------------
'This Function rebuilt and prints out the line according
'to the current keyword that we are working on
Function FPrintASPLine(ByVal strLine, ByVal fInScript)
Dim iKeyWordIndex 'index of the key word that we need to work on
Dim iKeyWordPos 'index of the picked key word in the string
FPrintASPLine = fInScript
iKeyWordIndex = ICheckASPLineForKeyWords(strLine, fInScript, iKeyWordPos)
Select Case iKeyWordIndex
Case 0
Call PrintHTML(strLine)
Case iASPOpen
FPrintASPLine = FHandleASPOpen(strLine, iKeyWordPos)
Case iASPClose
FPrintASPLine = FHandleASPClose(strLine, iKeyWordPos)
Case iScriptOpen
FPrintASPLine = FHandleScriptOpen(strLine, iKeyWordPos)
Case iScriptClose
FPrintASPLine = FHandleScriptClose(strLine, iKeyWordPos)
Case iInclude
FPrintASPLIne = HandleIncludeTag(strLine, iKeyWordPos, fInScript)
Case IFRAMEOpen
FPrintASPLIne = HandleFrameOpen(strLine, fInScript)
Case IFRAMEClose
FPrintASPLIne = HandleFrameClose(strLine, fInScript)
Case iComment
Call HandleCommentTag(strLine, iKeyWordPos, fInScript)
Case Else
Response.Write("Function ERROR -- PLEASE CONTACT ADMIN.")
End Select
End Function
'------------------------------------------------------------------------------------
'This Function parse a line (or a Sub-line) in VB source code and look for
'keywords and set the precedence for them from left to right.
'In aNother word, the leftmost keyword found will have the highest
'precedence. This Function is returning the code which determines which
'keyword that we are working on.
Function ICheckObjectLineForKeyWords (ByVal strLine)
Dim arrASPKeyWordList(6) 'array that stores all the key words excluding comments
Dim iTemp 'variable that holds the current leftmost keyword offset
Dim iPos 'variable that holds the offset of keywords
Dim iKeyWord 'variable that holds the index of the keyword
ICheckObjectLineForKeyWords = 0
iTemp = 0
arrASPKeyWordList(0) = "End" : arrASPKeyWordList(1) = "Function"
arrASPKeyWordList(2) = "Sub" : arrASPKeyWordList(3) = "property"
arrASPKeyWordList(4) = " as " : arrASPKeyWordList(5) = "Dim "
arrASPKeyWordList(6) = "'" : arrASPKeyWordList(7) = "REM"
for iKeyWord = LBound(arrASPKeyWordList) to UBound(arrASPKeyWordList)
iPos = InStr(1, strLine, arrASPKeyWordList(iKeyWord), 1)
If IMin(iTemp, iPos) = iPos Then
iTemp = iPos
If (iKeyWord = 5) OR (iKeyWord = 8) Then
ICheckObjectLineForKeyWords = iKeyWord
Else
ICheckObjectLineForKeyWords = iKeyWord + 1
End If
End If
next
End Function
'------------------------------------------------------------------------------------
'This function formats line numbers with leading zeros and one trailing space for
'numbered formatted source code output. Added by Brad Berson.
Function FmtdLineNum (ByVal iLineCount)
FmtdLineNum = String(5-LEN(iLineCount),"0") & iLineCount & " "
End Function
'------------------------------------------------------------------------------------
'This function prints out the lines of VB objects
'Note. Please ignore this function for now
Sub PrintObjectLine (ByVal strLine)
Dim iKeyWordIndex
iKeyWordIndex = ICheckObjectLineForKeyWords(strLine)
Select Case iKeyWordIndex
Case 0
Call PrintHTML(strLine)
Case 1
Call PrintHTML(strLine)
If instr(1, strLine, "Function", 1) <> 0 Then
Response.Write("")
Response.Write("