<% ' original program from www.asp101.com ' modified to display the entire file rather than just the scripts ' added return footer ' added second parameter for more meaningful header Dim objFSO, objInFile Dim strIn, strTemp Dim I, J Dim strFileName Dim ProcessString Dim bCharWritten Dim bInsideScript Dim bInsideString Dim iInsideComment Dim strSourceApp Dim strRef ProcessString = 0 bCharWritten = False bInsideScript = False bInsideString = False iInsideComment = 0 strRef = request.servervariables("http_referer") strFileName = Request.QueryString("file") response.Write "<head>" & vbNewLine response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=utf-8"" />" & vbNewLine response.Write "</head>" & vbNewLine response.Write "<body>" & vbNewLine response.Write "<B>ASP Source Code: " & strRef & " - " & strFileName & "</B><HR>" & vbNewLine ' Conditional limiting use of this file If InStr(1, strFileName, "\", 1) Then strFileName="" If InStr(1, strFileName, "/", 1) Then strFileName="" If strFileName <> "" Then Set objFSO = CreateObject("Scripting.FileSystemObject") Set objInFile = objFSO.OpenTextFile(Server.MapPath(strFileName)) Response.Write "<PRE>" & vbCRLF ' Loop Through Real File and Output Results to Browser Do While Not objInFile.AtEndOfStream strIn = Server.HTMLEncode(objInFile.ReadLine) strTemp = "" For I = 1 to Len(strIn) bCharWritten = False If InStr(I, strIn, "<%", 1) = I Then strTemp = strTemp & "<FONT COLOR=#0000FF>" bInsideScript = True Else If InStr(I, strIn, "%>", 1) = I Then strTemp = strTemp & "%></FONT>" bCharWritten = True ' so we dont get the trailing end of this tag again! ' ie. Len("%>") - 1 = 4 I = I + 4 bInsideScript = False End If End If ' Toggle Inside String if needed! If bInsideScript And iInsideComment = 0 And InStr(I, strIn, """, 1) = I Then bInsideString = Not bInsideString ' Now do comments if we're in script If bInsideScript And Not bInsideString And InStr(I, strIn, "'", 1) = I Then strTemp = strTemp & "<FONT COLOR=#009900>" iInsideComment = iInsideComment + 1 End If ' End comment at end of line if needed If iInsideComment > 0 And I = Len(strIN) Then strTemp = strTemp & Mid(strIn, I, 1) For J = 1 to iInsideComment strTemp = strTemp & "</FONT>" Next 'J bCharWritten = True iInsideComment = 0 End If If bCharWritten = False Then strTemp = strTemp & Mid(strIn, I, 1) End If Next Response.Write strTemp & vbCRLF Loop Response.Write "</PRE>" & vbCRLF objInFile.Close Set objInFile = Nothing Set objFSO = Nothing End If response.Write "<P><HR><P>" & vbNewLine response.Write "<FORM ACTION=""" & strRef & """" response.Write " METHOD=""get"">" & vbNewLine response.Write "<INPUT NAME=""Submit"" TYPE=""Submit"" " response.Write "Value=" & chr(34) & "Return" & chr(34) & ">" & vbNewLine response.Write "</FORM>" & vbNewLine response.Write "</body>" %>