ASP/VBS 正则表达式扩展函数

整理一下这几年做ASP常用的一些功能函数,有时间的话将分批整理.

今天就把有关正则表达式的先整理出来.

废话不多，下面是代码（老规矩，使用时请将Ｅ替换成E）:

'将普通字符串格式化为一个正则字符串
Function Str2Exp(ByVal tExp)
	Dim SpeChr
	SpeChr	= Array(92,33,34,36,40,41,42,43,44,45,46,47,58,61,63,91,93,94)
	For i=0 To Ubound(SpeChr)
		tExp	= Replace(tExp,Chr(SpeChr(i)),Chr(92)&Chr(SpeChr(i)))
	Next
	tExp	= Replace(tExp,Chr(32),"\s*")
	tExp	= Replace(tExp,Chr(9),"\s*")
	tExp	= Replace(tExp,Chr(13),"\s*")
	tExp	= Replace(tExp,Chr(10),"\s*")
	tExp	= Replace(tExp,Chr(11),"\s*")
	Str2Exp	= tExp
End Function

'生成一个正则表达式对象
Function REObject( reg, m)
	Dim re:Set re=new RegExp
	re.Pattern = reg
	If InStr(1, m, "g", 1)>0 Then re.Global = True
	If InStr(1, m, "i", 1)>0 Then re.IgnoreCase = True
	If InStr(1, m, "m", 1)>0 Then re.MultiLine = True
	Set REObject=re
End Function

'正则匹配简便写法
Function RegTest( reg, str)
	RegTest=RegExpTest(reg,"ig",str)
End Function

'正则替换简便写法
Function RegReplace( reg, str, rstr)
	RegReplace=RegExpReplace(reg,"ig",str,rstr)
End Function


'正则测试字符串
Function RegExpTest( reg, m, str)
	RegExpTest=REObject(reg, m).test(str)
End Function

'正则替换字符串
Function RegExpReplace( reg, m, str, rstr)
	RegExpReplace=REObject(reg, m).Replace(str,rstr)
End Function


Function RegＥxecute( reg, str, param)
	RegＥxecute=RegExpＥxecute( reg, "ig", str, param)
End Function

'//执行正则,返回一个匹配到的数组
Function RegExpＥxecute( reg, m, str, Param)
	Dim Match, Matches, Arr, i, Re
	Set Re = REObject(reg, m)
	Set Matches=Re.Ｅxecute(str)
	i = 0
	If Matches.Count>0 Then
		ReDim Arr(Matches.Count-1)
		For Each Match In Matches
			Arr(i)= Re.Replace(Match.Value, Param)
			i = i + 1
		Next
	Else
		ReDim Arr(0)
	End If
	RegExpＥxecute = Arr
End Function

'//带回调函数执行替换,简便写法
Function RegReplaceCall( reg, str, fstr)
	RegReplaceCall = RegExpReplaceCall(reg, "ig", str, fstr)
End Function

'//带回调函数执行替换
Function RegExpReplaceCall( reg, m, str, fstr)
	Dim Fun, Match, Matches, i, nStr, LastIndex
	If str & "" = "" Then Exit Function
	Set Fun = getRef(fstr)
	Set Matches = REObject(reg,m).Ｅxecute(Str)
	LastIndex = 1
	For Each Match In Matches
		If Match.FirstIndex>0 Then
			nStr = nStr & Mid(Str, LastIndex, Match.FirstIndex+1-LastIndex)
		End If
		nStr = nStr & Fun(Match)
		
		LastIndex = Match.FirstIndex+1+Match.Length
	Next
	nStr = nStr & Mid(Str, LastIndex)
	RegExpReplaceCall = nStr
End Function

'//去除非法字符
Function BadWord(str,rstr)
	BadWord=RegExpReplace("[\x00-\x2f\x3a-\x40\x5b-\x60\x7b-\x7f]+","ig",str,rstr)
End Function

'替换掉字符串中的所有标签
Function ReplaceTag( str)
	ReplaceTag=RegExpReplace("<[^>]*>","ig",str,"")
End Function

'替换多余空格
Function html2txt(str,le)
	str=Replace(str&"","&nbsp;"," ")
	html2txt=Left(RegExpReplace("(\s)\s+","ig",ReplaceTag(str),"$1"),le)
End Function

'邮箱格式匹配
Function TestMail( m)
	TestMail=False
	Dim reg:reg="^\w+((-\w+)|(\.\w+))*\@[A-Za-z0-9]+((\.|-)[A-Za-z0-9]+)*\.[A-Za-z0-9]+$"
	TestMail=RegExpTest(reg,"ig",m)
End Function

'判断合法字符
Function IsWord( str)
	IsWord=RegExpTest("^[\u4e00-\u9fa5\w\d]*$","ig",str)
End Function

'批量ID匹配
Function TestBat( c)
	TestBat=False
	TestBat=RegExpTest("^\s*\d+(?:\s*,\s*\d+\s*)*$","ig",c)
End Function


'//简化html代码,只保留指定的标签
Function SimpleHTML(content,tags)
	If tags="" Then tags="p,br"
	SimpleHTML = RegReplace("<(\/?)("& Replace(tags,",","|") &")([^>]*)>",content&"","[$1$2$3]")
	SimpleHTML = RegReplace("<[^>]*>",SimpleHTML,"")
	SimpleHTML = RegReplace("\[(\/?)("& Replace(tags,",","|") &")([^\]]*)\]",SimpleHTML,"<$1$2$3>")
End Function

'//移除所有html代码
Function RemoveHTML(Content)
	RemoveHTML = Replace(Content&"","&nbsp;"," ")
	RemoveHTML = RegReplace("<[^>]*>",RemoveHTML,"")
End Function

简单说明:

以上正则体系包含方便的生成正则式的函数，使用正则式检测，替换的函数。

部分函数相同功能分一个简便版本，一个复杂版本，复杂版本是功能的真正实现，简便版本少了一个参数，默认使用正则表达式的全局模式和忽略大小写模式，这种模式是最常用到的。

重点介绍以下几个函数:

REObject:    根据传入的正则字符串和模式字符串生成一个正则对象

RegTest和RegExpTest:    使用正则表达式检测字符串.

RegReplace和RegExpReplace:    使用正则表达式替换匹配到的字符。

RegＥxecute和RegExpＥxecute:    使用正则表达式匹配指定的字符串，返回匹配到的数组。这个函数是最开始用于实现js中的正则替换回调函数的功能。

不过用法比较麻烦，而且实现原理上也有漏洞。做法就是将匹配出的字符依次处理后，再根据替换字符一个一个替换回去。

RegReplaceCall和RegExpReplaceCall:    这个是真正实现js中正则替换回调函数功能的函数；但有一点就是函数只能将函数名作为字符串传入，而且要写成全局函数；不可使用系统函数，因为使用了getRef获取函数引用，这种方法不能获取系统函数的引用。回调函数接收一个参数，就是当前的Match对象，它有几种属性和方法可以使用:

Match.FirstIndex:匹配的首字符位置.从0开始(这与VBS中字符索引位置不同)

Match.subMatches(index):获取指定的子匹配，索引从0开始

Match.Length:匹配到的字符串长度；

其它方法可查阅VBS手册;

我用它写了个单词首字母大写的函数实现：

'//过滤拼音中的特殊字符首字母大写
Public Function FilterPinYin( Str)
	Dim pReg, rMatch, rMth, nStr
	Str = RegReplaceCall("(^|\s+)(\w)",Trim(Str),"toUCase")
	Str = RegReplace("[^\w\d\-_]",Str,"-")
	FilterPinYin = Str
End Function

Function toUCase(objMatch)
	toUCase = UCase(objMatch.subMatches(1))
End Function

Response.Write FilterPinYin("wo shi yi ge ren")
'//输出
'//WoShiYiGeRen