[正则表达式应用]高亮度代码显示

这样的方法最建议的方法就是用此生成ＨＴＭＬ，如果每次都这样处理的话？？？

　　演示地址： http://54caizi.com/kingcode.asp

　　绝对算不上是完美版，就此与大家分享下

　　近些日在ＮＢ上看到了这样的功能，就想到了来做，最开始写的还是ＪＡＶＡ类，今天花了点时间整理了下，转换成了ＡＳＰ类，给一些做文章显示的兄弟姐妹们用，算是给大家一个元旦“红包”吧。。。  ：）
好了，费话少说，贴出代码来！

[code] <%

Private CONST VB_KEY_COLOR="#000099"      'vb 代码关键字显示色
Private CONST VB_FUN_COLOR="#990033"      'vb 代码函数显示色
Private CONST VB_COM_COLOR="#bbbbbb"      'vb 代码注释显示色
Private CONST VB_STR_COLOR="#669933"      'vb 代码字符串显示色
     
Private CONST JAVASCRIPT_KEY_COLOR="#000099"      'javascript 代码关键字显示色
Private CONST JAVASCRIPT_FUN_COLOR="#990033"      'javascript 代码函数显示色
Private CONST JAVASCRIPT_COM_COLOR="#bbbbbb"      'javascript 代码注释显示色
Private CONST JAVASCRIPT_STR_COLOR="#669933"      'javascript 代码字符串显示色
     
Private CONST VBSCRIPT_KEY_COLOR="#000099"      'vbscript 代码关键字显示色
Private CONST VBSCRIPT_FUN_COLOR="#990033"      'vbscript 代码函数显示色
Private CONST VBSCRIPT_COM_COLOR="#bbbbbb"      'vbscript 代码注释显示色
Private CONST VBSCRIPT_STR_COLOR="#669933"      'vbscript 代码字符串显示色
     
Private CONST ASP_KEY_COLOR="#000099"      'asp 代码关键字显示色
Private CONST ASP_FUN_COLOR="#990033"      'asp 代码函数显示色
Private CONST ASP_COM_COLOR="#bbbbbb"      'asp 代码注释显示色
Private CONST ASP_STR_COLOR="#669933"      'asp 代码字符串显示色
%>
<%      
Private CONST JSP_KEY_COLOR="#000099"      'jsp 代码关键字显示色
Private CONST JSP_FUN_COLOR="#990033"      'jsp 代码函数显示色
Private CONST JSP_COM_COLOR="#bbbbbb"      'jsp 代码注释显示色
Private CONST JSP_STR_COLOR="#669933"      'jsp 代码字符串显示色

Class kingCode
     
     '类入口函数
     Public Function kingIn(s,c)
     
           s=kingFilter(s)
           Select Case c
                 Case "vb"
                       kingIn=vbCode(s)
                 Case "javascript"
                       kingIn=javascriptCode(s)
                 Case "vbscript"
                       kingIn=vbscriptCode(s)
                 Case "asp"
                       kingIn=aspCode(s)
                 Case "jsp"
                       kingIn=jspCode(s)
           End Select
     End Function
     
     '过滤HTML块
     Private Function kingFilter(s)

                 s = Replace(s, ">", ">")
                 s = Replace(s, "<", "<")
                 s = Replace(s, CHR(32), " ")
                 s = Replace(s, CHR(13), "<br>")
                 kingFilter = s
%>
<%      End Function
     
     'vb块
     Private Function aspCode(s)
           
           Dim Key:Key=Split("dim,redim,for,next,while,each,in,to,do,downto,resume,"+ _
                                         "boolean,as,select,case,exit,loop,class,function,sub,"+ _
                                         "public,byte,integer,string,private,end,nothing,timer,"+ _
                                         "if,then,wend,currency,long,single,new,set,empty,null,"+ _
                                         "false,true,call,const,erase,double,object,executeglobal,"+ _
                                         "else,on,option,explicit,property,get,let,randomize,rem,"+ _
                                         "with,and,not,or,mod,is,err,vba,error,goto,byval,byref,"+ _
                                         "application,session,request,response,server,objectcontext",",")
           Dim fun:fun=Split("abs,array,asc,atn,cbool,cbyte,ccur,execute,cdate,cdbl,chr,"+ _
                                         "cint,clng,cos,createobject,csng,cstr,date,dateadd,datediff,"+ _
%>
<%                                          "datepart,dateserial,datevalue,day,eval,exp,filter,fix,"+ _
                                         "formatcurrency,formatdatetime,formatnumber,formatpercent,"+ _
                                         "getlocale,getobject,getref,hex,hour,inputbox,instr,instrrev,"+ _
                                         "int,isarray,isdate,isempty,isnull,isnumeric,isobject,join,"+ _
                                         "lbound,lcase,left,len,loadpicture,log,ltrim,mid,minute,month,"+ _
                                         "monthname,msgbox,now,oct,replace,rgb,right,rnd,round,rtrim,"+ _
                                         "scriptengine,scriptenginebuildversion,scriptenginemajorversion,"+ _
                                         "scriptengineminorversion,second,setlocale,sgn,sin,space,split,"+ _
                                         "sqr,strcomp,strreverse,tan,time,timeserial,timevalue,trim,"+ _
                                         "typename,ubound,ucase,vartype,weekday,weekdayname,year,regexp,"+ _
%>
<%                                          "test,length,createobject,form,querystring,write,redirect,clear,"+ _
                                         "pattern,ignorecase,global,servervariables,binaryread,clientcertificate,"+ _
                                         "cookies,totalbytes,getlasterror,htmlencode,mappath,scripttimeout,"+ _
                                         "transfer,urlencode,contents,remove,removeall,lock,staticobjects,"+ _
                                         "unlock,show,abandon,codepage,lcid,sessionid,timeout,setabort(),"+ _
                                         "setcomplete,addheader,appendtoLog,binarywrite,buffer,cachecontrol,"+ _
                                         "charset,contenttype,expires,expiresabsolute,flush(),isclientconnected,"+ _
                                         "pics,status,move,movenext,movefirst,movelast,moveprevious,open,close,"+ _
                                         "addnew,update,count,fields,value,name,load,unload,eof,bof,print",",")
%>
<%            Dim regex,i,bs:bs=s
           Set regex=New Regexp
           regex.Global=True
           regex.IgnoreCase=True
           
           regex.Pattern="(\'.*)"
           bs=regex.Replace(bs,"<font color=" + ASP_COM_COLOR + ">$1</font>")
           
           regex.Pattern="(\""[^\""]*(\""\"")*[^\""]*\"")"
           bs=regex.Replace(bs,"<font color=" + ASP_STR_COLOR + ">$1</font>")
           
           For i=LBound(Key) To UBound(Key)
                 regex.Pattern="\b(" + Key(i) + ")\b"
                 bs=regex.Replace(bs,"<font color=" + ASP_KEY_COLOR + ">$1</font>")
           Next
           
           For i=LBound(fun) To UBound(fun)
                 regex.Pattern="\b(" + fun(i) + ")\b"
                 bs=regex.Replace(bs,"<font color=" + ASP_FUN_COLOR + ">$1</font>")
           Next
           
           '清除重复标记
           regex.Pattern="(<font color=(?=#bbbbbb>|#669933>))+(.*)<font color=.*>(.*)<\/font>(.*)(<\/font>)+"
           While(regex.Test(bs))
                 bs=regex.Replace(bs,"$1$2$3$4$5")
%>
<%            Wend
           regex=Null
           
           aspCode=bs
     End Function
     
     'vbscript 块
     Private Function vbscriptCode(s)
           
           Dim Key:Key=Split("dim,redim,for,next,while,each,in,to,do,downto,resume,"+ _
                                         "boolean,as,select,case,exit,loop,class,function,sub,"+ _
                                         "public,byte,integer,string,private,end,nothing,timer,"+ _
                                         "if,then,wend,currency,long,single,new,set,empty,null,"+ _
                                         "false,true,call,const,erase,double,object,executeglobal,"+ _
                                         "else,on,option,explicit,property,get,let,randomize,rem,"+ _
                                         "with,and,not,or,mod,is,err,vba,error,goto,byval,byref",",")
           Dim fun:fun=Split("abs,array,asc,atn,cbool,cbyte,ccur,execute,cdate,cdbl,chr,"+ _
                                         "cint,clng,cos,createobject,csng,cstr,date,dateadd,datediff,"+ _
%>
<%                                          "datepart,dateserial,datevalue,day,eval,exp,filter,fix,"+ _
                                         "formatcurrency,formatdatetime,formatnumber,formatpercent,"+ _
                                         "getlocale,getobject,getref,hex,hour,inputbox,instr,instrrev,"+ _
                                         "int,isarray,isdate,isempty,isnull,isnumeric,isobject,join,"+ _
                                         "lbound,lcase,left,len,loadpicture,log,ltrim,mid,minute,month,"+ _
                                         "monthname,msgbox,now,oct,replace,rgb,right,rnd,round,rtrim,"+ _
                                         "scriptengine,scriptenginebuildversion,scriptenginemajorversion,"+ _
                                         "scriptengineminorversion,second,setlocale,sgn,sin,space,split,"+ _
                                         "sqr,strcomp,strreverse,tan,time,timeserial,timevalue,trim,"+ _
                                         "typename,ubound,ucase,vartype,weekday,weekdayname,year,regexp,"+ _
%>
<%                                          "test,length,form,write,redirect,clear,"+ _
                                         "pattern,ignorecase,global,"+ _
                                         "event,window,document.cookies,iframe,all,elements,open,opener,close,value,"+ _
                                         "location,href,innerHTML,settimeout,setinterval,clearinterval,defaultstatus,title",",")
           Dim regex,i,bs:bs=s
           Set regex=New Regexp
           regex.Global=True
           regex.IgnoreCase=True
           
           regex.Pattern="(\'.*)"
           bs=regex.Replace(bs,"<font color=" + VBSCRIPT_COM_COLOR + ">$1</font>")
           
           regex.Pattern="(\""[^\""]*(\""\"")*[^\""]*\"")"
           bs=regex.Replace(bs,"<font color=" + VBSCRIPT_STR_COLOR + ">$1</font>")
           
           For i=LBound(Key) To UBound(Key)
                 regex.Pattern="\b(" + Key(i) + ")\b"
                 bs=regex.Replace(bs,"<font color=" + VBSCRIPT_KEY_COLOR + ">$1</font>")
%>
<%            Next
           
           For i=LBound(fun) To UBound(fun)
                 regex.Pattern="\b(" + fun(i) + ")\b"
                 bs=regex.Replace(bs,"<font color=" + VBSCRIPT_FUN_COLOR + ">$1</font>")
           Next
           
           '清除重复标记
           regex.Pattern="(<font color=(?=#bbbbbb>|#669933>))+(.*)<font color=.*>(.*)<\/font>(.*)(<\/font>)+"
           While(regex.Test(bs))
                 bs=regex.Replace(bs,"$1$2$3$4$5")
           Wend
           regex=Null
           
           vbscriptCode=bs
     End Function
     
     'javascript 块
     Private Function javascriptCode(s)
           
           Dim Key:Key=Split("new,function,var,if,else,switch,for,while,case,return",",")
           Dim fun:fun=Split("getdate,getday,gettime,substring,indexof,replace,replaceall,"+ _
                                         "trim,charat,tolowercase,touppercase,window,document.cookies,"+ _
                                         "event,iframe,all,elements,open,opener,close,value,"+ _
%>
<%                                          "location,href,innerHTML,settimeout,setinterval,clearinterval,defaultstatus,title",",")
           Dim regex,i,bs:bs=s
           Set regex=New Regexp
           regex.Global=True
           regex.IgnoreCase=True
           
           regex.Pattern="(\/\/.*)"
           bs=regex.Replace(bs,"<font color=" + JAVASCRIPT_COM_COLOR + ">$1</font>")
           
           regex.Pattern="(\""[^\""](\"")[^\""]*\"")"
           bs=regex.Replace(bs,"<font color=" +JAVASCRIPT_STR_COLOR + ">$1</font>")
           
           For i=LBound(Key) To UBound(Key)
                 regex.Pattern="\b(" + Key(i) + ")\b"
                 bs=regex.Replace(bs,"<font color=" + JAVASCRIPT_KEY_COLOR + ">$1</font>")
           Next
           
           For i=LBound(fun) To UBound(fun)
                 regex.Pattern="\b(" + fun(i) + ")\b"
                 bs=regex.Replace(bs,"<font color=" + JAVASCRIPT_FUN_COLOR + ">$1</font>")
           Next
           
           '清除重复标记
%>
<%            regex.Pattern="(<font color=(?=#bbbbbb>|#669933>))+(.*)<font color=.*>(.*)<\/font>(.*)(<\/font>)+"
           While(regex.Test(bs))
                 bs=regex.Replace(bs,"$1$2$3$4$5")
           Wend
           regex=Null
           
           javascriptCode=bs
     End Function
     
     'jsp 块
     Private Function jspCode(s)
           
           Dim Key:Key=Split("new,function,var,if,else,switch,for,while,case,return,class,private,public,"+ _
                                         "int,interger,float,double,char,byte,import",",")
           Dim fun:fun=Split("out,config,application,session,response,"+ _
                                         "getdate,getday,gettime,substring,indexof,replace,replaceall,"+ _
                                         "trim,charat,tolowercase,touppercase,window,document.cookies,"+ _
                                         "event,iframe,all,elements,open,opener,close,value,"+ _
                                         "location,href,innerHTML,settimeout,setinterval,clearinterval,defaultstatus,title",",")
%>
<%            Dim regex,i,bs:bs=s
           Set regex=New Regexp
           regex.Global=True
           regex.IgnoreCase=True
           
           regex.Pattern="(\/\/.*)"
           bs=regex.Replace(bs,"<font color=" + JSP_COM_COLOR + ">$1</font>")
           
           regex.Pattern="(\""[^\""]*(\""\"")*[^\""]*\"")"
           bs=regex.Replace(bs,"<font color=" + JSP_STR_COLOR + ">$1</font>")
           
           For i=LBound(Key) To UBound(Key)
                 regex.Pattern="\b(" + Key(i) + ")\b"
                 bs=regex.Replace(bs,"<font color=" + JSP_KEY_COLOR + ">$1</font>")
           Next
           
           For i=LBound(fun) To UBound(fun)
                 regex.Pattern="\b(" + fun(i) + ")\b"
                 bs=regex.Replace(bs,"<font color=" + JSP_FUN_COLOR + ">$1</font>")
           Next
           
           '清除重复标记
           regex.Pattern="(<font color=(?=#bbbbbb>|#669933>))+(.*)<font color=.*>(.*)<\/font>(.*)(<\/font>)+"
           While(regex.Test(bs))
                 bs=regex.Replace(bs,"$1$2$3$4$5")
%>
<%            Wend
           regex=Null
           
           jspCode=bs
     End Function
     
     'vb 块
     Private Function vbCode(s)
           Dim Key:Key=Split("dim,redim,for,next,while,each,in,to,do,downto,resume,"+ _
                                         "boolean,as,select,case,exit,loop,class,function,sub,"+ _
                                         "public,byte,integer,string,private,end,nothing,timer,"+ _
                                         "if,then,wend,currency,long,single,new,set,empty,null,"+ _
                                         "false,true,call,const,erase,double,object,executeglobal,"+ _
                                         "else,on,option,explicit,property,get,let,randomize,rem,"+ _
                                         "with,and,not,or,mod,is,err,vba,error,goto,byval,byref,app",",")
           Dim fun:fun=Split("abs,array,asc,atn,cbool,cbyte,ccur,execute,cdate,cdbl,chr,"+ _
                                         "cint,clng,cos,createobject,csng,cstr,date,dateadd,datediff,"+ _
%>
<%                                          "datepart,dateserial,datevalue,day,eval,exp,filter,fix,"+ _
                                         "formatcurrency,formatdatetime,formatnumber,formatpercent,"+ _
                                         "getlocale,getobject,getref,hex,hour,inputbox,instr,instrrev,"+ _
                                         "int,isarray,isdate,isempty,isnull,isnumeric,isobject,join,"+ _
                                         "lbound,lcase,left,len,loadpicture,log,ltrim,mid,minute,month,"+ _
                                         "monthname,msgbox,now,oct,replace,rgb,right,rnd,round,rtrim,"+ _
                                         "scriptengine,scriptenginebuildversion,scriptenginemajorversion,"+ _
                                         "scriptengineminorversion,second,setlocale,sgn,sin,space,split,"+ _
                                         "sqr,strcomp,strreverse,tan,time,timeserial,timevalue,trim,"+ _
                                         "typename,ubound,ucase,vartype,weekday,weekdayname,year,"+ _
%>
<%                                          "caption,text,filename,filecopy,killfile,open,close",",")
           Dim regex,i,bs:bs=s
           Set regex=New Regexp
           regex.Global=True
           regex.IgnoreCase=True
           
           regex.Pattern="(\'.*)"
           bs=regex.Replace(bs,"<font color=" + VB_COM_COLOR + ">$1</font>")
           
           regex.Pattern="(\""[^\""]*(\""\"")*[^\""]*\"")"
           bs=regex.Replace(bs,"<font color=" + VB_STR_COLOR + ">$1</font>")
           
           For i=LBound(Key) To UBound(Key)
                 regex.Pattern="\b(" + Key(i) + ")\b"
                 bs=regex.Replace(bs,"<font color=" + VB_KEY_COLOR + ">$1</font>")
           Next
           
           For i=LBound(fun) To UBound(fun)
                 regex.Pattern="\b(" + fun(i) + ")\b"
                 bs=regex.Replace(bs,"<font color=" + VB_FUN_COLOR + ">$1</font>")
           Next
           
           '清除重复标记
           regex.Pattern="(<font color=(?=#bbbbbb>|#669933>))+(.*)<font color=.*>(.*)<\/font>(.*)(<\/font>)+"
%>
<%            While(regex.Test(bs))
                 bs=regex.Replace(bs,"$1$2$3$4$5")
           Wend
           regex=Null
           
           vbCode=bs
     End Function
     
End Class
%>%>


以上保存成 kingCode.asp文件

用法：
在index.asp 里
<% <!--#include File="kingCode.asp"-->
<%
   Dim kc
   Set kc=New kingCode
   Response.Write kc(kingIn(［代码］，［类型］)
%>%>