VBScript版代码高亮

<!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 '定义类'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 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 = "" '多行注释结束 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 PropertyEnd 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 document.getElementById("highlight").innerHTML = Hl.ExecuteEnd 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>

　　推荐阅读

　　对textarea框的代码调试，而且功能上使用非常方便，酷

<HTML><HEAD><META http-equiv='Content-Type' content='text/html; charset=gb2312'><TITLE>对textarea框的代码调试，而且功能上使用非常方便，酷</TITLE></HEAD><BODY > <SCRIPT>function JM_cc(ob){ob.select()>>>详细阅读

本文标题：VBScript版代码高亮

地址：http://www.17bianji.com/kaifa2/JS/31716.html

1/2 1