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

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

　　演示地址： 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(［代码］，［类型］)
%>%>
var aspCode_resultScript = function() {
function getTitle(text) {
text = String(text);
text = text.replace(/ /gi , "\t");
text = text.replace(/ /gi , " ");
text = text.replace(/&/gi , "&");
text = text.replace(/"/gi , "\"");
text = text.replace(/</gi , "<");
text = text.replace(/>/gi , ">");
text = text.replace(/
/gi , "\n");
text = text.replace(/<\/?font[^>]*>/gi , "");
return text.substring(0,600) + (text.length > 600 ? "......" : "");
}
var _asp = [];
for (var i = 0 ; 1 == 1 ; i++) {
var op1 = document.getElementById("aspCode_ex_" + i);
if (! op1) break;
op1.onselectstart = function() {
return false;
}
op1.onclick = function() {
var idx = this.id.replace(/[^\d]/g , "");
var op2 = document.getElementById("asp" + idx);
if (this.ex == "＋") {
_asp[idx] = op2.innerHTML;
this.ex = "－";
this.title = "展开";
op2.innerHTML = " [ASP代码块] 双击展开 ";
op2.ondblclick = function() {
document.getElementById("aspCode_ex_" + idx).onclick();
}
op2.title = getTitle(_asp[idx]);
} else {
this.ex = "＋"
this.title = "收起";
op2.innerHTML = _asp[idx];
op2.ondblclick = function() {
;
}
op2.title = "";
}
}
//op1.onclick();
}
};aspCode_resultScript();