<! Doctype html public "-// W3C // dtd html 4.01 Transitional // EN">
<Html>
<Head>
<Meta http-equiv = "Content-Type" content = "text/html; charset = UTF-8"/>
<Title> VBScript code highlighting </title>
<Link href = "style.css" rel = "stylesheet" type = "text/css"/>
</Head>
<Body>
<Div class = "menu_head"> VBScript code highlighting </div>
<Div class = "content">
<Script language = "vbscript" type = "text/vbscript">
'==============================================
'Code highlight class
'Usage:
'Set HL = New highlight' definition class
'Hl. Language = "vb" 'specifies the programming Language. It supports VBS, JS, XML, HTML, SQL, C #, Java..., etc.
'You can also set the following attributes and Related keywords.
'Public keyword' keyword
'Public objects' object
'Public splitword' Separator
'Public linecomment' line comment
'Public CommentOn 'multi-line comment
'Public commentoff' multi-line comment ends
'Public ignore' case sensitive
'Public content' code content
'Public tags' flag
'Public stron' string tag
Escape the 'public' string delimiter
'Public IsMultiple 'allows multi-row Reference
'Hl. CodeContent = "code content to be highlighted"
'Response. Write (Hl. Execute) 'This method returns the highlighted code
'==============================================
Class Highlight
Public keyword' keyword
Public objects' object
Public splitword' Separator
Public LineComment 'line comment
Public CommentOn 'multiline comment
Public CommentOff 'multiline comment ends
Public Ignore 'case sensitive
Public codecontent' code content
Public tags' tag
Public StrOn 'string tag
Public Escape character string Escape
Public IsMultiple 'Allow multi-row references
Private Content
Private Sub Class_Initialize
Keywords = "function, void, this, boolean, while, if, return, new, true, false, try, catch, throw, null, else, int, long, do, var "'keyword
Objects = "src, width, border, cellspacing, cellpadding, align, bgcolor, class, style, href, type, name, String, Number, Boolean, RegExp, Error, Math, date "'object
SplitWords = ",.?!; : \/<> () {} [] "'= +-| * % @ # $ ^ &" & VBCRLF & CHR (9)' Separator
LineComment = "//" 'line comment
CommentOn = "/*" 'multi-line comment
CommentOff = "*/" 'multi-line comment ends
Ignore = 0' case sensitive
Tags = "a, img, html, head, body, title, style, script, language, input, select, div, span, button, img, iframe, frame, frameset, table, tr, td, caption, form, font, meta, textarea "'tag
StrOn = "" '"' string tag
Escape = "\" 'character string Escape
CodeContent = ""
End Sub
Public Function Execute
Dim S
Dim T, Key, X, Str
Dim Flag
Flag = 1: S = 1
For I = 1 to Len (CodeContent)
If Instr (1, SplitWords, Mid (CodeContent, I, 1), 0)> 0 Then
If Flag = 1 Then
Key = Mid (Codecontent, S, I-S)
If Keywords <> "" And Instr (1, "," & Keywords & "," & Key & ",", Ignore)> 0 Then
Content = Content & "<font color =" "blue"> "& Key &" </font>"
ElseIf Objects <> "" And Instr (1, "," & Objects & "," & Key & ",", Ignore)> 0 Then
Content = Content & "<font color =" red ">" & Key & "</font>"
ElseIf Tags <> "And Instr (1,", "& Tags &", "& Key &", ", Ignore)> 0 Then
Content = Content & "<font color =" "#996600"> "& Key &" </font>"
Else
Content = Content & Key
End If
End if
Flag = 0
X = Mid (CodeContent, I, 1)
If LineComment <> "" And Mid (CodeContent, I, Len (LineComment) = LineComment Then
S = Instr (I, CodeContent, VBCRLF)
If S = 0 Then
S = Len (CodeContent)
End if
Content = Content & "<font color =" "Green"> "& HtmlEnCode (Mid (CodeContent, I, S-I) &" </font>"
I = S
ElseIf StrOn <> "" And Instr (StrOn, Mid (CodeContent, I, 1)> 0 Then
Str = Mid (CodeContent, I, 1)
S = I
Do
S = Instr (S + 1, CodeContent, Str, 1)
If S <> 0 Then
T = S-1
Do While Mid (CodeContent, T, 1) = Escape
T = T-1
Loop
If (S-T) Mod 2 = 1 Then
Exit Do
End If
Else
S = Len (CodeContent)
Exit Do
End If
Loop While 1
Content = Content & "<font color =" "# FF00FF" ">" & HtmlEnCode (Mid (CodeContent, I, S-I + 1) & "</font>"
I = S
ElseIf CommentOn <> "" And Mid (CodeContent, I, Len (CommentOn) = CommentOn Then
S = Instr (I, CodeContent, CommentOff, 1)
If S = 0 Then
S = Len (CodeContent)
End if
Content = Content & "<font color =" "Green" ">" & HtmlEnCode (Mid (CodeContent, I, S-I + Len (CommentOff ))) & "</font>"
I = S + Len (CommentOff)
ElseIf X = "" Then
Content = Content &""
ElseIf X = "Then
Content = Content &"""
ElseIf X = "&" Then
Content = Content &"&"
ElseIf X = "<" Then
Content = Content & "<"
ElseIf X = ">" Then
Content = Content & ">"
ElseIf X = Chr (9) Then
Content = Content &""
ElseIf X = VBLF Then
Content = Content & "<br/>"
Else
Content = Content & X
End If
Else
If Flag = 0 Then
S = I
Flag = 1
End if
End If
Next
If Flag = 1 Then
Execute = Content & Mid (CodeContent, S)
Else
Execute = content
End If
End Function
Private Function HtmlEnCode (Str)
If IsNull (Str) Then
HtmlEnCode = "": Exit Function
End if
Str = Replace (Str ,"&","&")
Str = Replace (Str, "<", "<")
Str = Replace (Str, ">", "> ")
Str = Replace (Str ,"""",""")
Str = Replace (Str, Chr (9 ),"")
Str = Replace (Str ,"","")
Str = Replace (Str, VBLF, "<br/> ")
HtmlEnCode = Str
End Function
Public Property Let Language (Str)
Dim S
S = UCase (Str)
Select Case true
Case S = "VB" Or S = "VBS" or s = "VBSCRIPT ":
Keywords = "And, ByRef, ByVal, Call, Case, Class, Const, Dim, Do, Each, Else, ElseIf, Empty, End, Eqv, Erase, Error, Exit, explicit, False, For, Function, Get, If, Imp, In, Is, Let, Loop, Mod, Next, Not, Nothing, Null, On, Option, Or, Private, property, Public, Randomize, ReDim, Resume, Select, Set, Step, Sub, Then, To, True, Until, Wend, While, Xor, Anchor, Array, Asc, Atn, CBool, CByte, CCur, CDate, CDbl, Chr, CInt, CLng, Cos, CreateObject, CSng, CStr, Date, DateAdd, DateDiff, DatePart, DateSerial, DateValue, Day, Dictionary, document, Element, Err, Exp, FileSystemObject, Filter, Fix, Int, Form, FormatCurrency, FormatDateTime, FormatNumber, FormatPercent, GetObject, Hex, Hour, InputBox, InStr, Rev, IsArray, isDate, IsEmpty, IsNull, IsNumeric, IsObject, Join, LBound, LCase, Left, Len, Link, LoadPicture, Location, Log, LTrim, RTrim, Trim, Mid, Minute, Month, monthName, MsgBox, Navigator, Now, Oct, Replace, Right, Rnd, Round, ScriptEngine, ScriptEngineBuildVersion, rule, ScriptEngineMinorVersion, Second, Sgn, Sin, Space, Split, Sqr, StrComp, string, StrReverse, Tan, Time, TextStream, TimeSerial, TimeValue, TypeName, UBound, UCase, VarType, Weekday, WeekDayName, Year, Function"
Objects = "String, Number, Boolean, Date, Integert, Long, Double, Single"
SplitWords = ",.?!; : \/<> () {} [] "'= +-| * % @ # $ ^ &" & VBCRLF & Chr (9)
LineComment = "'"
CommentOn = ""
CommentOff = ""
StrOn = """"
Escape = ""
Ignore = 1
CodeContent = ""
Tags = ""
Case s = "C #":
Keywords = "abstract, as, base, bool, break, byte, case, catch, char, checked, class, const, continue, decimal, default, delegate, do, double, else, enum, event, explicit, extern, false, finally, fixed, float, for, foreach, get, goto, if, implicit, in, int, interface, internal, is, lock, long, namespace, new, null, object, operator, out, override, params, private, protected, public, readonly, ref, return, sbyte, sealed, short, sizeof, stackalloc, static, set, string, struct, switch, this, throw, true, try, typeof, uint, ulong, unchecked, unsafe, ushort, using, value, virtual, void, volatile, while "'keyword
Objects = "String, Boolean, DateTime, Int32, Int64, Exception, able, DataReader" 'object
SplitWords = ",.?!; : \/<> () {} [] "'= +-| * % @ # $ ^ &" & VBCRLF & CHR (9)' Separator
LineComment = "//" 'line comment
CommentOn = "/*" 'multi-line comment
CommentOff = "*/" 'multi-line comment ends
Ignore = 0' case sensitive
Tags = "" 'Mark
StrOn = "'string tag
Escape = "\" 'character string Escape
Case S = "JAVA ":
Keywords = "abstract, boolean, break, byte, case, catch, char, class, const, continue, default, do, double, else, extends, final, finally, float, for, goto, if, implements, import, instanceof, int, interface, long, native, new, package, private, protected, public, return, short, static, strictfp, super, switch, synchronized, this, throw, throws, transient, try, void, volatile, while "'keywords
Objects = "String, Boolean, DateTime, Int32, Int64, Exception, able, DataReader" 'object
SplitWords = ",.?!; : \/<> () {} [] "'= +-| * % @ # $ ^ &" & VBCRLF & CHR (9)' Separator
LineComment = "//" 'line comment
CommentOn = "/*" 'multi-line comment
CommentOff = "*/" 'multi-line comment ends
Ignore = 0' case sensitive
Tags = "" 'Mark
StrOn = "'string tag
Escape = "\" 'character string Escape
Case S = "JS" or s = "JSCRIPT" or s = "JAVASCRIPT ":
Keywords = "function, void, this, boolean, while, if, return, new, true, false, try, catch, throw, null, else, int, long, do, var "'keyword
Objects = "String, Number, Boolean, RegExp, Error, Math, Date" 'object
SplitWords = ",.?!; : \/<> () {} [] "'= +-| * % @ # $ ^ &" & VBCRLF & CHR (9)' Separator
LineComment = "//" 'line comment
CommentOn = "/*" 'multi-line comment
CommentOff = "*/" 'multi-line comment ends
Ignore = 0' case sensitive
Tags = "" 'Mark
StrOn = "'string tag
Escape = "\" 'character string Escape
Case S = "XML ":
Keywords = "! DOCTYPE ,? Xml, script, version, encoding "'keyword
Objects = "String, Number, Boolean, RegExp, Error, Math, Date" 'object
SplitWords = ",.?!; : \/<> () {} [] "'= +-| * % @ # $ ^ &" & VBCRLF & CHR (9)' Separator
LineComment = "//" 'line comment
CommentOn = "<! -- "'Multiline comment
CommentOff = "-->" 'multi-line comment ends
Ignore = 0' case sensitive
Tags = "" 'Mark
StrOn = "'string tag
Escape = "\" 'character string Escape
Case S = "HTML ":
Case S = "SQL ":
Keywords = "COMMIT, DELETE, INSERT, LOCK, ROLLBACK, SELECT, TRANSACTION, READ, ONLY, WRITE, USE, ROLLBACK, SEGMENT, ROLE, role t, NONE, UPDATE, DUAL, WORK, COMMENT, FORCE, FROM, WHERE, INTO, VALUES, ROW, SHARE, MODE, EXCLUSIVE, UPDATE, ROW, NOWAIT, TO, SAVEPOINT, UNION, UNION, ALL, INTERSECT, MINUS, START, WITH, CONNECT, BY, GROUP, HAVING, ORDER, UPDATE, NOWAIT, IDENTIFIED, SET, DROP, PACKAGE, CREATE, REPLACE, PROCEDURE, FUNCTION, TABLE, RETURN, AS, BEGIN, DECLARE, END, IF, THEN, ELSIF, ELSE, WHILE, CURSOR, EXCEPTION, WHEN, OTHERS, NO_DATA_FOUND, TOO_MANY_ROWS, CURSOR_ALREADY_OPENED, FOR, LOOP, IN, OUT, TYPE, OF, INDEX, BINARY_INTEGER, RAISE, ROWTYPE, VARCHAR2, NUMBER, LONG, DATE, RAW, long raw, CHAR, INTEGER, MLSLABEL, CURRENT, OF, DEFAULT, CURRVAL, NEXTVAL, LEVEL, ROWID, ROWNUM, DISTINCT, ALL, LIKE, IS, NOT, NULL, BETWEEN, ANY, AND, OR, EXISTS, ASC, DESC, ABS, CEIL, COS, COSH, EXP, FLOOR, LN, LOG, MOD, POWER, ROUND, SIGN, SIN, SINH, SQRT, TAN, TANH, TRUNC, CHR, CONCAT, INITCAP, LOWER, LPAD, LTRIM, delimiter, NLS_LOWER, NLS_UPPER, REPLACE, RPAD, RTRIM, SOUNDEX, SUBSTR, SUBSTRB, TRANSLATE, UPPER, ASCII, INSTR, substring B, LENGTH, LENGTHB, NLSSORT, week, LAST_DAY, keys, NEW_TIME, NEXT_DAY, ROUND, SYSDATE, TRUNC, CHARTOROWID, CONVERT, HEXTORAW, direction, ROWIDTOCHAR, TO_CHAR, TO_DATE, TO_LABEL, distance, TO_NUMBER, distance, DUMP, GREATEST, distance, LEAST, LEAST_UB, NVL, UID, USER, USERENV, VSIZE, AVG, COUNT, GLB, LUB, MAX, MIN, STDDEV, SUM, VARIANCE "'keyword
Objects = "" 'object
SplitWords = ",.?!; : \/<> () {} [] "'= +-| * % @ # $ ^ &" & VBCRLF & CHR (9)' Separator
LineComment = "--" 'line comment
CommentOn = "/*" 'multi-line comment
CommentOff = "*/" 'multi-line comment ends
Ignore = 1' case sensitive
Tags = "" 'Mark
StrOn = "'"' string tag
Escape = "" 'character string Escape
End Select
End Property
End Class
</Script>
<Script language = "vbscript" type = "text/vbscript">
Function plaster ()
Document. form1.code. focus ()
Document.exe cCommand ("Paste ")
End Function
Function goit (stx)
Dim code, HL
Code = Document. all. code. value
Set HL = New Highlight
HL. Language = stx
HL. CodeContent = code
Document. getElementById ("highlight"). innerHTML = Hl. Execute
End Function
</Script>
<Form method = "post" name = "form1">
<Div align = "center"> <textarea rows = "18" name = "code" style = "width: 99% "id =" code "> </textarea> </div>
<Input type = "button" value = "HTML" onclick = "goit ('html')"/>
<Input type = "button" value = "VB/VBScript" onclick = "goit ('vb ')"/>
<Input type = "button" value = "JavaScript" onclick = "goit ('js')"/>
<Input type = "button" value = "C #" onclick = "goit ('C # ')"/>
<Input type = "button" value = "SQL" onclick = "goit ('SQL')"/>
<Input type = "button" value = "XML" onclick = "goit ('xml')"/>
<Input type = "button" value = "Java" onclick = "goit ('java')"/>
<Input type = "button" value = "Paste" onclick = "plaster ()"/>
<Input type = "reset" value = "clear content"/>
</Form>
<Div id = "highlight" align = "left" style = "width: 98%; overflow: auto; word-wrap: word-break; word-break: break-all; "> <div>
</Body>
</Html>