把下面代码保存为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_AspCodeHighLightPrivate RegExPublic Keyword,ObjectCommand,Strings,VBCodePublic KeyWordColor,ObjectCommandColor,StringsColor,Comment,CodeColor Private Sub Class_Initialize() Set RegEx = New RegExpRegEx.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,RetStrRegEx.Pattern =Pattern1 Set Matches = RegEx.Execute(Str) For Each Match In Matches ' 遍历 Matches 集合 Temp=Re(Match.value) Str = Replace(Str,Match.value,Temp) NextRegEx.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 TempIf VBCode="" Then MakeLi="" Exit FunctionEnd 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 FunctionEnd Classstar=timer()Set TT = New Wyd_AspCodeHighLightIf Request("Content")<>"" Then TT.VBCode=Request("Content") Response.write TT.MakeLi() REsponse.write "<br>耗时："&FormatNumber(timer()-star,2)*1000End If%></body></html>