演示地址： 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(［代码］，［类型］)
%>%>