VBScript版代码高亮

2018-09-23 20:32

阅读:715

  <!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版代码高亮</title>
<link href=style.css rel=stylesheet type=text/css />
</head>

  <body>
<div class=menu_head>VBScript版代码高亮</div>
<div class=content>
<script language=vbscript type=text/vbscript>
======================================
代码高亮类
使用方法:
Set HL = New 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允许多行引用
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
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,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 = <!--多行注释
CommentOff = -->多行注释结束
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>
<script language=vbscript type=text/vbscript>
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
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=粘贴 onclick=plaster() />
<input type=reset value=清空内容 />
</form>

  <div id=highlight align=left style=width:98%;overflow:auto;word-wrap:word-break;word-break:break-all;><div>
</body>
</html>


评论


亲,登录后才可以留言!