ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: wcymiss

[原创] 不懂html也来学网抓(xmlhttp/winhttp+fiddler)

    [复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-10-22 12:30 | 显示全部楼层
本帖已被收录到知识树中,索引项:网页交互
本帖最后由 wcymiss 于 2014-10-22 13:54 编辑

新手作业:

网站:http://weibo.com/guide/welcome
操作:登录微博,点击“好友圈”,获取好友最近微博内容。
说明:用46楼的方法编写代码。不必理会Cookie的生存期。我们只是为了学习模拟Cookie。在Responsetext能得到微博内容即可。不需处理内容。

TA的精华主题

TA的得分主题

发表于 2014-10-22 12:32 | 显示全部楼层
onlycxb 发表于 2014-10-21 17:04

接续onlycxb大侠的代码,完成另一半:
Sub HomerWork1_1()
Dim xml As New MSXML2.XMLHTTP, url As String, St As String, p%
Dim arr, brr, ar, i, c
For p = 1 To 7
url = "http://data.bank.hexun.com/lccp/Jrxp.aspx?col=1&tag=desc&date=" & Date & "&page=" & p
    With xml
        .Open "GET", url, False
        .send
        St = .responseText
    End With
    St = Split(Split(St, "<div class=""mark"">")(1), "</div>")(0)
    arr = Split(St, "<tr align='center'>")
    ReDim brr(1 To UBound(arr), 1 To 9)
    For i = 1 To UBound(arr)
        ar = arr(i)
        brr(i, 1) = Split(Split(ar, "value='")(1), "'")(0) + Split(Split(ar, "<font class='cred'>")(1), "</font>")(0)
        brr(i, 2) = Split(Split(ar, "</font></td><td class='hl'>")(1), "</td>")(0)
        brr(i, 3) = Split(Split(ar, "<td  class='on'>")(1), "</td>")(0)
        brr(i, 4) = Split(Split(ar, "<td  class='hl'>")(1), "</td>")(0)
        brr(i, 5) = Split(Split(ar, "<td  class='hl'>")(2), "</td>")(0)
        brr(i, 6) = Split(Split(ar, "<td  class='hl'>")(3), "</td>")(0)
        brr(i, 7) = Split(Split(ar, "<td  class='hl'>")(4), "</td>")(0)
        brr(i, 8) = Split(Split(ar, "<td  class='hl'>")(5), "</td>")(0)
        brr(i, 9) = Split(Split(Split(ar, "<td  class='hl'>")(5), "</td>")(1), ">")(1)

    Next i
    With ActiveSheet
        .Columns("D:E").NumberFormatLocal = "yyyy-m-d"
        .[a1].Offset((p - 1) * 21).Resize(1, 10) = [{"对比","产品名称","银行","起售日","停售日","币种","管理期(月)","产品类型","预期收益(%)","收益"}]
        .[b2].Offset((p - 1) * 21).Resize(UBound(brr, 1), 9) = brr
    End With
Next p
End Sub

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2014-10-22 12:33 | 显示全部楼层
VBA万岁 发表于 2014-10-22 12:32
接续onlycxb大侠的代码,完成另一半:
Sub HomerWork1_1()
Dim xml As New MSXML2.XMLHTTP, url As Str ...

ie法完成作业1:
Sub 今日在售银行产品()
'On Error Resume Next
Cells.ClearContents
Dim p%, tp As Long, i%, j%, t, r As Object

With CreateObject("internetexplorer.application")
    .Visible = True
    .Navigate "http://data.bank.hexun.com/lccp/jrxp.aspx"
    Do Until .readyState = 4
        DoEvents
    Loop
   
    For p = 1 To 7
        t = Timer
        Do While t + 5 > Timer
            DoEvents
        Loop
        
        Set r = .Document.all.tags("table")(2).Rows
        For i = 0 To r.Length - 1
            For j = 0 To r(i).Cells.Length - 1
                Cells((p - 1) * 21 + i + 1, j + 1) = r(i).Cells(j).innerText
            Next j
        Next i
   
        .Document.all.tags("a")(181).Click
    Next p
End With
End Sub

TA的精华主题

TA的得分主题

发表于 2014-10-22 12:34 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 VBA万岁 于 2014-10-22 12:40 编辑
VBA万岁 发表于 2014-10-22 12:33
ie法完成作业1:
Sub 今日在售银行产品()
'On Error Resume Next


附件如下地:
今日在售银行产品.zip (663.39 KB, 下载次数: 515)

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2014-10-22 12:51 | 显示全部楼层
suwenkai 发表于 2014-10-21 22:18
第一题

suwenkai大师的代码可作为23及52楼、53代码的改善版。

TA的精华主题

TA的得分主题

发表于 2014-10-22 14:01 | 显示全部楼层
好,太需要这样图文并茂的教程了,感谢wcymiss强大的技术和博大的胸怀

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-10-22 15:30 | 显示全部楼层
获取数据-防盗链的处理-模拟User-Agent

很少遇到需要模拟User-Agent的网页。

服务器可以根据发送头里的User-Agent辨别你是用手机还是电脑,是用IE浏览器还是用火狐浏览器。

举例:
EH查看他人的帖子(主题或回复)有些限制,需要登录才能查看所有会员的主题或回复。
但这种限制仅仅是在电脑上,手机不在此例。
因此,可以模拟User-Agent,伪装成在手机上浏览EH网站,查看他人帖子。

我们在电脑上也可以利用fiddler伪装成手机哦!
步骤:
1、打开Fiddler,勾选“Rules”-“User-Agents”-“WinPhone7”
ugent.png

2、打开浏览器,打开EH论坛,点击任一用户名,点击“回帖数”。
ugent2.png

ugent3.png


3、在Fiddler里查找数据网页,复制User-Agent后的字符串,写入代码。
ugent4.png

代码如下:


  1. Sub Main()
  2.     Dim strText As String
  3.     With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")
  4.         .Open "GET", "http://club.excelhome.net/home.php?mod=space&uid=218917&do=thread&view=me&type=reply&from=space&mobile=yes", False
  5.         .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible: MSIE 7.0; Windows Phone OS 7.0; Trident/3.1; IEMobile/7.0; SAMSUNG; SGH-i917)"
  6.         .Send
  7.         strText = .responsetext
  8.         Debug.Print strText
  9.     End With
  10. End Sub
复制代码

评分

2

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-10-22 15:45 | 显示全部楼层
获取数据-防盗链的处理-其他发包头的模拟

其他发包头的模拟也比较少见。

我的一位朋友Super(EH会员名:浮华、缠绕指尖)提供了一个需要模拟“x-requested-with”的网页:http://statementdog.com/analysis/tpe/8114#8114。大家可以自己抓包试试看。

如果你有需要模拟其他发包头的网页,请发消息给我,我会补充在这层楼里。谢谢。

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-10-22 16:45 | 显示全部楼层
本帖最后由 wcymiss 于 2014-10-28 16:12 编辑

获取数据-防盗链的处理-动态参数

相同方式操作网页,抓包能得到相同的参数值,这样的参数是静态的。反之就是动态参数。

举例:(14楼作业2)
网站:http://www.caac.gov.cn/S1/GNCX/
操作:点击“查询”,获取航班信息数据。

数据网页的参数列表:
动态参数1.png

sn这个参数的值是一堆数字字母混合物,像这样的参数,一般都是作为服务器辨识身份的标识。

搜索该值,查找最早出现该值的网页,先发送该网页的请求,获取sn值,然后写入目标数据网页的参数里。

最终代码如下:
  1. Sub Main()
  2.     Dim strText As String
  3.     Dim strHost As String
  4.     Dim strURL As String
  5.     strHost = "http://webflight.linkosky.com"
  6.     With CreateObject("WinHttp.WinHttpRequest.5.1")
  7.         
  8.         .Open "GET", strHost & "/WEB/Flight/WaitingSearch.aspx?JT=1&OC=PEK&DC=SHA&dstDesp=GUANGZHOU%B9%E3%D6%DD&dst2=CAN&DD=2014-10-22&DT=7&BD=&BT=7&AL=ALL&DR=true&image.x=37&image.y=14", False
  9.         .setRequestHeader "Referer", "http://www.caac.gov.cn/S1/GNCX/"
  10.         .Send
  11.         strText = .responsetext
  12.         strURL = Split(Split(strText, "setTimeout(""window.location.replace('")(1), "'")(0)
  13.         
  14.         .Open "GET", strHost & strURL, False
  15.         .Send
  16.         strText = .responsetext
  17.         Debug.Print strText
  18.         
  19.     End With
  20. End Sub
复制代码
这样获取动态参数的方式,与34楼的Cookie的模拟是不是有点类似?

注:这个sn值是由查询的各种条件如日期、机场等由服务器综合计算得来的。在不知道它的算法的情况下,需要先获取先前页面获得sn值后再进行查询。

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-10-22 16:56 | 显示全部楼层
本帖最后由 wcymiss 于 2014-10-24 16:18 编辑

再上一个动态参数的例子:

网站:http://www.abchina.com/cn/Public ... t20101217_45743.htm
操作:币种选择“日元(JPY)”,日期选择从2014年10月1日到今天,点击查询,然后查看第6页的数据。

抓包分析步骤:
1、操作网页并抓包,复制数据。
复制数字不要包括末尾的0。因为这些0有可能是某种格式的效果,并非是数据的一部分。把0一起复制进去有可能搜索不到网页。

动态1.png

2、搜索该数字,确认数据网页

动态2.png

3、查看Request框中Raw的内容,SendData里有参数,并且有被编码的字符:
不能用被编码的字符进行搜索。

动态3.png

Request框中WebForms里可以看到参数的字符原型:
代表页码的参数是“__EVENTARGUMENT”。

动态4.png

4、参数太长了,fiddler的搜索框里放不下,只能截取部分字符进行搜索:
搜索到后不要忘了对整段字符串进行校对。

动态5.png

5、第2步骤里确认的数据网页的动态参数的来源已确认,但此网页本身也有动态参数:

动态6.png

6、搜索第二个动态参数。

7、找到最初源头了。这个网页没有参数了。好了,代码就从这里开始吧!

动态7.png

成型代码:
  1. Sub Main()
  2.     Dim strUrl As String
  3.     Dim strText As String
  4.     Dim VIEWSTATE As String
  5.     Dim EVENTVALIDATION As String
  6.     Dim strDdr1 As String
  7.     Dim strDatepicker1 As String
  8.     Dim strDatepicker2 As String
  9.     Dim intPageNum As Integer
  10.    
  11.     strUrl = "http://app.abchina.com/rateinfo/RateHistorySearch.aspx"
  12.     strDdr1 = "日元(JPY)" '币种
  13.     strDatepicker1 = "2014-10-01"
  14.     strDatepicker2 = "2014-10-22"
  15.     intPageNum = 6 '页码
  16.    
  17.     With CreateObject("MSXML2.XMLHTTP")
  18.         '第一次GET,获取VIEWSTATE和EVENTVALIDATION
  19.         .Open "GET", strUrl, False
  20.         .send
  21.         strText = .responsetext
  22.         VIEWSTATE = encodeURI(CStr(Split(Split(strText, "__VIEWSTATE"" value=""")(1), """ />")(0)))
  23.         EVENTVALIDATION = encodeURI(CStr(Split(Split(strText, "__EVENTVALIDATION"" value=""")(1), """ />")(0)))
  24.         
  25.         '第二次POST,获取指定日期的VIEWSTATE和EVENTVALIDATION
  26.         .Open "POST", strUrl, False
  27.         .setrequestheader "Content-Type", "application/x-www-form-urlencoded"
  28.         .send "__VIEWSTATE=" & VIEWSTATE _
  29.             & "&__EVENTVALIDATION=" & EVENTVALIDATION _
  30.             & "&ddr1=" & encodeURI(strDdr1) _
  31.             & "&datepicker1=" & strDatepicker1 _
  32.             & "&datepicker2=" & strDatepicker2 _
  33.             & "&btnSearch=" & encodeURI("搜索")
  34.         strText = .responsetext
  35.         VIEWSTATE = encodeURI(CStr(Split(Split(strText, "__VIEWSTATE"" value=""")(1), """ />")(0)))
  36.         EVENTVALIDATION = encodeURI(CStr(Split(Split(strText, "__EVENTVALIDATION"" value=""")(1), """ />")(0)))
  37.         
  38.         '第三次POST,翻页
  39.         .Open "POST", strUrl, False
  40.         .setrequestheader "Content-Type", "application/x-www-form-urlencoded"
  41.         .send "__VIEWSTATE=" & VIEWSTATE _
  42.             & "&__EVENTTARGET=PagerControl1" _
  43.             & "&__EVENTARGUMENT=" & intPageNum _
  44.             & "&__EVENTVALIDATION=" & EVENTVALIDATION _
  45.             & "&ddr1=" & encodeURI(strDdr1) _
  46.             & "&datepicker1=" & strDatepicker1 _
  47.             & "&datepicker2=" & strDatepicker2 _
  48.             & "&PagerControl1_input=1"
  49.         strText = .responsetext
  50.         Debug.Print strText
  51.     End With
  52. End Sub
复制代码
  1. Function encodeURI(strTobecoded As String) As String
  2.     With CreateObject("msscriptcontrol.scriptcontrol")
  3.         .Language = "JavaScript"
  4.         encodeURI = .Eval("encodeURIComponent('" & strTobecoded & "');")
  5.         'encodeURIComponent无法转换括号,所以再替换下括号
  6.         encodeURI = Replace(Replace(encodeURI, "(", "%28"), ")", "%29")
  7.     End With
  8. End Function
复制代码
小贴士:aspx网页的数据查询大多有类似VIEWSTATE的参数,这个参数特点是:文本超长,且一层层传递。每层的VIEWSTATE值还会有一部分内容是相同的。所以搜索到参数值后一定要校对整个字符串是否完全一致。

评分

5

查看全部评分

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-13 14:35 , Processed in 0.043851 second(s), 7 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表