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