对VB/ASP源代码进行着色1

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

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

</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), """)
sText = Replace(sText, CHR(39), "'")
ChangeVbToColor=sText
End Function

Function HTMLEncode(fString)
If Not isnull(fString) Then
fString = replace(fString, "&", "&")
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = replace(fString, CHR(32), " ")
fString = replace(fString, CHR(9), " ")
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>

……

标签:对VB/ASP源代码进行着色