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