代码如下:

class wyd_aspcodehighlight 
private regex 
public keyword,objectcommand,strings,vbcode 
public keywordcolor,objectcommandcolor,stringscolor,comment,codecolor 
  private sub class_initialize() 
    set regex = new regexp 
regex.ignorecase = true   ' 设置是否区分字母的大小写 true 不区分。 
    regex.global = true   ' 设置全程性质。 
    keywordcolor="#0000ff" 
    objectcommandcolor="#ff0000" 
    stringscolor="#ff00ff" 
comment="#008000" 
codecolor="#993300" 
keyword="set|private|if|then|sub|end|function|for|next|do|while|wend|true|false|nothing|class" '关建字 请自己添加 
objectcommand="left|mid|right|int|cint|clng|string|join|array" '函数 请自己添加 
vbcode="" 
  end sub 
  private sub class_terminate() 
    set regex = nothing 
  end sub 
  private function m_replace(str,pattern,color) 
    regex.pattern = pattern  ' 设置模式。 
    m_replace=regex.replace(str,"$1") 
  end function  



  private function string_replace(str,pattern,pattern1,color,isstring) 
  dim temp,retstr 
regex.pattern =pattern1 
    set matches = regex.execute(str) 
    for each match in matches   ' 遍历 matches 集合 
       temp=re(match.value) 
       str = replace(str,match.value,temp) 
    next 
regex.pattern = pattern  ' 设置模式。 
if isstring=1 then 
       string_replace=regex.replace(str,""$1"") 
else 
    string_replace=regex.replace(str,"$1") 
end if 
  end function 


  private function re(str) 
   dim tregex,temp 
   set tregex = new regexp 
   tregex.ignorecase = true  ' 设置是否区分字母的大小写。 
   tregex.global = true   ' 设置全程性质。 
   tregex.pattern="<.*?>" 
   temp=tregex.replace(str,"") 
   temp=replace(temp,"<","") 
   temp=replace(temp,">","") 
   re=temp 
   set tregex=nothing 
  end function 

  public function makeli() 
    dim temp 
if vbcode="" then 
    makeli="" 
    exit function 
end if 
    vbcode=htmlencode(vbcode) 
    temp=m_replace(vbcode,"\b("&keyword&")\b",keywordcolor) 
    temp=m_replace(temp,"\b("&objectcommand&")\b",objectcommandcolor) 
    temp=string_replace(temp,"""(.*?)""","""(.*)(<.+?>)("&keyword&objectcommand&")+(<.+?>)(.*)""",stringscolor,1)' 字符串 
    temp=string_replace(temp,"(('|rem).*)","'(.*)(<.+?>)("&keyword&objectcommand&")+(<.+?>)(.*)",comment,0) '注释 
    makeli=""&repvbcrlf(temp)&"" 
  end function 
  public function repvbcrlf(fstring) 
     repvbcrlf = replace(fstring, chr(10), "
 ") 
  end function 
  public function htmlencode(fstring) 
     if isnull(fstring) or fstring="" then 
     htmlencode="" 
  exit function 
     end if 
     fstring = replace(fstring, ">", ">") 
     fstring = replace(fstring, "<", "<") 
     'fstring = replace(fstring, chr(32), " ") 
     'fstring = replace(fstring, chr(9), " ") 
     'fstring = replace(fstring, chr(34), """) 
     'fstring = replace(fstring, chr(39), "'") 
     'fstring = replace(fstring, chr(13), "") 
     'fstring = replace(fstring, chr(10) & chr(10), "

 ") 
     'fstring = replace(fstring, chr(10), "
 ") 
     htmlencode = fstring 
   end function 
end class 

 代码如下:

star=timer() 
set tt = new wyd_aspcodehighlight 
if request("xx")<>"" then 
  tt.vbcode=request("xx") 
  response.write tt.makeli() 
  response.write "
"&formatnumber(timer()-star,2)*1000 
else 

%> 
 
class lih 
private regex 
public keyword,objectcommand,strings,vbcode 
public keywordcolor,objectcommandcolor,stringscolor,comment 
  private sub class_initialize() 
    set regex = new regexp 
    keywordcolor="#0000ff" 
    objectcommandcolor="#ff0000" 
    stringscolor="#ff00ff" 
comment="#008000" 
keyword="if|end|for|next|function|then|do|while|wend|class" 
vbcode="" 
  end sub 
  private sub class_terminate() 
    set regex = nothing 
  end sub 
  private function m_replace(str,pattern,color) 
    regex.ignorecase = false   ' 设置是否区分字母的大小写。 
    regex.global = true   ' 设置全程性质。 
    regex.pattern = pattern  ' 设置模式。 
 
 
<%end if%>