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 » &quot;<%=sFileName%>&quot;
    </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, "&nbsp;&nbsp;&nbsp;&nbsp;")

    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.