| HiLiteR 1.1 » "srcbb.asp" | Report a Bug | Recommend a feature | Ask a question | Submit a site |
<%
'-------------------------------------------------------------
'HiLiteR 1.1
'http://www.2enetworx.com/dev/projects/hiliter.asp
'File: src.asp
'Description: Parsing and Highlighting Engine
'Written By Hakan Eskici on Dec 03, 2000
'You may use the code for any purpose
'But re-publishing is discouraged.
'See License.txt for additional information
'-------------------------------------------------------------
response.buffer = True
sFileName = request("filename")
%>
<html>
<head>
<title>HiLiteR 1.1 » <%=sFileName%></title>
<link rel="STYLESHEET" type="text/css" href="hiliter.css">
</head>
<body>
<table border=0 width="100%">
<td style="font-size: 9pt; font-weight: bold;color: #703200;">
HiLiteR 1.1 » "<%=sFileName%>"
</td>
<td align="right" class="text">
<a href="http://www.2enetworx.com/dev/projects/reportbug.asp?pid=11" title="Report a bug about HiLiteR">Report a Bug</a> |
<a href="http://www.2enetworx.com/dev/projects/recommend.asp?pid=11" title="Recommend a feature about HiLiteR">Recommend a feature</a> |
<a href="http://www.2enetworx.com/dev/projects/question.asp?pid=1" title="Ask a question about HiLiteR">Ask a question</a> |
<a href="http://www.2enetworx.com/dev/projects/submitsite.asp?pid=11" title="Submit your site where you use HiLiteR">Submit a site</a>
</td>
</table>
<hr size="1" color="#C0C0C0" noshade>
<!--#include file="syntaxdef.asp"-->
<%
sub SyntaxReplace(v, s, sClassName, bLookAtTheEnd)
'v : Array of words
's : string being processed
'sClassName : style sheet class name to be used
'bLookAtTheEnd : checks for a complete word
for i = 0 to UBound(v)
if lcase(mid(s, iPos, len(v(i)))) = v(i) then
'Found!
if bLookAtTheEnd then
'If a complete word is being looked for
if instr(cWordDelimiters, mid(s, iPos + len(v(i)), 1)) <> 0 then
'Set the change flag
bChange = True
'Colorize the word found
sBuffer = sBuffer & "<font class=""" & sClassName & """>" & _
mid(s, iPos, len(v(i))) & "</font>"
iPos = iPos + len(v(i)) - 1
end if
else
'Set the change flag
bChange = True
'Colorize the word found
sBuffer = sBuffer & "<font class=""" & sClassName & """>" & _
mid(s, iPos, len(v(i))) & "</font>"
iPos = iPos + len(v(i)) - 1
end if
end if
next
end sub
function ProcessLine(s)
s = Server.HtmlEncode(s)
'Clear the line buffer
sBuffer = ""
bInString = False
for iPos = 1 to len(s)
bChange = False
'Checks that if we are in a word
if instr(cWordDelimiters, mid(s, iPos, 1)) = 0 then
bPrevCharInWord = bInWord
bInWord = True
else
bPrevCharInWord = bInWord
bInWord = False
end if
'Delimiter Begin
'Looks for ASP start tag
if mid(s, iPos, len(cDelimiterBegin)) = cDelimiterBegin then
bChange = True
bInAsp = True
sBuffer = sBuffer & "<font class=""d"">" & cDelimiterBegin & "</font>"
iPos = iPos + (len(cDelimiterBegin) - 1)
end if
'Delimiter End
'Looks for ASP end tag
if mid(s, iPos, len(cDelimiterEnd)) = cDelimiterEnd then
bChange = True
bInAsp = False
sBuffer = sBuffer & "<font class=""d"">" & cDelimiterEnd & "</font>"
iPos = iPos + (len(cDelimiterEnd) - 1)
end if
'Strings
'Looks for a string enclosed in quotes
if mid(s, iPos, len(cQuote)) = cQuote then
bChange = True
bInString = Not bInString
if bInString then
sBuffer = sBuffer & "<font class=""s"">" & cQuote
else
sBuffer = sBuffer & cQuote & "</font>"
end if
iPos = iPos + (len(cQuote)-1)
end if
if (bInAsp = True AND bInString = False) then
'Comments
'Looks for a comment line
if mid(s, iPos, 1) = cComment then
sBuffer = sBuffer & "<font class=""c"">" & cComment & _
right(s, len(s) - iPos) & "</font>"
'Comments go until the end of the line, so the line is completed
exit for
end if
'Were we "in a word" one char before?
if bPrevCharInWord = False then
'Do the highlighting by extended syntax replacing
'Functions
SyntaxReplace vF, s, "f", True
'Properties
SyntaxReplace vP, s, "p", True
'KeyWords
SyntaxReplace vK, s, "k", True
'Operators
SyntaxReplace vOp, s, "op", False
'Objects
SyntaxReplace vOb, s, "ob", False
end if
end if
if Not bChange then
'If there is no change, just add the char to the buffer as is
sBuffer = sBuffer & mid(s, iPos, 1)
end if
next
sBuffer = replace(sBuffer, vbTab, " ")
ProcessLine = sBuffer
end function
'Global variables
dim iPos
dim bChange
dim sBuffer
'Better we should do a security check to prevent
'access to any file on the server
if sFileName = "" then sFileName = "test.asp"
response.write vbCrLf & vbCrLf & "<!-- HiLiteR Code Block Start -->" & vbCrLf & vbCrLf
response.write "<p class=""source"">"
if lcase(right(sFileName, 4)) <> ".asp" or instr(sFileName, "..") or instr(sFileName, "/") or instr(sFileName, "\") then
response.write "Error:<br>"
response.write "Invalid File Name<br><br>"
response.write "Filename should be an .asp file and cannot include .., / or \<br><br>"
response.write "Usage:<br>"
response.write "src.asp?filename=file.asp<br>"
else
'Timing start
dtStart = Timer
set fso = CreateObject("Scripting.FileSystemObject")
set f = fso.OpenTextFile(Server.MapPath(sFileName))
bInASP = False
Do While Not f.AtEndOfStream
sLine = f.ReadLine
sOutput = ProcessLine(sLine)
response.write sOutput & "<br>" & vbCrLf
loop
f.Close
Set f = Nothing
Set fso = Nothing
dtEnd = Timer
response.write "<br><hr size=""1"" color=""#C0C0C0"" noshade>"
'Display the perf stats
end if
response.write "</p>"
response.write vbCrlf & vbCrLf & "<!-- HiLiteR Code Block End -->" & vbCrLf & vbCrLf
response.write "<p class=""text"">"
response.write "Processing time: " & formatnumber(dtEnd - dtStart, 2) & " seconds.<br><br>"
response.write "Visit <a href=""http://www.2enetworx.com/dev"" style=""color: #0000FF; text-decoration: underline;"">2eNetWorX</a> for more OpenSource VB and ASP Projects."
response.write "</p>"
%>
</body>
</html>
Processing time: 3.07 seconds.
Visit 2eNetWorX for more OpenSource VB and ASP Projects.