【 tulaoshi.com - Web开发 】
代码如下:
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), "/PP ")
''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
%