源码网商城,靠谱的源码在线交易网站 我的订单 购物车 帮助

源码网商城

ASP高亮类

  • 时间:2020-02-10 01:39 编辑: 来源: 阅读:
  • 扫一扫,手机访问
摘要:ASP高亮类
[u]复制代码[/u] 代码如下:
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), "</P><P> ")     ''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 %> 
  • 全部评论(0)
联系客服
客服电话:
400-000-3129
微信版

扫一扫进微信版
返回顶部