已结贴 - 编程论坛

#2

风吹过b2015-08-15 13:12

首先，这个地方往后是百度快照这四个字和链接，以这个来定位结尾。
其次这个域名是绿色的，应该是一个统一的 css ，用这个定开始位置。
最后，根据取到的内容进行分析，取自己要用和内容。

在手机上，没法写代码。电脑上周装了 win10了，还没 vb

#3

a2513572015-08-15 13:27

回复 2楼风吹过b

你说的这个方式我也试过加载成文字信息获取对应部分信息貌似不行！所以再次请教！

#4

wmf20142015-08-16 11:13

一般通过获取源文件，分析href标签并提取链接地址，又或者提取所有的“http://”打头的字符串也行。

#5

风吹过b2015-08-16 21:22

你是要取绿色那个内容，还是取百度出来的结果？
如果是百度出来的结果，按你的方法读取后，然后再读一遍。
如使用 webborws 再读取，或 winhttp 读都可以的。

如果是取绿色那个内容，按我二楼的方案去做。
<span class="g">info.
就是绿色部分，按这个 <span class="g"> 去搜索就可以了。

#6

a2513572015-08-17 00:09

回复 4楼 wmf2014

是这样的！第一张图是我想获取百度快照的那10个绿色链接 ,第二张图是网页源码百度自转码的链接其实都是他俩同一个链接只不过在源码里变得不同！我的问题是准确抓取那10个百度快照的链接！可是我怎么尝试都不知道怎么去过滤其他和准确的抓取！！！我写的代码也只是获取了百度里面的所有链接！却没有准确抓取想要的那10个链接！求源码过程！！十分感谢！我就是想做一个能每天检测我网站的排名动态！

#7

a2513572015-08-17 00:12

回复 5楼风吹过b

是这样的！第一张图是我想获取百度快照的那10个绿色链接 ,第二张图是网页源码百度自转码的链接其实都是他俩同一个链接只不过在源码里变得不同！我的问题是准确抓取那10个百度快照的链接！可是我怎么尝试都不知道怎么去过滤其他和准确的抓取！！！我写的代码也只是获取了百度里面的所有链接！却没有准确抓取想要的那10个链接！求源码过程！！十分感谢！我就是想做一个能每天检测我网站的排名动态！！！！

#8

a2513572015-08-17 01:03

Private Sub Form_Load()
Web1.Navigate "https://www.baidu.com/s?wd=动态混胶机"
End Sub

'求解这段代码怎么貌似失效了似的！

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Dim n As Long, i As Long
n = Web1.Document.getElementsByTagName("A").Count '页面上总共几个链接
For i = 0 To (n - 1)
List1.AddItem Web1.Document.getElementsByTagName( "A" )(i).innerText & "---" & Web1.Document.getElementsByTagName("A")(i).href '取它的文字和URL并放入list1列表
Next
End Sub

'求解这段代码怎么貌似失效了似的！

#9

风吹过b2015-08-17 09:56

Web1.Navigate "https://www.baidu.com/s?wd=动态混胶机"
这里的对象是： web1

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
这里的对象是 WebBrowser1 ，自然无效。

前后要统一，开始写了代码，就轻易不要去修改控件的名字。

#10

风吹过b2015-08-17 10:31

程序代码：

Option Explicit

Private Sub Command1_Click()
WebBrowser1.Navigate "https://www.baidu.com/s?wd=深圳混胶机"

End Sub
Private Sub List1_Click()
Text1.Text = List1
Text2.Text = List1.ListIndex                      'list1选中行行数

End Sub
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, url As Variant)
List1.Clear
Dim Document As Object
Dim i As Long, s1 As String, s2 As String
Dim s3 As String, s4 As String

For i = 0 To WebBrowser1.Document.links.length - 1
    s1 = WebBrowser1.Document.links(i).href
    s2 = WebBrowser1.Document.links(i).innertext
    If Len(s2) > 1 Then                         '没取到标题就不添加
        If s2 = "百度快照" Then                 '如果取到的标题是百度快照
            List1.AddItem s4 & " : " & s3       '把缓存加进列表
        End If
        s3 = s1                                 '缓存
        s4 = s2
    End If
Next i

End Sub

加了过滤在里面，但百度地址还没转换，还在想转换的事情，
使用 winhttp 对象时，会自动重定位，需要更换方式。

#11

a2513572015-08-17 13:38

回复 10楼风吹过b

完美过关...昨天我也想到了用if来判断"百度快照"进行过滤
可是我过滤的效果比较差我是直接采取百度快照的直接链接
您这个已经完全达到了我想要的结果！
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
List1.Clear
List2.Clear
Dim Document, i, s1, s2
For i = 0 To WebBrowser1.Document.links.length - 1
s1 = WebBrowser1.Document.links(i).href
s2 = WebBrowser1.Document.links(i).innertext
    If InStr(1, s2, "百度快照") > 0 Then
    If s2 = "" Then
    Else
    List2.AddItem s1
    End If
    Else
    End If
List1.AddItem s2 & " : " & s1
Next
End Sub

值得学习,,,,谢谢了！