高亮度代码显示，ASP，VB，VBS，JS，JSP
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(［代码］，［类型］)
%> from:asp学习网/title:高亮度代码显示，ASP，VB，VBS，JS，JSP/ time:2006-4-28 16:54:26
本文主题高亮度代码显示，ASP，VB，VBS，JS，JSP
