如何写一个正则表达式，匹配 href=url

Question

6、假如有协议头(包含 :// 的)话，只允许 http://，以防止这些 ftp:// file:// edonkey:// op:// 东东

Answer 1

re.Pattern = "^((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+)"
strContent = re.Replace(strContent,"<a target=_blank href=$1>$1</a>")
re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+)$"
strContent = re.Replace(strContent,"<a target=_blank href=$1>$1</a>")
re.Pattern = "([^>=""])((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+)"
strContent = re.Replace(strContent,"$1<a target=_blank href=$2>$2</a>")
re.Pattern = "([^(http://|http:\\)])((www|cn)[.](\w)+[.]{1,}(net|com|cn|org|cc)(((\/[\~]*|\\[\~]*)(\w)+)|[.](\w)+)*(((([?](\w)+){1}[=]*))*((\w)+){1}([\&](\w)+[\=](\w)+)*)*)"
strContent = re.Replace(strContent,"$1<a target=_blank href=http://$2>$2</a>")

Answer 2

写漏，也不匹配 vbscript 开头的，如 href="vbscript:func()"

Answer 3

<SCRIPT LANGUAGE="JavaScript">
<!--
//var str = 'href="http://aaa.bbb.cc"'
//var str = "href='http://aaa.bbb.cc'"
//var str = 'href=http://aaa.bbb.cc'
//var str = 'href="           http://aaa.bbb.cc    "'
var str = 'href=http://aaa.bbb.cc:599/ddcc/ss.asp'
//var str = 'href="aas/ddcc/page.htm"'//但不匹配如下地址：
//var str = 'href="#top"'
//var str = 'href="vbs:func()"'
//var str = 'href="javascript:test()"'
//var str = 'href="javascript1.2:test()"'
//var str = 'href="JScript:test()"'
//var str = 'href="VBScript:test()"'var reg = /^href=(\"|\'|)\s*((http:\/\/[^\1]+)|([^#()\1]+))\s*\1$/i;
var mm = str.match(reg);
if (mm)  alert(mm[2]);
//-->
</SCRIPT>

Answer 4

thanks all.要求检验容错严格些，折腾半天，自己写了一堆代码，虽然不是最优，但也能正常工作了

Answer 5

<%
Function GetXMLHTTPObject()
On Error Resume Next
Dim obj
Set obj = Server.CreateObject("Microsoft.XMLHTTP")
If Not IsObject(obj) Then
Set obj = Server.CreateObject("Msxml2.XMLHTTP")
If Not IsObject(obj) Then Set obj = Server.CreateObject("MSXML2.ServerXMLHTTP")
End If
If IsObject(obj) Then Set GetXMLHTTPObject = obj Else Set GetXMLHTTPObject = Null
End Function Function GetHTMLContent(Url)
On Error Resume Next
Dim objXML, html

GetHTMLContent = ""

Set objXML = GetXMLHTTPObject()
If Not IsObject(objXML) Then Exit Function

    objXML.Open "GET", Url, False
    objXML.Send
    
    'If NO Err Then
    GetHTMLContent = objXML.responseText
    
    Set objXML = Nothing
End FunctionSub GetWebSiteHref(startUrl, deepStep)
Dim html

html = GetHTMLContent (startUrl)

If Len(html) = 0 Then Exit Sub

Dim regEx, match, matches, tagA, url, title, isValidUrl

Set regEx = New RegExp

regEx.IgnoreCase = True
regEx.Global     = True regEx.Pattern  = "<\s*a\s+[^<>]*href\s*=[^<>]*>[^<>]*</a\s*>"
Set matches = regEx.Execute(html)

For Each match In matches
url   = ""
title = ""

tagA = Trim(match.Value)
    'Response.Write Server.HTMLEncode(tagA) & Chr(13)
    
    ' 截取url
    
    regEx.Pattern = "<\s*a\s+[^<>]*href\s*=\s*\'"
    If regEx.Test(tagA) Then
    url = Trim(regEx.Replace(tagA, ""))     regEx.Pattern = "\'[^<>]*>[^<>]*</a\s*>"
    url = Trim(regEx.Replace(url, ""))
    Else
     regEx.Pattern = "<\s*a\s+[^<>]*href\s*=\s*\"""
     If regEx.Test(tagA) Then
     url = Trim(regEx.Replace(tagA, ""))      regEx.Pattern = "\""[^<>]*>[^<>]*</a\s*>"
     url = Trim(regEx.Replace(url, ""))
     Else
     regEx.Pattern = "<\s*a\s+[^<>]*href\s*=\s*"
     url = Trim(regEx.Replace(tagA, ""))
    
     regEx.Pattern = "\s+[^<>]*>[^<>]*</a\s*>"
     If regEx.Test(tagA) Then
     url = Trim(regEx.Resplace(tagA, ""))
     Else
     regEx.Pattern = "\s*>[^<>]*</a\s*>"
     url = Trim(regEx.Resplace(tagA, ""))
     End If
     End If
    End If
         
    regEx.Pattern = "[\f\n\r\t\v]*"
    url = Trim(regEx.Replace(url, ""))
    
    url = Trim(regEx.Replace(url, ""))     isValidUrl = True
    If Len(url) = 0 Or Left(url, 1) = "#" Then isValidUrl = False
    
    If isValidUrl And InStr(url, "://") > 0 Then 
     If UCase(Left(url, 7)) <> "HTTP://" Then isValidUrl = False
    End If
    
    If isValidUrl Then
     regEx.Pattern = "JAVASCRIPT[\d\.]*\s*:.*"
     isValidUrl = Not regEx.Test(url)
    End If
    
    If isValidUrl Then
     regEx.Pattern = "JSCRIPT[\d\.]*\s*:.*"
     isValidUrl = Not regEx.Test(url)
    End If
    
    If isValidUrl Then
     regEx.Pattern = "VBS\s*:.*"
     isValidUrl = Not regEx.Test(url)
    End If
    
    If isValidUrl Then
     regEx.Pattern = "VBSCRIPT\s*:.*"
     isValidUrl = Not regEx.Test(url)
    End If
    
    If isValidUrl Then
' 截取标题     
    
    regEx.Pattern = "<\s*a\s+[^<>]*href\s*=[^<>]*>"
    title = Trim(regEx.Replace(tagA, ""))
    
    regEx.Pattern = "</a\s*>"
    title = Trim(regEx.Replace(title, ""))
    
    regEx.Pattern = "[\f\n\r\t\v]*"
    title = Trim(regEx.Replace(title, ""))
         
    Response.Write Server.HTMLEncode(title) & "(" & url & ")" & Chr(13)
    
    ' Do Something, Get Page Content
    ' ....
    End If
Next

Set matches = Nothing

Set regEx = Nothing
End Sub'Call GetWebSiteHref("http://www.MicroSoft.com/", 1)
%>