[點(diǎn)晴永久免費(fèi)OA]ASP高亮類
代碼如下：
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 '' 設(shè)置是否區(qū)分字母的大小寫 True 不區(qū)分。 RegEx.Global = True '' 設(shè)置全程性質(zhì)。 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" ''關(guān)建字 請自己添加 ObjectCommand="Left|Mid|Right|Int|Cint|Clng|String|Join|Array" ''函數(shù) 請自己添加 VBCode="" End Sub Private Sub Class_Terminate() Set RegEx = Nothing End Sub Private Function M_Replace(Str,Pattern,Color) RegEx.Pattern = Pattern '' 設(shè)置模式。 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 '' 設(shè)置模式。 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 '' 設(shè)置是否區(qū)分字母的大小寫。 TRegEx.Global = True '' 設(shè)置全程性質(zhì)。 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> ''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 '' 設(shè)置是否區(qū)分字母的大小寫。 RegEx.Global = True '' 設(shè)置全程性質(zhì)。 RegEx.Pattern = Pattern '' 設(shè)置模式。</TEXTAREA> <INPUT TYPE="submit" value=fff> </FORM> <% End If %> 該文章在 2022/7/5 1:03:00 編輯過 |
相關(guān)文章
正在查詢... 
|
400 186 1886
