对VB/ASP源代码进行着色

这类程序在网上很多，但拿来练练“正则表达式”也不错的，所以就随手写了这个，现在只能对代码（函数，关键字，对象，字符串）进行着色，下一步想对函数块加入折叠效果（.NET代码编辑器的效果）。

演示效果代码：（ChangeVBToColor函数即是重点函数）
---------------------------------------------------------------------------------------------------------------
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
"http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>无标题文档</title>
<style type="text/css">
<!--
body {
 font-family: "宋体";
 font-size: 12px;
 color: #333333;
}
.Text {
 font-family: "宋体";
 font-size: 12px;
 border: 1px solid #333333;
}
td {
 font-family: "宋体";
 font-size: 12px;
}
-->
</style>
</head>

<body>
<table width="760" height="399" border="0" cellpadding="0" cellspacing="2">
  <tr>
    <td height="302" valign="top"><form name="form1" method="post" action="">
      <div align="center">
        <textarea name="Content" cols="120" rows="25" class="Text" id="Content"></textarea>       
        <br>
        <input name="btnShow" type="button" class="Text" id="btnShow" value="显  示" OnClick="GetHtmlContent()"> 
          </div>
    </form></td>
  </tr>
  <tr>
    <td height="91"><span id="sHtml"></span></td>
  </tr>
</table>
<SCRIPT LANGUAGE="VBScript">
Sub GetHtmlContent
    'GGG form1.Content.value
 document.all.sHtml.innerHTML=ChangeVbToColor(HtmlEncode(form1.Content.value))
End Sub

Function ChangeVbToColor(ByVal sText)
Dim re,Matches,i
Dim oneReg
Set re=new RegExp
re.IgnoreCase =true
re.Global=true
'转换函数块
're.Pattern="Function (/w+)(/([^/)]*/))?([^End Function]*)End Function"
'sText=re.Replace(sText,"<font color=red>$1</font>")
'sText=re.Replace(sText,"<img src=http://www.cnblogs.com/Images/OutliningIndicators/ExpandedSubBlockStart.gif>$3")
'alert sText
'转换保留字为[蓝色]
re.Pattern="(/bAnd/b|/bByRef/b|/bByVal/b|/bCall/b|/bCase/b|/bClass/b|/bConst/b|/bDim/b|/bDo/b|/bEach/b|/bElse/b|/bElseIf/b|/bEmpty/b|/bEnd/b|/bEqv/b|/bErase/b|/bError/b|/bExit/b|/bExplicit/b|/bFalse/b|/bFor/b|/bFunction/b|/bGet/b|/bIf/b|/bImp/b|/bIn/b|/bIs/b|/bLet/b|/bLoop/b|/bMod/b|/bNext/b|/bNot/b|/bNothing/b|/bNull/b|/bOn/b|/bOption/b|/bOr/b|/bPrivate/b|/bProperty/b|/bPublic/b|/bRandomize/b|/bReDim/b|/bRem/b|/bResume/b|/bSelect/b|/bSet/b|/bStep/b|/bSub/b|/bThen/b|/bTo/b|/bTrue/b|/bUntil/b|/bWend/b|/bWhile/b|/bXor/b)"
sText=re.Replace(sText,"<font color=blue>$1</font>")
'转换函数和对象为[红色]
re.Pattern="(/bAnchor/b|/bArray/b|/bAsc/b|/bAtn/b|/bCBool/b|/bCByte/b|/bCCur/b|/bCDate/b|/bCDbl/b|/bChr/b|/bCInt/b|/bCLng/b|/bCos/b|/bCreateObject/b|/bCSng/b|/bCStr/b|/bDate/b|/bDateAdd/b|/bDateDiff/b|/bDatePart/b|/bDateSerial/b|/bDateValue/b|/bDay/b|/bDictionary/b|/bDocument/b|/bElement/b|/bErr/b|/bExp/b|/bFileSystemObject /b|/bFilter/b|/bFix/b|/bInt/b|/bForm/b|/bFormatCurrency/b|/bFormatDateTime/b|/bFormatNumber/b|/bFormatPercent/b|/bGetObject/b|/bHex/b|/bHistory/b|/bHour/b|/bInputBox/b|/bInStr/b|/bInstrRev/b|/bIsArray/b|/bIsDate/b|/bIsEmpty/b|/bIsNull/b|/bIsNumeric/b|/bIsObject/b|/bJoin/b|/bLBound/b|/bLCase/b|/bLeft/b|/bLen/b|/bLink/b|/bLoadPicture/b|/bLocation/b|/bLog/b|/bLTrim/b|/bRTrim/b|/bTrim/b|/bMid/b|/bMinute/b|/bMonth/b|/bMonthName/b|/bMsgBox/b|/bNavigator/b|/bNow/b|/bOct/b|/bReplace/b|/bRight/b|/bRnd/b|/bRound/b|/bScriptEngine/b|/bScriptEngineBuildVersion/b|/bScriptEngineMajorVersion/b|/bScriptEngineMinorVersion/b|/bSecond/b|/bSgn/b|/bSin/b|/bSpace/b|/bSplit/b|/bSqr/b|/bStrComp/b|/bString/b|/bStrReverse/b|/bTan/b|/bTime/b|/bTextStream/b|/bTimeSerial/b|/bTimeValue/b|/bTypeName/b|/bUBound/b|/bUCase/b|/bVarType/b|/bWeekday/b|/bWeekDayName/b|/bWindow/b|/bYear/b)"
sText=re.Replace(sText,"<font color=red>$1</font>")
'转换字符串为[紫色]
re.Pattern="(""[^""]*"")"
sText=re.Replace(sText,"<font color=#FF33FF>$1</font>")
sText = Replace(sText, CHR(34), "&quot;")
sText = Replace(sText, CHR(39), "&#39;")
ChangeVbToColor=sText
End Function

Function HTMLEncode(fString)
If Not isnull(fString) Then
 fString = replace(fString, "&", "&amp;")
    fString = replace(fString, ">", "&gt;")
    fString = replace(fString, "<", "&lt;")
 fString = replace(fString, CHR(32), "&nbsp;")
    fString = replace(fString, CHR(9), "&nbsp;")
    fString = Replace(fString, CHR(13), "")
    fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
    fString = Replace(fString, CHR(10), "<BR> ")
    HTMLEncode = fString
Else
    HTMLEncode=""
End If
End Function
Function GGG(ByVal sText)
dim re,name,strTemplate,Matches,i
Dim oneReg
set re=new RegExp
re.IgnoreCase =true
re.Global=true
're.Pattern= "<(.*)>.*<///1>"
re.Pattern="Function (/w+)(/([^/)]*/))?(.[^(End Function)]*)End Function"
Set Matches=re.Execute(sText)
alert sText
alert Matches.Count
For i =0 to Matches.Count-1
    alert Matches(i).SubMatches(0)&"<br>"
Next
End Function
</SCRIPT>
</body>
</html>