码迷,mamicode.com
首页 > Web开发 > 详细

GetImageURL

时间:2017-08-05 23:32:04      阅读:237      评论:0      收藏:0      [点我收藏+]

标签:str   nts   传递参数   参数   deb   cti   each   name   get   

Sub GetImageUrl(ByVal URL As String)
    Dim strText As String
    Dim i As Long
    Dim OneImg
    
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .Send
        strText = .responsetext
    End With
    
    Dim arr() As String
    ReDim arr(1 To 1) As String
    
    With CreateObject("htmlfile")
        .write strText
        i = 0
        For Each OneImg In .getElementsByTagName("img")
           If OneImg.getAttribute("real_src") <> "Null" Then
                ‘If RegTest(CStr(OneImg.getAttribute("real_src")), "http(.+)sinaimg\.cn/(.+)") Then
                Debug.Print RegTest(OneImg.getAttribute("real_src"), "http://s\d+?(.+)sinaimg\.cn/(.+)")
                
                Debug.Print OneImg.getAttribute("real_src")
                ‘ End If
            End If
        Next
    End With
    
End Sub

Sub ddddddddd()
      GetImageUrl "http://blog.sina.com.cn/s/blog_5a18c50f0102x8lg.html"
End Sub
Sub dd()
     Debug.Print RegTest("http://s14.sinaimg.cn/mw690/001Eip7Fzy7d3ZOIfKZfd&690", "http(.+)sinaimg\.cn/(.+)")
End Sub

Public Function RegTest(ByVal OrgText As String, ByVal Pattern As String) As Boolean
‘传递参数 :原字符串, 匹配模式
    Dim Regex As Object
    Set Regex = CreateObject("VBScript.RegExp")
    With Regex
        .Global = True
        .Pattern = Pattern
    End With
    RegTest = Regex.TEST(OrgText)
    Set Regex = Nothing
End Function

  

GetImageURL

标签:str   nts   传递参数   参数   deb   cti   each   name   get   

原文地址:http://www.cnblogs.com/nextseven/p/7291764.html

(0)
(0)
   
举报
评论 一句话评论(0
登录后才能评论!
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码!