VBScript版代码高亮_Javascript教程-查字典教程网

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">

<html>

<head>

<title>VBScript版代码高亮</title>

</head>

<body>

<div>VBScript版代码高亮</div>

<div>

'======================================

'代码高亮类

'使用方法:

'Set HL = New Highlight '定义类

'HL.Language = "vb" '指定程序语言,支持 VBS ,JS ,XML, HTML, SQL, C#, Java...等

'还可通过直接设置下列属性还设置相关关键字等

'Public Keywords'关键字

'Public Objects'对象

'Public SplitWords'分隔符

'Public LineComment'行注释

'Public CommentOn'多行注释

'Public CommentOff'多行注释结束

'Public Ignore'是否区分大小写

'Public CodeContent'代码内容

'Public Tags'标记

'Public StrOn'字符串标记

'Public Escape'字符串界定符转义

'Public IsMultiple'允许多行引用

'HL.CodeContent = "要高亮的代码内容"

'Response.Write(Hl.Execute) '该方法返回高亮后的代码

'=====================================

Class Highlight

Public Keywords'关键字

Public Objects'对象

Public SplitWords'分隔符

Public LineComment'行注释

Public CommentOn'多行注释

Public CommentOff'多行注释结束

Public Ignore'是否区分大小写

Public CodeContent'代码内容

Public Tags'标记

Public StrOn'字符串标记

Public Escape'字符串界定符转义

Public IsMultiple'允许多行引用

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"'关键字

Objects= "src,width,border,cellspacing,cellpadding,align,bgcolor,class,style,href,type,name,String,Number,Boolean,RegExp,Error,Math,Date"'对象

SplitWords = " ,.?!;:/<>(){}[]""'=+-|*%@#$^&"&VBCRLF&CHR(9)'分隔符

LineComment = "//"'行注释

CommentOn = "/*"'多行注释

CommentOff = "*/"'多行注释结束

Ignore= 0'是否区分大小写

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"'标记

StrOn = """'"'字符串标记

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

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

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,InstrRev,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,ScriptEngineMajorVersion,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"'关键字

Objects= "String,Boolean,DateTime,Int32,Int64,Exception,DataTable,DataReader"'对象

SplitWords = " ,.?!;:/<>(){}[]""'=+-|*%@#$^&"&VBCRLF&CHR(9)'分隔符

LineComment = "//"'行注释

CommentOn = "/*"'多行注释

CommentOff = "*/"'多行注释结束

Ignore= 0'是否区分大小写

Tags= ""'标记

StrOn = """"'字符串标记

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"'关键字

Objects= "String,Boolean,DateTime,Int32,Int64,Exception,DataTable,DataReader"'对象

SplitWords = " ,.?!;:/<>(){}[]""'=+-|*%@#$^&"&VBCRLF&CHR(9)'分隔符

LineComment = "//"'行注释

CommentOn = "/*"'多行注释

CommentOff = "*/"'多行注释结束

Ignore= 0'是否区分大小写

Tags= ""'标记

StrOn = """"'字符串标记

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"'关键字

Objects= "String,Number,Boolean,RegExp,Error,Math,Date"'对象

SplitWords = " ,.?!;:/<>(){}[]""'=+-|*%@#$^&"&VBCRLF&CHR(9)'分隔符

LineComment = "//"'行注释

CommentOn = "/*"'多行注释

CommentOff = "*/"'多行注释结束

Ignore= 0'是否区分大小写

Tags= ""'标记

StrOn = """"'字符串标记

Escape= ""'字符串界定符转义

Case S = "XML":

Keywords = "!DOCTYPE,?xml,script,version,encoding"'关键字

Objects= "String,Number,Boolean,RegExp,Error,Math,Date"'对象

SplitWords = " ,.?!;:/<>(){}[]""'=+-|*%@#$^&"&VBCRLF&CHR(9)'分隔符

LineComment = "//"'行注释

CommentOn = "<>"'多行注释结束

Ignore= 0'是否区分大小写

Tags= ""'标记

StrOn = """"'字符串标记

Escape= ""'字符串界定符转义

Case S = "HTML":

Case S = "SQL":

Keywords = "COMMIT,DELETE,INSERT,LOCK,ROLLBACK,SELECT,TRANSACTION,READ,ONLY,WRITE,USE,ROLLBACK,SEGMENT,ROLE,EXCEPT,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,NLS_INITCAP,NLS_LOWER,NLS_UPPER,REPLACE,RPAD,RTRIM,SOUNDEX,SUBSTR,SUBSTRB,TRANSLATE,UPPER,ASCII,INSTR,INSTRB,LENGTH,LENGTHB,NLSSORT,ADD_MONTHS,LAST_DAY,MONTHS_BETWEEN,NEW_TIME,NEXT_DAY,ROUND,SYSDATE,TRUNC,CHARTOROWID,CONVERT,HEXTORAW,RAWTOHEX,ROWIDTOCHAR,TO_CHAR,TO_DATE,TO_LABEL,TO_MULTI_BYTE,TO_NUMBER,TO_SINGLE_BYTE,DUMP,GREATEST,GREATEST_LB,LEAST,LEAST_UB,NVL,UID,USER,USERENV,VSIZE,AVG,COUNT,GLB,LUB,MAX,MIN,STDDEV,SUM,VARIANCE"'关键字

Objects= ""'对象

SplitWords = " ,.?!;:/<>(){}[]""'=+-|*%@#$^&"&VBCRLF&CHR(9)'分隔符

LineComment = "--"'行注释

CommentOn = "/*"'多行注释

CommentOff = "*/"'多行注释结束

Ignore= 1'是否区分大小写

Tags= ""'标记

StrOn = "'"'字符串标记

Escape= ""'字符串界定符转义

End Select

End Property

End Class

</script>

Function plaster()

document.form1.code.focus()

document.execCommand("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>

</body>

</html>