<% option explicit %> <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"> <HTML> <HEAD> <TITLE> Script Reader </TITLE> <STYLE> BODY { font-family: "sans-serif"; bgcolor: "#FFFFFF"; } PRE { font-family: "monospaced"; } #statement { color: "#0000FF"; /* Color for Script Statements (things like Call, Dim, If...Then...Else, etc) */ } #function { color: "#FF0000"; /* Color for Script Functions (things like Instr, Abs, etc) */ } #script { color: "#800000"; /* Color for anything that is not in one of the above script categories, but is contained inside script delimeters */ } #scripton { color: "#FF00FF"; /* Color for anything that is not in one of the above script categories, but is contained inside script delimeters, inside quotation marks */ } #html { color: "#0000FF"; /* Color for any non-script html output */ } #base { color: "#000000"; /* Color for any non-script, non-html output */ } #comment { color: "#008000"; /* Color for any commented code */ } #linenum { color: "#808080"; /* Color for the line numbers */ } </STYLE> </HEAD> <BODY> <% Dim fs '{{ Our instance of the filesystembobject Dim ourfile '{{ The name of the file to be read and interpreted Dim readstream '{{ Our connection to the file that we are reading Dim ourline '{{ The line read from the file that we are currently working with Dim linenum '{{ Incrementing value used to display the line number Dim inscript '{{ Our variable for determining whether we are reading script or straight html Dim beginscript '{{ Location in string that script delimeter was found Dim endscript '{{ Location in string that closing script delimeter was found Dim scriptstr() '{{ An array that holds all of the strings that exists between script delimeters Dim quoted() '{{ An array that will hold all of the strings that are contained between quotation marks Dim beginquote '{{ A variable that holds the location of the first occurrance of the quote in a string Dim endquote '{{ A variable that holds the location of the next occurrance of the quote in a string Dim HTMLcommentstr '{{ A variable to hold all of the HTML commented code for a line Dim commentstr() '{{ An array that holds all of the commented code for a line Dim iscomment '{{ Acts as an on/off switch when commented code is detected Dim isHTMLcomment '{{ Acts as an on/off switch when commented HTML is detected Dim begincomment '{{ A variable that holds the location of a begin comment delimeter Dim endcomment '{{ A variable that holds the location of an end comment delimeter Dim statementsArr '{{ Array that contains all of the statement words that should be identified Dim functionArr '{{ Array that contains all of the function words that should be identified Dim curitem '{{ Array item that we are currently working with Dim i '{{ Incrementing value for looping through array Dim x '{{ Another incrementing value for looping through array Dim y '{{ What do you think? Another incrementing value for looping through arrays Dim z '{{ Yet another incrementing value for looping through yet another array Dim curpos '{{ Incrementing value for moving through a string '{{ Any Statements that should be identified by a particular color... these are the standard VBScript Statements statementsArr = Array("Call ", "Const ", "Dim ", "Do While ", "Do Until ", "Erase ", "Exit ", "For ", "For Each ", "Next", "Function ","End Function", "If ", "Then ", "Then", "End If", "Else", "ElseIf", "On Error", "On Error Resume Next", "Option Explicit", "Private ", "Public ", "Randomize ", "Redim ", "Select Case ", "Case ", "Set ", "Sub ", "End Sub", "While ", "Wend", "Not ", "Is ", "Nothing", "Empty", "Null", " To ") '{{ Any Functions that should be identified by a particular color... these are the standard VBScript Functions functionArr = Array("Abs(", "IsArray(", "Array(", "Asc(", "Atn(", "CBool(", "CByte(", "CCur(", "CDate(", "CDbl(", "Chr(", "CInt(", "CLng(", "Cos(", "CreateObject(", "CSng(", "CStr(", "Date(", "DateAdd(", "DateDiff(", "DatePart(", "DateSerial(", "DateValue(", "Day(", "Exp(", "Filter(", "Fix(", "FormatCurrency(", "FormatDateTime(", "FormatNumber(", "FormatPercent(", "GetObject(", "Hex(", "Hour(", "InputBox(", "InStr(", "InStrRev(", "Int(", "IsDate(", "IsEmpty(", "IsNull(", "IsNumeric(", "IsObject(", "Join(", "LBound(", "LCase(", "Left(", "Len(", "LoadPicture(", "Log(", "LTrim(", "Mid(", "Minute(", "Month(", "MonthName(", "MsgBox(", "Now(", "Oct(", "Replace(", "RGB(", "Right(", "Rnd(", "Round(", "RTrim(", "ScriptEngine(", "ScriptEngineBuildVersion(", "ScriptEngineMajorVersion(", "ScriptEngineMinorVersion(", "Second(", "Sgn(", "Sin(", "Space(", "Split(", "Sqr(", "StrComp(", "StrReverse(", " String(", "Tan(", "Time(", "TimeSerial(", "TimeValue(", "Trim(", "TypeName(", "UBound(", "UCase(", "VarType(", "Weekday(", "WeekdayName(", "Year(") Function Occurrance(str,searchfor) '{{ Counts the number of times the specified searchfor string appears in a string Dim strcount strcount = 0 curpos = 1 Do while Instr(curpos,str,searchfor) <> 0 strcount = strcount + 1 curpos = Instr(curpos,str,searchfor)+1 Loop Occurrance = strcount End Function ourfile = Request("ourfile") Set fs = Server.CreateObject("Scripting.FileSystemObject") If NOT fs.FileExists(server.mappath(ourfile)) Then Set fs = Nothing Response.Write "The requested file [" & ourfile & "] could not be found." Response.End End If Set readstream = fs.OpenTextFile(server.mappath(ourfile)) linenum = 1 Response.Write "<pre>" Do Until Readstream.AtEndOfStream '{{ This is to make our line numbering all have the same number of digits... you can '{{ extend this logic out to how ever many digits you think you will need... '{{ but hundreds should be enough for most... Response.Write "<span id=""linenum"">" Select Case Len(linenum) Case 3 Response.Write linenum & "&nbsp;&nbsp;" Case 2 Response.Write "0" & linenum & "&nbsp;&nbsp;" Case 1 Response.Write "00" & linenum & "&nbsp;&nbsp;" End Select Response.Write "</span>" '{{ Read the current line from the specified file and place it in a variable ourline = ReadStream.ReadLine '{{ Replace the greater than and less than characters with the harder to write out, but '{{ easier to work with printable values '{{ If you attempt to detect % > (without the space) in code, it will end your script at that instance '{{ even if it is quoted, even if it is commented out... blah! ourline = Replace(ourline,"<","&lt;") ourline = Replace(ourline,">","&gt;") '{{ Parse out the different parts of the string that we can process with this script... ASP Script, Script, HTML, Comments '{{ Check for ASP script delimeters i = 0 Redim scriptstr(i) If inscript Then beginscript = 1 If Instr(beginscript,ourline,"%&gt;") Then endscript = Instr(beginscript,ourline,"%&gt;") + Len("%&gt;") scriptstr(i) = Mid(ourline,beginscript,endscript-beginscript) ourline = Replace(ourline,scriptstr(i),"#scriptstr" & i & "#") i = i + 1 inscript = False ElseIf Instr(beginscript,ourline,"&lt;/SCRIPT&gt;") Then endscript = Instr(beginscript,ourline,"&lt;/SCRIPT&gt;") + Len("&lt;/SCRIPT&gt;") scriptstr(i) = Mid(ourline,beginscript,endscript-beginscript) ourline = Replace(ourline,scriptstr(i),"#scriptstr" & i & "#") i = i + 1 inscript = False Else endscript = Len(ourline) + 1 scriptstr(i) = Mid(ourline,beginscript,endscript-beginscript) ourline = Replace(ourline,scriptstr(i),"#scriptstr" & i & "#") i = i + 1 inscript = True End If End If Do While i < Occurrance(ourline,"&lt;%") + i beginscript = Instr(1,ourline,"&lt;%") '{{ Check for a closing script delimeter in the same line If Instr(beginscript+1,ourline,"%&gt;") Then endscript = Instr(1,ourline,"%&gt;")+Len("%&gt;") '{{ Now we have a scripting string to process using our functions '{{ Replace the string with our script holder and add the string to our scriptstr array Redim Preserve scriptstr(i) scriptstr(i) = Mid(ourline,beginscript,endscript-beginscript) ourline = Replace(ourline,scriptstr(i),"#scriptstr" & i & "#") i = i + 1 inscript = False Else '{{ The whole line after the occurance of the script delimeter is code endscript = Len(ourline)+1 Redim Preserve scriptstr(i) scriptstr(i) = Mid(ourline,beginscript,endscript-beginscript) ourline = Replace(ourline,scriptstr(i),"#scriptstr" & i & "#") i = i + 1 inscript = True End If Loop '{{ Just to be fancy, we are checking for the <SCRIPT> tag as well... Do While i < Occurrance(UCase(ourline),"&LT;SCRIPT") + i beginscript = Instr(1,UCase(ourline),"&LT;SCRIPT") '{{ Check for a closing script delimeter in the same line If Instr(beginscript,Ucase(ourline),"&LT;/SCRIPT&GT;") Then endscript = Instr(1,UCase(ourline),"&LT;/SCRIPT&GT;")+Len("&LT;/SCRIPT&GT;") scriptstr(i) = Mid(ourline,beginscript,endscript-beginscript) ourline = Replace(ourline,scriptstr(i),"#scriptstr" & i & "#") i = i + 1 inscript = False Else '{{ The whole line after the occurance of the script delimeter is code endscript = Len(ourline) scriptstr(i) = Mid(ourline,beginscript,endscript-beginscript) ourline = Replace(ourline,scriptstr(i),"#scriptstr" & i & "#") i = i + 1 inscript = True End If Loop '{{ Replace quoted strings that appear inside of script delimeters with placeholders y = 0 Redim quoted(y) For i = 0 to Ubound(scriptstr) Do While Instr(1,scriptstr(i),"""") beginquote = Instr(1,scriptstr(i),"""") endquote = Instr(beginquote+1,scriptstr(i),"""")+1 If endquote < beginquote Then Exit Do End If If y > 0 Then Redim Preserve quoted(y) End If quoted(y) = Mid(scriptstr(i),beginquote,endquote-beginquote) scriptstr(i) = Replace(scriptstr(i),quoted(y),"#quoted" & y & "#") y = y + 1 Loop Next z = 0 Redim commentstr(z) For i = 0 to Ubound(scriptstr) endcomment = Len(scriptstr(i)) + 1 If Instr(1,scriptstr(i),"'") Then '{{ we found an ASP comment iscomment = Instr(1,scriptstr(i),"'") begincomment = Instr(1,scriptstr(i),"'") If Instr(1,scriptstr(i),"%&gt;") Then endcomment = Instr(1,scriptstr(i),"%&gt;") End If Redim Preserve commentstr(z) commentstr(z) = Mid(scriptstr(i),begincomment,endcomment-begincomment) scriptstr(i) = Replace(scriptstr(i),commentstr(z),"#commentstr" & z & "#") z = z + 1 ElseIf Instr(1,scriptstr(i),"//") Then iscomment = Instr(1,scriptstr(i),"'") '{{ we found a javascript comment begincomment = Instr(1,scriptstr(i),"//") Redim Preserve commentstr(z) commentstr(z) = Mid(scriptstr(i),begincomment,endcomment-begincomment) scriptstr(i) = Replace(scriptstr(i),commentstr(z),"#commentstr" & z & "#") z = z + 1 ElseIf Instr(1,scriptstr(i),"&lt;!--") Then iscomment = Instr(1,scriptstr(i),"'") '{{ we found a javascript hide script tag begincomment = Instr(1,scriptstr(i),"&lt;!--") Redim Preserve commentstr(z) commentstr(z) = Mid(scriptstr(i),begincomment,endcomment-begincomment) scriptstr(i) = Replace(scriptstr(i),commentstr(z),"#commentstr" & z & "#") z = z + 1 ElseIf Instr(1,scriptstr(i),"--&gt;") Then '{{ we found a javascript end hide script tag begincomment = Instr(1,scriptstr(i),"--&gt;") Redim Preserve commentstr(z) commentstr(z) = Mid(scriptstr(i),begincomment,endcomment-begincomment) scriptstr(i) = Replace(scriptstr(i),commentstr(z),"#commentstr" & z & "#") z = z + 1 Else iscomment = "" End If Next '{{ Now that we have all of our quoted script bits hidden in placeholders, lets perform a few functions '{{ on the string to replace statements and functions... '{{ Surrounds keywords defined in the statements array with the appropriate span tags For i = 0 to Ubound(scriptstr) '{{ Identifies Statements in the string passed in by looping through the statements array For x = 0 to Ubound(statementsarr) curitem = statementsarr(x) '{{ Check for all of the capitalization iterations of the string If Instr(1,scriptstr(i),curitem) Then scriptstr(i) = Replace(scriptstr(i),curitem,"<span id=""statement"">" & curitem & "</span>") End If Next Next '{{ Surrounds keywords defined in the function array with the appropriate span tags For i = 0 to Ubound(scriptstr) '{{ Identifies Statements in the string passed in by looping through the statements array For x = 0 to Ubound(functionarr) curitem = functionarr(x) '{{ Check for all of the capitalization iterations of the string If Instr(1,scriptstr(i),curitem) Then scriptstr(i) = Replace(scriptstr(i),curitem,"<span id=""function"">" & Replace(curitem,"(","") & "</span>(") End If Next Next '{{ Now lets perform a function on the base string before we repopulate all of the placeholders '{{ Surround tags with the span tag ourline = Replace(ourline,"&lt;","<span id=""html"">&lt;") ourline = Replace(ourline,"&gt;","&gt;</span>") '{{ Surround HTML comments with the span tag If isHTMLcomment Then begincomment = 1 Else begincomment = Instr(1,ourline,"&lt;!--") End If If Instr(1,ourline,"--&gt;") Then endcomment = Instr(1,ourline,"--&gt;") + Len("--&gt;") Else endcomment = 0 End If If begincomment > 0 Then isHTMLcomment = True If endcomment > 0 Then isHTMLcomment = False HTMLcommentstr = Mid(ourline,begincomment,endcomment-begincomment) ourline = Replace(ourline,HTMLcommentstr,"<span id=""comment"">" & HTMLcommentstr & "</span>") Else endcomment = Len(ourline)+1 HTMLcommentstr = Mid(ourline,begincomment,endcomment-begincomment) ourline = Replace(ourline,HTMLcommentstr,"<span id=""comment"">" & HTMLcommentstr) End If ElseIf endcomment > 0 Then isHTMLcomment = False HTMLcommentstr = Mid(ourline,begincomment,endcomment-begincomment) ourline = Replace(ourline,HTMLcommentstr,"<span id=""comment"">" & HTMLcommentstr & "</span>") Else isHTMLcomment = False End If '{{ With that done, we can replace our placeholders with the actual value and surround them in our span tags For i = 0 to Ubound(scriptstr) If z > 0 Then For z = 0 To ubound(commentstr) scriptstr(i) = Replace(scriptstr(i),"#commentstr" & z & "#","<span id=""comment"">" & commentstr(z) & "</span>") Next End If Next For i = 0 to Ubound(scriptstr) If y > 0 Then For y = 0 to ubound(quoted) If iscomment = "" Then scriptstr(i) = Replace(scriptstr(i),"#quoted" & y & "#","<span id=""scripton"">" & quoted(y) & "</span>") ElseIf Instr(1,Replace(scriptstr(i),"#quoted" & y & "#",quoted(y)),quoted(y)) > iscomment Then scriptstr(i) = Replace(scriptstr(i),"#quoted" & y & "#",quoted(y)) End If Next End If Next For i = 0 to Ubound(scriptstr) '{{ Replaces occurrances of script delimeters with appropriate span tags scriptstr(i) = Replace(scriptstr(i),"&lt;%","<span id=""script"">&lt;%") scriptstr(i) = Replace(scriptstr(i),"%&gt;","%&gt;</span>") scriptstr(i) = Replace(scriptstr(i),"&lt;SCRIPT","<span id=""script"">&lt;SCRIPT") scriptstr(i) = Replace(scriptstr(i),"&lt;/SCRIPT&gt;","&lt;/SCRIPT&gt;</span>") Next For i = 0 to Ubound(scriptstr) ourline = Replace(ourline,"#scriptstr" & i & "#",scriptstr(i)) Next '{{ Now that its all fixed up, print it to the screen and move on!!!! Response.write ourline & "<br>" '{{ Okay, first we'll increment our line number... now we are moving on linenum = linenum + 1 Loop Response.Write "</pre>" '{{ Close the file we have been working with ReadStream.Close '{{ Set the value of the variable that was holding it to nothing Set Readstream = Nothing '{{ Set our filesystemobject to nothing Set fs = Nothing %> </BODY> </HTML>