VB常用函数收集[11.15更新...]

去掉所有HTML标记

Function FilterHTML(str,strlen)
　　Dim re
　　Set re=new RegExp
　　re.IgnoreCase =True
　　re.Global=True
　　re.Pattern="<(.[^>]*)>"
　　str=re.Replace(str,"")
　　set re=Nothing
　　Dim l,t,c,i
　　l=Len(str)
　　t=0
　　For i=1 to l
　　　　c=Abs(Asc(Mid(str,i,1)))
　　　　If c>255 Then
　　　　　　t=t+2
　　　　Else
　　　　　　t=t+1
　　　　End If
　　　　If t>=strlen Then
　　　　　　cutStr=left(str,i)&"..."
　　　　　　Exit For
　　　　Else
　　　　　　cutStr=str
　　　　End If
　　Next
　　cutStr=Replace(cutStr,chr(10),"")
　　cutStr=Replace(cutStr,chr(13),"")
End Function

判断字符串是否是合法的EMail

Public Function IsValidEmail(strEmail As String) As Boolean
Dim names, name, i, c
IsValidEmail = True
  
names = Split(strEmail, "@")

If UBound(names) <> 1 Then
　　IsValidEmail = False
　　Exit Function
End If

For Each name In names

　　If Len(name) <= 0 Then
　　　　IsValidEmail = False
　　　　Exit Function
　　End If

　　For i = 1 To Len(name)
　　　　c = LCase(Mid(name, i, 1))
　　　　If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 And Not IsNumeric(c) Then
　　　　　　IsValidEmail = False
　　　　　　Exit Function
　　　　End If
　　Next

　　If Left(name, 1) = "." Or Right(name, 1) = "." Then
　　　　IsValidEmail = False
　　　　Exit Function
　　End If

Next

If InStr(names(1), ".") <= 0 Then
　　IsValidEmail = False
　　Exit Function
End If

i = Len(names(1)) - InStrRev(names(1), ".")

If i <> 2 And i <> 3 Then
　　IsValidEmail = False
　　Exit Function
End If

If InStr(strEmail, "..") > 0 Then
　　IsValidEmail = False
　　Exit Function
End If

End Function