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%>