生成语法高亮代码

把下面代码保存为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>

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值