ASP高亮类

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,"<font color="&color&">$1</font>")
 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,"<font color="&color&">"$1"</font>")
else
   string_replace=regex.replace(str,"<font color="&color&">$1</font>")
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="<font  color="&codecolor&">"&repvbcrlf(temp)&"</font>"
 end function
 public function repvbcrlf(fstring)
    repvbcrlf = replace(fstring, chr(10), "<br> ")
 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), "</p><p> ")
    ''fstring = replace(fstring, chr(10), "<br> ")
    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 "<br>"&formatnumber(timer()-star,2)*1000
else
%>
<form method=post action="index2.asp">
<textarea name="xx" rows="30" cols="80">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  '' 设置模式。</textarea>
<input type="submit" value=fff>
</form>
<%
end if
%>