Highlighted VBScript code

Source: Internet
Author: User
Tags rtrim

<! 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>

Related Article

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.