<% Option Explicit %>
<%
Sub Main()
Dim sInput 'As String
Dim sOutput 'As String
Dim oHighlighter 'As clsHighlighter
sInput = Request.Form.Item("InputText")
If LCase(Request.Form.Item("Action")) = "highlight" Then
Set oHighlighter = New clsHighlighter
With oHighlighter
sOutput = .HighlightCode(sInput, LANGUAGE_ASP)
End With
Set oHighlighter = Nothing
End If
DisplayPage sOutput
End Sub
Sub DisplayPage(ByVal sOutput)
Response.Write "<html>" & vbcrlf
Response.Write " <head>" & vbcrlf
Response.Write " <title>Highlight</title>" & vbcrlf
Response.Write " </head>" & vbcrlf
Response.Write " <body>" & vbcrlf
If Len(sOutput)=0 Then
Response.Write " <form method='post'>" & vbcrlf
Response.Write " <input type='hidden' name='Action' value='highlight'>" & vbcrlf
Response.Write " <textarea name='InputText' rows='9' cols='60' style='margin: 5px; border: 1px solid gray; font-family: courier new, helvetica, sans-serif; font-size: 9pt'>" & Server.HTMLEncode(Request.Item("InputText")) & "</textarea>" & vbcrlf
Response.Write " <br> <input type='submit' value='Convert' style='border: 1px solid gray; font-family: tahoma, arial, sans-serif; font-size: 8pt'>" & vbcrlf
Response.Write " </form>" & vbcrlf & vbcrlf & vbcrlf
Else
Response.Write sOutput
End If
Response.Write " </body>" & vbcrlf
Response.Write "</html>" & vbcrlf
End Sub
Main
'8<- - - - - - - - - - 8<- - - - - - - - - - 8<- - - - - - - - - - 8<- - - - - - - - - - 8<- - - - - - - - - -
Public Const LANGUAGE_HTML = 1
Public Const LANGUAGE_VB = 2
Public Const LANGUAGE_ASP = 3
Class clsHighlighter
Public Function HighlightCode(ByVal sInput, ByVal lLanguage) 'As String
sInput = Replace(sInput, " ", " ") '== Get rid of tabs
Select Case CLng(lLanguage)
Case LANGUAGE_HTML : HighlightCode = ProcessHTML(sInput)
Case LANGUAGE_VB : HighlightCode = ProcessVB(sInput)
Case LANGUAGE_ASP : HighlightCode = ProcessASP(sInput)
End Select
End Function
Private Function ProcessASP(ByVal sInput) 'As String
Const ASP_OPENER = "<span style='background-color: #ffff00'><b><%</b></span>"
Const ASP_CLOSER = "<span style='background-color: #ffff00'><b>%></b></span>"
Dim lCount 'As Long
Dim sTemp 'As String
Dim sOutput 'As String
Dim lMax 'As Long
Dim bInASP 'As Boolean
Dim sChar 'As String
Dim sOpener 'As String
Dim sCloser 'As String
sOpener = "<" & Chr(37)
sCloser = Chr(37) & ">"
lMax = Len(sInput)
bInASP = False
For lCount = 1 To lMax
sChar = Mid(sInput, lCount, 1)
sTemp = sTemp & sChar
If Right(sTemp,2) = sOpener And Not bInASP Then
bInASP = True
sOutput = sOutput & ProcessHTML(Left(sTemp, Len(sTemp)-2)) & ASP_OPENER
sTemp = ""
ElseIf Right(sTemp,2) = sCloser And bInASP Then
sOutput = sOutput & ProcessVB(Left(sTemp, Len(sTemp)-2)) & ASP_CLOSER
bInASP = False
sTemp = ""
End If
Next
If bInASP Then
sOutput = sOutput & ProcessVB(sTemp)
Else
sOutput = sOutput & ProcessHTML(sTemp)
End If
ProcessASP = "<font face='Courier New' size='-1'>" & sOutput & "</font>"
End Function
Private Function ProcessVB(ByVal sInput) 'As String
Const TERMINAL_OPENER = "" '-- ""
Const TERMINAL_CLOSER = "" '-- ""
Const STRING_OPENER = "<i>"
Const STRING_CLOSER = "</i>"
Const COMMENT_OPENER = "<font color='#009999'>"
Const COMMENT_CLOSER = "</font>"
Dim sOutput 'As String
Dim sTemp 'As String
Dim lCount 'As Long
Dim lMax 'As Long
Dim sChar 'As String
Dim bInString 'As Boolean
Dim bInComment 'As String
lMax = Len(sInput)
bInString = False
bInComment = False
For lCount = 1 To lMax
sChar = Mid(sInput, lCount, 1)
If IsVBTerminal(sChar) Then
If sChar = Chr(34) And bInString And Not bInComment Then '== Close a string
sOutput = sOutput & STRING_OPENER & Replace(Server.HTMLEncode(sTemp & sChar), " ", " ") & STRING_CLOSER
bInString = False
sTemp = ""
ElseIf sChar = Chr(34) And Not (bInString Or bInComment) Then '== Open a string
bInString = True
sOutput = sOutput & FormatVBWord(sTemp)
sTemp = Chr(34)
ElseIf Not (bInString Or bInComment) And sChar="'" Then
bInComment = True
sOutput = sOutput & FormatVBWord(sTemp)
sTemp = "'"
ElseIf bInComment And sChar=vbCr Then
sOutput = sOutput & COMMENT_OPENER & sTemp & COMMENT_CLOSER & "<br>" & vbCr
sTemp = ""
bInComment = False
ElseIf Not (bInString Or bInComment) Then
sOutput = sOutput & FormatVBWord(sTemp) & TERMINAL_OPENER & Replace(Replace(sChar, vbCr, "<br>" & vbCr), " ", " ") & TERMINAL_CLOSER
sTemp = ""
Else
sTemp = sTemp & sChar 'Replace(sChar, " ", " ")
End If
Else
sTemp = sTemp & sChar
End If
Next
sOutput = sOutput & sTemp
ProcessVB = sOutput
End Function
Private Function FormatVBWord(ByVal sInput) 'As String
Const STATEMENT_OPENER = "<font color='#0000ff'><b>"
Const STATEMENT_CLOSER = "</b></font>"
Const KEYWORD_OPENER = "<font color='#ff0000'>"
Const KEYWORD_CLOSER = "</font>"
Const FUNCTION_OPENER = "<font color='#ff9900'>"
Const FUNCTION_CLOSER = "</font>"
Const EVENT_OPENER = "<font color='#660066'>"
Const EVENT_CLOSER = "</font>"
Dim sTemp 'As String
sTemp = LCase(sInput)
Select Case sTemp
'== Statements
Case "and", "appactivate", "as" : FormatVBWord = STATEMENT_OPENER & sInput & STATEMENT_CLOSER
Case "base", "beep", "byref", "byval" : FormatVBWord = STATEMENT_OPENER & sInput & STATEMENT_CLOSER
Case "call", "case", "chdir", "chdrive", "class", "const" : FormatVBWord = STATEMENT_OPENER & sInput & STATEMENT_CLOSER
Case "defbool", "defbyte", "defcur", "defdate", "defdbl", "defdec", "defint", "deflng", "defobj", "defsng", "defstr", "deftype", "defvar", "deletesetting", "dim", "do" : FormatVBWord = STATEMENT_OPENER & sInput & STATEMENT_CLOSER
Case "each", "else", "elseif", "end", "enum", "erase", "event", "exit", "explicit" : FormatVBWord = STATEMENT_OPENER & sInput & STATEMENT_CLOSER
Case "filecopy", "for", "foreach", "function" : FormatVBWord = STATEMENT_OPENER & sInput & STATEMENT_CLOSER
Case "get", "gosub", "goto" : FormatVBWord = STATEMENT_OPENER & sInput & STATEMENT_CLOSER
Case "if", "implements", "in", "is" : FormatVBWord = STATEMENT_OPENER & sInput & STATEMENT_CLOSER
Case "kill" : FormatVBWord = STATEMENT_OPENER & sInput & STATEMENT_CLOSER
Case "let", "lineinput", "lock", "loop", "lset" : FormatVBWord = STATEMENT_OPENER & sInput & STATEMENT_CLOSER
Case "mkdir" : FormatVBWord = STATEMENT_OPENER & sInput & STATEMENT_CLOSER
Case "name", "new", "next", "not" : FormatVBWord = STATEMENT_OPENER & sInput & STATEMENT_CLOSER
Case "onerror", "on", "option", "optional", "or" : FormatVBWord = STATEMENT_OPENER & sInput & STATEMENT_CLOSER
Case "private", "property", "public", "put" : FormatVBWord = STATEMENT_OPENER & sInput & STATEMENT_CLOSER
Case "raiseevent", "randomize", "redim", "reset", "resume", "return", "rmdir", "rset" : FormatVBWord = STATEMENT_OPENER & sInput & STATEMENT_CLOSER
Case "savepicture", "savesetting", "select", "sendkeys", "set", "setattr", "static", "sub" : FormatVBWord = STATEMENT_OPENER & sInput & STATEMENT_CLOSER
Case "then", "to", "type" : FormatVBWord = STATEMENT_OPENER & sInput & STATEMENT_CLOSER
Case "unlock", "until" : FormatVBWord = STATEMENT_OPENER & sInput & STATEMENT_CLOSER
Case "wend", "while", "width", "with" : FormatVBWord = STATEMENT_OPENER & sInput & STATEMENT_CLOSER
'== Functions
Case "abs", "array", "asc", "ascb", "ascw", "atn", "avg" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "boolean" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "cbool", "cbyte", "ccur", "cdate", "cdbl", "cdec", "choose", "chr", "chrb", "chrw", "cint", "clng", "command", "cos", "count", "csng", "cstr", "curdir", "cvar", "cvdate", "cverr" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "date", "dateadd", "datediff", "datepart", "dateserial", "datevalue", "day", "ddb", "dir", "doevents" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "environ", "eof", "error", "exp" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "fileattr", "filedatetime", "filelen", "fix", "format", "freefile", "fv" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "getallstrings", "getattr", "getautoserversettings", "getobject", "getsetting" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "hex", "hour" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "iif", "imestatus", "input", "inputb", "inputbox", "instr", "instrb", "instrrev", "int", "ipmt", "isarray", "isdate", "isempty", "iserror", "ismissing", "isnull", "isnumeric", "isobject" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "join" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "lbound", "lcase", "left", "leftb", "len", "lenb", "loadpicture", "loc", "lof", "log", "long", "ltrim" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "max", "mid", "midb", "min", "minute", "mirr", "mod", "month", "msgbox" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "now", "nper", "npv" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "oct" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "partition", "pmt", "ppmt", "pv" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "qbcolor" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "rate", "rgb", "right", "rightb", "rnd", "rtrim" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "second", "seek", "sgn", "shell", "sin", "sln", "space", "spc", "split", "sqr", "stdev", "stdevp", "str", "strcomp", "strconv", "string", "switch", "sum", "syd" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "tab", "tan", "time", "timer", "timeserial", "timevalue", "trim", "typename" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "ubound", "ucase" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "val", "var", "varp", "vartype" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "weekday" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
Case "year" : FormatVBWord = FUNCTION_OPENER & sInput & FUNCTION_CLOSER
'== VB Events
Case "accesskeypress", "afteraddfile", "afterchangefilename", "afterclosefile", "aftercoledit", "aftercolupdate", "afterdelete", "afterinsert", "afterlabeledit", "afterremovefile", "afterupdate", "afterwritefile", "ambienchanged", "applychanges", "associate", "asyncreadcomplete", "axisactivated", "axislabelactivated", "axislabelselected", "axislabelupdated", "axisselected", "axistitleactivated", "axistitleselected", "axistitleupdated", "axisupdated" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "beforeclick", "beforecoledit", "beforecolupdate", "beforeconnect", "beforedelete", "beforeinsert", "beforelabeledit", "beforeloadfile", "beforeupdate", "buttonclick", "buttoncompleted", "buttongotfocus", "buttonlostfocus" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "change", "chartactivated", "chartselected", "chartupdated", "click", "coledit", "collapse", "colresize", "columnclick", "compare", "configchagecancelled", "configchanged", "connectionrequest" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "dataarrival", "datachanged", "dataupdated", "dblclick", "deactivate", "devicearrival", "deviceotherevent", "devicequeryremove", "devicequeryremovefailed", "deviceremovecomplete", "deviceremovepending", "devmodechange", "disconnect", "displaychanged", "dissociate", "dogetnewfilename", "done", "donepainting", "downclick", "dragdrop", "dragover", "dropdown" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "editproperty", "entercell", "enterfocus", "exitfocus", "expand" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "footnoteactivated", "footnoteselected", "footnoteupdated" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "gotfocus" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "headclick" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "infomessage", "initialize", "iniproperties", "itemactivated", "itemadded", "itemcheck", "itemclick", "itemreloaded", "itemremoved", "itemrenamed", "itemseletected" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "keydown", "keypress", "keyup" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "leavecell", "legendactivated", "legendselected", "legendupdated", "linkclose", "linkerror", "linknotify", "linkopen", "load", "lostfocus" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "mousedown", "mousemove", "mouseup" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "nodeclick" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "objectmove", "olecompletedrag", "oledragdrop", "oledragover", "olegivefeedback", "olesetdata", "olestartdrag", "onaddnew", "oncomm" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "paint", "panelclick", "paneldblclick", "pathchange", "patternchange", "plotactivated", "plotselected", "plotupdated", "pointactivated", "pointlabelactivated", "pointlabelselected", "pointlabelupdated", "pointselected", "pointupdated", "powerquerysuspend", "powerresume", "powerstatuschanged", "powersuspend" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "querychangeconfig", "querycomplete", "querycompleted", "querytimeout", "queryunload" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "readproperties", "reposition", "requestchangefilename", "requestwritefile", "resize", "resultschanged", "rowcolchange", "rowcurrencychange", "rowresize", "rowstatuschanged" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "selchange", "selectionchanged", "sendcomplete", "sendprogress", "seriesactivated", "seriesselected", "seriesupdated", "settingchanged", "splitchange", "statechanged", "statusupdate", "syscolorschanged" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "terminate", "timechanged", "titleactivated", "titleselected", "titleactivated" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "unboundadddata", "unbounddeleterow", "unboundgetrelativebookmark", "unboundreaddata", "unboundwritedata", "unload", "upclick", "updated" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "validate", "validationerror" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
Case "willassociate", "willchangedata", "willdissociate", "willexecute", "willupdaterows", "writeproperties" : FormatVBWord = EVENT_OPENER & sInput & EVENT_CLOSER
'== VB Keywords
Case "accept", "activate", "add", "addcustom", "addfile", "addfromfile", "addfromtemplate", "additem", "addnew", "addtoaddintoolbar", "addtoolboxprogid", "append", "appendchunk", "arrange", "assert", "asyncread" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "batchupdate", "begintrans", "bind" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "cancel", "cancelasyncread", "cancelbatch", "cancelupdate", "canpropertychange", "captureimage", "celltext", "cellvalue", "circle", "clear", "clearfields", "clearsel", "clearselcols", "clone", "close", "cls", "colcontaining", "columnsize", "committrans", "compactdatabase", "compose", "connect", "copy", "copyquerydef", "createobject", "createpreparedstatement", "createpropery", "createquery", "createquerydef", "createrelation", "createtabledef", "createuser", "createworkspace", "customize" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "delete", "deletecolumnlabels", "deletecolumns", "deleterowlabels", "deleterows", "doverb", "drag", "draw" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "edit", "editcopy", "editpaste", "enddoc", "ensurevisible", "establishconnection", "execute", "exists", "extracticon" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "fetch", "fetchverbs", "files", "fillcache", "find", "findfirst", "finditem", "findlast", "findnext", "findprevious", "forward", "form" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "getbookmark", "getchunk", "getclipstring", "getdata", "getfirstvisible", "getformat", "getheader", "getlinefromchar", "getnumticks", "getrows", "getselectedpart", "gettext", "getvisiblecount", "goback", "goforward" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "hide", "hittest", "holdfields" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "idle", "initializelabels", "insertcolumnlabels", "insertcolumns", "insertobjdlg", "insertrowlabels", "insertrows", "item" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "killdoc" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "layout", "line", "linkexecute", "linkpoke", "linkrequest", "linksend", "listen", "loadfile", "loadresdata", "loadrespicture", "loadresstring", "logevent" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "makecompilefile", "makereplica", "moreresults", "move", "movedata", "movefirst", "movelast", "movenext", "moveprevious" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "navigateto", "newpage", "newpassword", "nextrecordset" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "oledrag", "onaddinsupdate", "onconnection", "ondisconnection", "onstartupcomplete", "open", "openconnection", "opendatabase", "openquerydef", "openrecordset", "openresultset", "openurl", "overlay" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "paintpicture", "paste", "pastspecialdlg", "peekdata", "play", "point", "populatepartial", "popupmenu", "print", "printform", "propertychanged", "pset" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "querystring", "quit" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "raise", "randomdatafill", "randomfillcolumns", "randomfillrows", "rdocreateenvironment", "rdoregisterdatasource", "readfromfile", "readproperty", "rebind", "refill", "refresh", "refreshlink", "registerdatabase", "reload", "remove", "removeaddinfromtoolbar", "removeitem", "render", "repairdatabase", "reply", "replyall", "request", "requestordefault", "resetcustom", "resetcustomlabel", "resolvename", "response", "restoretoolbar", "resync", "rollback", "rollbacktrans", "rowbookmark", "rowcontaining", "rowtop" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "save", "saveas", "savefile", "savetofile", "savetoolbar", "savetoole1file", "scale", "scalex", "scaley", "scroll", "selectall", "selectpart", "selprint", "send", "senddata", "server", "setautoserversettings", "setdata", "setfocus", "setoption", "setsize", "settext", "setviewport", "show", "showcolor", "showfont", "showhelp", "showopen", "showprinter", "showsave", "showwhatsthis", "signoff", "signon", "size", "span", "splitcontaining", "startlabeledit", "startlogging", "stop", "synchronize" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "textheight", "textwidth", "todefaults", "totalbytes", "twipstochartpart", "typebycharttype" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "update", "updatecontrols", "updaterecord", "updaterow", "upto" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "whatsthismode", "write", "writeproperty" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case "zorder" : FormatVBWord = KEYWORD_OPENER & sInput & KEYWORD_CLOSER
Case Else : FormatVBWord = sInput '-- Replace(Replace(sInput, vbCr, "
" & vbCr), " ", " ")
End Select
End Function
Private Function IsVBTerminal(ByVal sChar) 'As Boolean
Select Case sChar
Case "." : IsVBTerminal = True
Case "(" : IsVBTerminal = True
Case ")" : IsVBTerminal = True
Case "=" : IsVBTerminal = True
Case " " : IsVBTerminal = True
Case vbTab : IsVBTerminal = True
Case "," : IsVBTerminal = True
Case vbCr : IsVBTerminal = True
Case vbLf : IsVBTerminal = True
Case vbCrLf : IsVBTerminal = True
Case "-" : IsVBTerminal = True
Case "+" : IsVBTerminal = True
Case "/" : IsVBTerminal = True
Case "*" : IsVBTerminal = True
Case "\" : IsVBTerminal = True
Case "%" : IsVBTerminal = True
Case """" : IsVBTerminal = True
Case "'" : IsVBTerminal = True
Case Else : IsVBTerminal = False
End Select
End Function
Private Function ProcessHTML(ByVal sInput) 'As String
Const TAG_OPENER = "<font color='#aa00aa'>"
Const STRING_OPENER = "<font color='#00aa33'>"
Dim sOutput 'As String
Dim bInTag 'As Boolean
Dim bInString 'As Boolean
Dim sStringChar 'As String
Dim lCount 'As Long
Dim lMax 'As Long
Dim sChar 'As String
Dim sLastChar 'As String
lMax = Len(sInput)
bInTag = False
bInString = False
For lCount = 1 To lMax
sLastChar = sChar
sChar = Mid(sInput, lCount, 1)
If sChar = "<" And Not bInTag Then '== Going into a tag
bInTag = True
sOutput = sOutput & TAG_OPENER & "<"
ElseIf sChar = ">" And bInTag And Not bInString Then '== Leaving a tag
bInTag = False
sOutput = sOutput & "></font>"
ElseIf bInTag And sChar="""" Then '== Double quotes in tag
If bInString Then sStringChar = "" Else sStringChar = """"
bInString = Not bInString
If bInString Then sOutput = sOutput & STRING_OPENER & """ Else sOutput = sOutput & ""</font>"
ElseIf bInTag And sChar="'" Then '== Single quotes in tag
If bInString Then sStringChar = "" Else sStringChar = "'"
bInString = Not bInString
If bInString Then sOutput = sOutput & STRING_OPENER & "'" Else sOutput = sOutput & "'</font>"
Else
sOutput = sOutput & Replace(Replace(Server.HTMLEncode(sChar), vblf, "<br>" & vbcrlf), " ", " ")
End If
Next
ProcessHTML = sOutput
End Function
End Class
%>