哪位牛人帮我改改下面的正则提取url的代码

[一如既往哈]

代码如下：

Public Function ReturnRegExStr(ByVal FromStrs As String) As String
    On Error Resume Next
    Dim bPatrn As String, w1 As String, w2 As String ' 创建变量。
    Dim regEx As New RegExp, Match, Matches
    bPatrn = "((http|https|ftp|rtsp|mms):(\/\/|\\\\)((\w)+[.]){1,}([a-z]{1,3}|[0-9]{1,3})(((\/[\~]*|\\[\~]*)(\w)+)|[.](\w)+)*(((([?](\w)+){1}[=]*))*((\w)+){1}([\&](\w)+[\=]((\w)+|-|%|\+|\#|(\w)+)*)*))"
'    bPatrn = "\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*"
'    bPatrn = "http://([\w-]+\.)+[\w-]+(/[\w- ./?%&=]*)?"
    regEx.Pattern = bPatrn '设置模式。'"\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*"'
    regEx.IgnoreCase = True '设置是否区分大小写。
    regEx.Global = True '设置全程匹配。
    Set Matches = regEx.Execute(FromStrs) '执行搜索。
    w1 = ""
    If Matches.Count < 1 Then Exit Function
    For Each Match In Matches '循环遍历Matches集合。
        w2 = Trim(Match.Value)
        If w2 <> "" Then
            w1 = w1 & IIf(w1 <> "", vbCrLf, "") & w2
        End If
    Next
    ReturnRegExStr = w1 '返回所有值
End Function
Sub Test()
    Dim w1 As String
    w1 = "wofw我们http://www.baidu.com?id=1&g=3-dfgkl，请访问www.baidu.com,或者sfkhttp://www.baidu.com/s?bs=%CC%EC%C6%F8%D4%A4%B1%A8%B2%E9%D1%AFreye&f=8&wd=%CC%EC%C6%F8%D4%A4%B1%A8%B2%E9%D1%AF"
    Debug.Print ReturnRegExStr(w1)
    '''应该返回下面3个地址：----但结果是错误的!!!
    '''1、http://www.baidu.com?id=1&g=3
    '''2、www.baidu.com
    '''3、http://www.baidu.com/s?bs=%CC%EC%C6%F8%D4%A4%B1%A8%B2%E9%D1%AFreye&f=8&wd=%CC%EC%C6%F8%D4%A4%B1%A8%B2%E9%D1%AF
End Sub

[一如既往哈]

期待你的老公的出现

[dbcontrols]

这事得问你的老公 http://hi.csdn.net/sysdzw

[一如既往哈]

感谢楼上的回复，如果网址是 http://tt.baidu.com 呢？

[孤独剑_LPZ]

第2个网址不标准,取不出,取另2个没有问题

[孤独剑_LPZ]

换种思路

Private Sub Form_Load()
    Dim w1 As String, ss() As String, i As Long, j As Long
    w1 = "wofw我们http://www.baidu.com?id=1&g=3-dfgkl，请访问www.baidu.com,或者sfkhttp://www.baidu.com/s?bs=%CC%EC%C6%F8%D4%A4%B1%A8%B2%E9%D1%AFreye&f=8&wd=%CC%EC%C6%F8%D4%A4%B1%A8%B2%E9%D1%AF"
    ss = Split(w1, "www.")
    For i = 1 To UBound(ss)
       j = IIf(InStr(ss(i), "，") > 0, InStr(ss(i), "，"), InStr(ss(i), ","))
       If j = 0 Then j = Len(ss(i)) + 1
       ss(i) = Left(ss(i), j - 1)
       ss(i) = Replace(ss(i), "-dfgkl", "")
       Debug.Print "http://" & ss(i)
    Next
End Sub

结果:
http://baidu.com?id=1&g=3
http://baidu.com
http://baidu.com/s?bs=%CC%EC%C6%F8%D4%A4%B1%A8%B2%E9%D1%AFreye&f=8&wd=%CC%EC%C6%F8%D4%A4%B1%A8%B2%E9%D1%AF

[一如既往哈]

非常感谢sysdzw

正则表达式偶不懂，上面用的都是从网上抄来的，好像没有一个能完全提取到正确的url地址，真是奇怪！！

[一如既往哈]

大侠（sysdzw），好像还有点问题，我在测试下面的语句时，第一个地址应该是错误的。
w1 = "wofw我们http://www.baidu.com?id=1&g=3 9-dfgkl，请访问456 wbq.baidu.com 78,或者sfkhttp://www.baidu.com/s?bs=%CC%EC%C6%F8%D4%A4%B1%A8%B2%E9%D1%AFreye&f=8&wd=%CC%EC%C6%F8%D4%A4%B1%A8%B2%E9%D1%AF"

第一个地址取出的应该是 http://www.baidu.com?id=1&g=3
我测试的时候结果是：http://www.baidu.com?id=1&g=3 9-dfgkl，这显然不是偶想要的，

再麻烦一下啦。。。。。

[无·法]

[Quote=引用 8 楼 topc008 的回复:]

大侠（sysdzw），好像还有点问题，我在测试下面的语句时，第一个地址应该是错误的。
w1 = "wofw我们http://www.baidu.com?id=1&g=3 9-dfgkl，请访问456 wbq.baidu.com 78,或者sfkhttp://www.baidu.com/s?bs=%CC%EC%C6%F8%D4%A4%B1%A8%B2%E9%D1%AFreye&a……
[/Quote]url地址中完全允许有空格。

[无·法]

如果你不想要空格的url的话用下面的表达式：

((?:http|https|ftp|rtsp|mms)://)?([\w-]+\.)+[\w-]+((/|\?|/\?)[\w-\./\?%&=]*)?

注意比较有什么不同，学习学习。

[无·法]

不知道你的本意是什么，如果纯粹是为了提取url地址那么不需要像你写的那么复杂的，网上搜下提取url的正则表达式到处都是，根据你的需要稍微修改下就行了。

((?:http|https|ftp|rtsp|mms)://)?([\w-]+\.)+[\w-]+((/|\?|/\?)[\w- \./\?%&=]*)?

发现你还不完全了解[]的含义，这个里面而已放很多单个字符+|-|%|用[+-%]要简洁的多。