生成语法高亮代码

把下面代码保存为HightLightCode.asp：

< html >
< head >
< title > 生成语法高亮代码 </ title >
< meta http - equiv = " Content-Type "  content = " text/html; charset=gb2312 " >
</ head >
< body >
< FORM name = form1 METHOD = POST action = "" >
< TEXTAREA NAME = " Content "  ROWS = " 10 "  COLS = " 20 " >< % = Request( " Content " )% ></ TEXTAREA >
< br >< br >< INPUT TYPE = " submit "  value = " 生成语法高亮代码 "  name = " make " >
</ FORM >
< input name = " Increase "  title = " 增大编辑框 "  type = " button "  value = "  +  "  onClick = " javascript:form1.Content.rows=form1.Content.rows+2;form1.Content.cols=form1.Content.cols+4; " >   < input name = " Decrease "  title = " 缩小编辑框 "  type = " button "  value = "  -  "  onClick = " javascript:if((form1.Content.rows>10)&&(form1.Content.cols>20)){ form1.Content.rows=form1.Content.rows-2;form1.Content.cols=form1.Content.cols-4} " >< Br >
< %
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 & " >&quot;$1&quot;</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,  " > " ,  " &gt; " )
     fString  =   replace (fString,  " < " ,  " &lt; " )
      ' fString = Replace(fString, CHR(32), "&nbsp;")
      ' fString = Replace(fString, CHR(9), "&nbsp;")
      ' fString = Replace(fString, CHR(34), "&quot;")
      ' fString = Replace(fString, CHR(39), "&#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( " Content " ) <> ""   Then
  TT.VBCode = Request( " Content " )
  Response.write TT.MakeLi()
  REsponse.write  " <br>耗时： " & FormatNumber ( timer () - star, 2 ) * 1000
End   If % >
</ body >
</ html >

转载于:https://www.cnblogs.com/Dicky/archive/2005/03/17/122531.html