复制代码 代码如下:
ClassWyd_AspCodeHighLight
PrivateRegEx
PublicKeyword,ObjectCommand,Strings,VBCode
PublicKeyWordColor,ObjectCommandColor,StringsColor,Comment,CodeColor
PrivateSubClass_Initialize()
SetRegEx=NewRegExp
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=""
EndSub
PrivateSubClass_Terminate()
SetRegEx=Nothing
EndSub
PrivateFunctionM_Replace(Str,Pattern,Color)
RegEx.Pattern=Pattern''设置模式。
M_Replace=RegEx.Replace(Str,"<fontcolor="&Color&">$1</font>")
EndFunction
PrivateFunctionString_Replace(Str,Pattern,Pattern1,Color,IsString)
DimTemp,RetStr
RegEx.Pattern=Pattern1
SetMatches=RegEx.Execute(Str)
ForEachMatchInMatches''遍历Matches集合
Temp=Re(Match.value)
Str=Replace(Str,Match.value,Temp)
Next
RegEx.Pattern=Pattern''设置模式。
IfIsString=1Then
String_Replace=RegEx.Replace(Str,"<fontcolor="&Color&">"$1"</font>")
Else
String_Replace=RegEx.Replace(Str,"<fontcolor="&Color&">$1</font>")
EndIf
EndFunction
PrivateFunctionRe(Str)
DimTRegEx,Temp
SetTRegEx=NewRegExp
TRegEx.IgnoreCase=True''设置是否区分字母的大小写。
TRegEx.Global=True''设置全程性质。
TRegEx.Pattern="<.*?>"
Temp=TRegEx.Replace(Str,"")
Temp=Replace(Temp,"<","")
Temp=Replace(Temp,">","")
Re=Temp
SetTRegEx=Nothing
EndFunction
PublicFunctionMakeLi()
DimTemp
IfVBCode=""Then
MakeLi=""
ExitFunction
EndIf
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="<FONTCOLOR="&CodeColor&">"&RepVbCrlf(Temp)&"</FONT>"
EndFunction
PublicFunctionRepVbCrlf(fString)
RepVbCrlf=Replace(fString,CHR(10),"<BR>")
EndFunction
PublicFunctionHTMLEncode(fString)
IfIsNull(fString)OrfString=""Then
HTMLEncode=""
ExitFunction
EndIf
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
EndFunction
EndClass

例子
star=timer()
SetTT=NewWyd_AspCodeHighLight
IfRequest("xx")<>""Then
TT.VBCode=Request("xx")
Response.writeTT.MakeLi()
REsponse.write"<br>"&FormatNumber(timer()-star,2)*1000
Else
%>
<FORMMETHOD=POSTaction="Index2.asp">
<TEXTAREANAME="xx"ROWS="30"COLS="80">ClassLih
PrivateRegEx
PublicKeyword,ObjectCommand,Strings,VBCode
PublicKeyWordColor,ObjectCommandColor,StringsColor,Comment
PrivateSubClass_Initialize()
SetRegEx=NewRegExp
KeyWordColor="#0000FF"
ObjectCommandColor="#FF0000"
StringsColor="#FF00FF"
Comment="#008000"
Keyword="If|End|For|Next|Function|Then|Do|While|Wend|Class"
VBCode=""
EndSub
PrivateSubClass_Terminate()
SetRegEx=Nothing
EndSub
PrivateFunctionM_Replace(Str,Pattern,Color)
RegEx.IgnoreCase=False''设置是否区分字母的大小写。
RegEx.Global=True''设置全程性质。
RegEx.Pattern=Pattern''设置模式。</TEXTAREA>
<INPUTTYPE="submit"value=fff>
</FORM>
<%
EndIf
%>