网页抓取分享

VBA万岁

onlycxb 发表于 2014-10-15 23:12
复楼上，我是通过计算记录总数/每页20条记录得到总记录（代码中已经标注）。 网页数据地址为http://jiaoy ...

第28、40~42行的引号内的数据是怎么来的？onlycxb大侠有抓包方面的介绍比较详尽的学习帖推荐吗？

onlycxb

VBA万岁 发表于 2014-10-16 16:07
第28、40~42行的引号内的数据是怎么来的？onlycxb大侠有抓包方面的介绍比较详尽的学习帖推荐吗？

利用fiddler，主要是通过页网刷新、跳转，并在这过程中观察主要能数变化和关联，查找包含输出数据的方式进行查找。只要勤加练习，即可找到。

VBA万岁

onlycxb 发表于 2014-10-16 16:21
利用fiddler，主要是通过页网刷新、跳转，并在这过程中观察主要能数变化和关联，查找包含输出数据的方式进 ...

多谢指点——下载安装Fiddler2学习看看。

onlycxb

分享7：
问题来源 http://club.excelhome.net/forum. ... &extra=page%3D1
特点：网页防盗，数据读取有权限

1. Sub t()
   
2.     Dim objWinHttp, Url$, Str$, m%, n%, i%, j%
   
3.     Dim arr
   
4.     Url = "http://www.gzgczj.com:8080/costRegulatory/project.do"
   
5.     Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
   
6.     With objWinHttp
   
7.         '第一次post
   
8.         .Open "POST", Url, False
   
9.         .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
   
10.         .setRequestHeader "Cookie", "JSESSIONID=2DC7701F8631495E370469482999EFE6"
    
11.         .setRequestHeader "Referer", "http://www.gzgczj.com:8080/costRegulatory/user.do?method=changeIndex&fareaId=1"
    
12.         .send "method=showProjectList&frecordProstatus=1010&isVisitor=1&fprojAreaId=-1&fprojName=&page.pageNO=1"
    
13.         m = Split(Split(.responseText, "共")(1), "页")(0)     '得到总页数
    
14.         '以取2页为例
    
15.         For i = 1 To 2                                      'm
    
16.             .Open "POST", Url, False
    
17.             .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
18.             .setRequestHeader "Cookie", "JSESSIONID=2DC7701F8631495E370469482999EFE6"
    
19.             .setRequestHeader "Referer", "http://www.gzgczj.com:8080/costRegulatory/user.do?method=changeIndex&fareaId=1"
    
20.             .send "method=showProjectList&frecordProstatus=1010&isVisitor=1&fprojAreaId=-1&fprojName=&page.pageNO=" & i
    
21.             Str = VBA.Replace(.responseText, vbCrLf, "")
    
22.             arr = Split(Str, "<TD class=""c_td"" width=""65%"">")
    
23.             Cells.ClearComments                             '清除工作表内原数据
    
24.             For j = 1 To UBound(arr)
    
25.                 n = n + 1
    
26.                 Cells(n, 1) = n
    
27.                 Cells(n, 2) = Split(arr(j), "</TD>")(0)     '工程名称
    
28.                 '其他数据省略
    
29.             Next j
    
30.         Next
    
31.     End With
    
32. End Sub
    

复制代码

浮华、缠绕指尖

肥冬瓜，不错呢。好熟悉的代码。。好熟悉的风格。。加油。

onlycxb

浮华、缠绕指尖 发表于 2014-10-19 22:56
肥冬瓜，不错呢。好熟悉的代码。。好熟悉的风格。。加油。

Super,只点到为止。能够得到数据即可。

ak47ok

每次回帖、谢谢！辛苦了。

VBA万岁

onlycxb 发表于 2014-10-15 23:12
复楼上，我是通过计算记录总数/每页20条记录得到总记录（代码中已经标注）。 网页数据地址为http://jiaoy ...

尝试用另外一种方法提取，代码如下：
Sub 新浪模拟交易2()
On Error Resume Next

Dim xml As New MSXML2.XMLHTTP, Js
Dim Url$, st$, n%, i%, r%, j%, Total%, m%, k%
Dim Sid As String
   
ActiveSheet.UsedRange.Offset(1, 0).Clear
For p = 1 To 2
    Url = "http://jiaoyi.sina.com.cn/api/jsonp.php/Johansen=johansen062308384298872741413371443299/Ranking_Service.getRate?cid=10000&num=20&start=" & (p - 1) * 20 & "&orderby=profit_ratio&ordertype=desc&qjson="
    With xml
        .Open "GET", Url, False
        .send
        st = .responseText
    End With
   
    For i = 1 To 20
        Cells((p - 1) * 20 + i + 1, 1) = Split(Split(st, "rank_day:")(i), ",mark:")(0)
        Cells((p - 1) * 20 + i + 1, 2) = Split(Split(st, "name:")(i), ",rank_day")(0): Cells((p - 1) * 20 + i + 1, 2) = Mid((p - 1) * 20 + Cells(i + 1, 2), 2, Len(Cells((p - 1) * 20 + i + 1, 2)) - 2)
        Cells((p - 1) * 20 + i + 1, 3) = Split(Split(st, "profit_ratio:")(i), ",profit_ratio_day")(0): Cells((p - 1) * 20 + i + 1, 3) = Mid(Cells((p - 1) * 20 + i + 1, 3), 2, Len(Cells((p - 1) * 20 + i + 1, 3)) - 2)
        Cells((p - 1) * 20 + i + 1, 4) = Split(Split(st, "profit_ratio_day:")(i), ",profit_ratio_week")(0): Cells((p - 1) * 20 + i + 1, 4) = Mid(Cells((p - 1) * 20 + i + 1, 4), 2, Len(Cells((p - 1) * 20 + i + 1, 4)) - 2)
        Cells((p - 1) * 20 + i + 1, 5) = Split(Split(st, "profit_ratio_week:")(i), ",success_ratio")(0): Cells((p - 1) * 20 + i + 1, 5) = Mid(Cells((p - 1) * 20 + i + 1, 5), 2, Len(Cells((p - 1) * 20 + i + 1, 5)) - 2)
        Cells((p - 1) * 20 + i + 1, 6) = Split(Split(st, "success_ratio:")(i), ",retrace_rate")(0): Cells((p - 1) * 20 + i + 1, 6) = Mid(Cells((p - 1) * 20 + i + 1, 6), 2, Len(Cells((p - 1) * 20 + i + 1, 6)) - 2)
        Cells((p - 1) * 20 + i + 1, 7) = Split(Split(st, "retrace_rate:")(i), ",frequency")(0): Cells((p - 1) * 20 + i + 1, 7) = Mid(Cells((p - 1) * 20 + i + 1, 7), 2, Len(Cells((p - 1) * 20 + i + 1, 7)) - 2)
        Cells((p - 1) * 20 + i + 1, 8) = Split(Split(st, "frequency:")(i), ",holdstock:[")(0): Cells((p - 1) * 20 + i + 1, 8) = Mid(Cells((p - 1) * 20 + i + 1, 8), 2, Len(Cells((p - 1) * 20 + i + 1, 8)) - 2)
        Cells((p - 1) * 20 + i + 1, 9) = Split(Split(st, "holdstock:[")(i), ",")(0): Cells((p - 1) * 20 + i + 1, 9) = Mid(Cells((p - 1) * 20 + i + 1, 9), 2, Len(Cells((p - 1) * 20 + i + 1, 9)) - 2)
        Cells((p - 1) * 20 + i + 1, 10) = Split(Split(st, "profit_count:")(i), ",loss_count")(0): Cells((p - 1) * 20 + i + 1, 10) = Mid(Cells((p - 1) * 20 + i + 1, 10), 2, Len(Cells((p - 1) * 20 + i + 1, 10)) - 2)
    Next i
Next p
End Sub

onlycxb

VBA万岁 发表于 2014-10-20 12:44
尝试用另外一种方法提取，代码如下：
Sub 新浪模拟交易2()
On Error Resume Next

总页码我怎么没看到？

VBA万岁

VBA万岁 发表于 2014-10-20 12:44
尝试用另外一种方法提取，代码如下：
Sub 新浪模拟交易2()
On Error Resume Next

附件如下：
新浪模拟交易排行榜.zip (22.58 KB, 下载次数: 38)

2014-10-20 12:49 上传

点击文件名下载附件