ASP语法高亮类代码


            此类高亮根据Editplus高亮来做的  复制代码 代码如下: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%>