ExcelHome技术论坛

标题: 不懂html也来学网抓(xmlhttp/winhttp+fiddler) [打印本页]

作者: wcymiss    时间: 2014-10-21 11:12
标题: 不懂html也来学网抓(xmlhttp/winhttp+fiddler)
本帖最后由 wcymiss 于 2014-11-1 09:24 编辑

本帖主要针对的是不懂html的网抓新手,所以,本帖基本不谈原理,只说实战

学网抓对vba的要求:
1、了解对象及对象属性方法的基本概念;
2、熟练使用循环、判断及vba数组;
3、掌握一种以上提取文本的方法,可以在各种有规律的文本里提取所需数据;
4、会调试代码,会用立即窗口、本地窗口。(很重要,请务必学会)
5、有录制宏的经验。

可以这样说,只要你具备上述vba知识,再对网抓有点兴趣,有点耐心,那你就能学会网抓。

我本人开始用xmlhttp和fiddler的时候,对html和javascript是一窍不通的,对get、post也不懂,全是依样画葫芦。画成功后,有了兴趣,才慢慢去寻找它的原理和相关知识去学习。我想我这样的学习方法或许可以给一些像我一样的小白一个借鉴。但愿没有误导新人才好。

学习html强力推荐此网站:http://www.w3school.com.cn/ ,绝对权威

==================================================
如果发觉楼主有写错的地方,或是用错术语,或是概念模糊,或是运行出错、运行效果与楼主不同,或是有看不懂、不理解的地方,请大家及时提出来。
希望在大家的帮助和建议下完善本帖,让不会网抓的朋友由此贴学会写一些基础的网抓代码,同时感受到网抓的乐趣。

谢谢大家!



补充内容 (2014-11-5 19:37):
交流QQ群:310731499
作者: wcymiss    时间: 2014-10-21 11:15
本帖最后由 wcymiss 于 2014-11-3 11:22 编辑

目录:

一、前期准备:
  1、fiddler的安装、设置、使用;
        Fiddler抓包并确认数据页面一例
  2、常用代码和自定义函数。

二、获取数据:
  1、直接获取:
    a、GET;
         作业一
    b、POST;
        作业二
    c、静态参数;
    d、转码
  2、防盗链的处理:
    a、模拟Referer;
    b、模拟Cookie;
        继续唠叨Cookie--例子暂缺
        还是Cookie-----模拟Cookie欺骗服务器一例
        作业三
    c、模拟User-Agent ;
    d、其他发包头的模拟;
    e、动态参数
      动态参数又一例
      抓取QQ群成员清单
      用IE获取Cookie

对获取数据作个小结

  3、其他
    a、缓存的困扰;
    b、重定向;
    c、代理

三、提取数据:
  1、下载文件;
  2、转码;
  3、处理数据的通用方法
  4、处理table
  5、处理xml
  6、处理JSON
    a、初识JSON
    b、JSON转换成vba对象
    c、编写JavaScript代码处理JSON(一)
    d、编写JavaScript代码处理JSON(二)
    作业四

四、发送数据
  1、登录;
    a、初识登录(以登录163邮箱为例)
    b、登录之后可以做什么----查询数据
    c、登录之后可以做什么----发送数据
    d、复杂登录前言
    e、复杂登录一:搜房网登录
    f、复杂登录二:58同城登录

  2、上传文件


作者: wcymiss    时间: 2014-10-21 11:25
本帖最后由 wcymiss 于 2014-10-31 10:36 编辑

vba网抓常用方法:

1、xmlhttp/winhttp法:
用xmlhttp/winhttp模拟向服务器发送请求,接收服务器返回的数据。
优点:效率高,基本无兼容性问题。
缺点:需要借助如fiddler的工具来模拟http请求。

2、IE/webbrowser法:
创建IE控件或webbrowser控件,结合htmlfile对象的方法和属性,模拟浏览器操作,获取浏览器页面的数据。
优点:这个方法可以模拟大部分的浏览器操作。所见即所得,浏览器能看到的数据就能用代码获取。
缺点:各种弹窗相当烦人,兼容性也确实是个很伤脑筋的问题。上传文件在IE里根本无法实现。(有实现方法?请一定告诉我)

3、QueryTables法:
因为它是excel自带,所以勉强也算是一种方法。其实此法和xmlhttp类似,也是GET或POST方式发送请求,然后得到服务器的response返回到单元格内。
优点:excel自带,可以通过录制宏得到代码,处理table很方便。代码简短,适合快速获取一些存在于源代码的table里的数据。
缺点:无法模拟referer等发包头(如果你有在QT中模拟referer的方法,请一定告诉我)

本帖主要讲述的是第一种方法。


作者: wcymiss    时间: 2014-10-21 11:33
个人偏爱fiddler的原因:(唠叨话,可略过)

1、fiddler不需要寄生在浏览器中,且可抓到多个浏览器的包。
2、除了抓浏览器,一些联网的软件的请求数据过程也能抓到。如QQ。(据说网游也可以,不过我没试过)
3、fiddler还能记录vba代码运行时的数据请求过程。
4、界面清晰,查找数据方便。更有json、xml、javascript各种数据格式化的插件。
5、还可以手工在fiddler里模拟发包,获取数据,方便测试。

作者: ghostjiao    时间: 2014-10-21 11:40
哇哇哇,吴女神,女神出现了,赶紧收藏了
作者: wcymiss    时间: 2014-10-21 11:45
fiddler的安装、设置、使用
安装:
下载链接:http://w.x.baidu.com/alading/anquan_soft_down_normal/10963安装了.Net Framework后才能安装fiddler。如果系统没有安装.Net Framework,在fiddler的安装中会提示下载安装。

设置:
1、菜单栏:Rules,勾选“Remove all Encodings”(解密所有加密数据)(很重要,否则之后会出现查找不到特征数据的情形)
2、菜单栏:Rule,勾选"Hide Image Requests"(隐藏图片包)、"Hide CONNECTs"(隐藏CONNECTs包)
(, 下载次数: 1494)

3、菜单栏:Tools-Fidder Options-HTTPS,勾选"Capure HTTPS CONNECTs"、"Decrypt HTTPS traffic"、"Ignore server certificate
errors"。(获取https包并忽略信任错误)
(, 下载次数: 1446)


使用:
fiddler抓包有点类似excel里的录制宏。

抓包步骤如下:
1、为确保fiddler抓到完整的数据包,抓包前请手动清除浏览器cookie、缓存及历史记录。
不要用fiddler上的按钮“Clear Cache ” ,这个按钮只能清除IE浏览器的缓存。
2、打开fiddler,然后打开浏览器,输入网址,在网页里做所需操作。操作完毕后,进入fiddler,fiddler的左半边框框内的数据就是抓到的包。为了fiddler不受之后网页操作的影响,可以点击左下方的"Capturing"按钮停止fiddler抓包。

fiddler抓包界面简单解析:
1、左边的是session框,选择该框任意一条数据,右边菜单选择“Inspectors”后出现上下两个框:上边是Request,包含所有的发送请求;下方是Response,包含所有服务器响应请求后返回的内容。
(, 下载次数: 1378)

2、查找数据:
抓到包后,session框里的数据太多,如何找到我们需要的呢?
a、在fiddler里按ctrl+F,搜索所需某个比较有特征的数据,搜到后点击该session,Request框和Response框都选择“Raw”菜单。
搜索框内可以选择搜索范围。
(, 下载次数: 1403)

b、在Response框下方的空白长条框里,输入之前搜索的那个特征数据,按回车,确认其是否存在于该Response内,如果存在,再查看上下文,确认是否是所需的数据页面。
这步很重要,如果数据页面确认错了,接下来就都是做无用功了。

3、数据页面确认后,我们写代码要模拟的就是Request框中的数据。

小贴士:
特征字符尽量不要选择中文,中文可能会有转码;也尽量不要选择带格式的文本。带格式的文本通常含有html代码。这些都有可能出现搜索不到数据的情形。




补充内容 (2015-1-9 12:58):
下载链接错了,那个是下载的更新。官网下载链接是这个:http://www.telerik.com/download/fiddler/fiddler4。你也可以百度搜索下载。
作者: blanksoul12    时间: 2014-10-21 11:49
留個位置,希望講解一下 FIDDER 用法及怎分析.
作者: wcymiss    时间: 2014-10-21 12:47
本帖最后由 wcymiss 于 2014-10-21 12:54 编辑

Fiddler抓包并确认数据页面一例:

网站:http://www.cffex.com.cn/fzjy/tjsj/pztj/
操作:点击“品种日数据统计”,在日期起始框内选择2014-10-01,在日期截止框内输入今天日期,点击“查询”,随后出现的表格为所需数据。
(, 下载次数: 1584)

Fiddler操作:
1、清除浏览器cookie、缓存、历史记录。
2、打开fiddler,打开浏览器,输入网址进行操作。
3、选择数据中某一段数字作为特征字符串在fiddler里进行查找。
(, 下载次数: 1563)

(, 下载次数: 1508)

4、找到后确认是否是所需数据页面。
(, 下载次数: 1483)


IF  搜索成功 Then
     继续往下看。。。
Else
     重新按照上述步骤抓包
End IF


作者: wcymiss    时间: 2014-10-21 12:51
更多Fiddler的使用方法,敬请参考《Fiddler调试权威指南》一书。
电子书下载地址:http://pan.baidu.com/s/1CRctw

我昨天才发现有这本书,赶紧收藏,还没来得及看
作者: riling102    时间: 2014-10-21 12:52
好的东西必须收藏标记!
作者: wcymiss    时间: 2014-10-21 13:19
本帖最后由 wcymiss 于 2014-11-1 16:44 编辑

常用代码及自定义函数:

1、网抓主体代码:
  1. Sub Main()
  2.     Dim strText As String
  3.     With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")'
  4.         .Open "POST", "", False
  5.         .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  6.         .setRequestHeader "Referer", ""
  7.         .Send
  8.         strText = .responsetext
  9.         Debug.Print strText
  10.     End With
  11. End Sub
复制代码
代码里的很多""就是留给你的填空题。。。
xmlhttp/winhttp对象的属性和方法可以网上百度学习(不学也暂时影响不大),内容不多。

2、Javascript表达式求值:
  1. Function JSEval(strText  As String) As String
  2.     With CreateObject("MSScriptControl.ScriptControl")
  3.         .Language = "javascript"
  4.         JSEval = .Eval(strText)
  5.     End With
  6. End Function
复制代码
3、url转码:
  1. Function encodeURI(strText As String) As String
  2.     With CreateObject("msscriptcontrol.scriptcontrol")
  3.         .Language = "JavaScript"
  4.         encodeURI = .Eval("encodeURIComponent('" & strText & "');")
  5.     End With
  6. End Function
复制代码
javascript提供了六个转码函数:
escape,unescape,encodeURI,encodeURIComponent,decodeURI,decodeURIComponent
具体用法请百度。我只能说我最常用的是encodeURIComponent。

4、流数据转成指定编码的文本:
  1. Function ByteToStr(arrByte, strCharset As String) As String
  2.     With CreateObject("Adodb.Stream")
  3.         .Type = 1 'adTypeBinary
  4.         .Open
  5.         .Write arrByte
  6.         .Position = 0
  7.         .Type = 2 'adTypeText
  8.         .Charset = strCharset
  9.         ByteToStr = .Readtext
  10.         .Close
  11.     End With
  12. End Function
复制代码
5、文本按指定编码转为流数据:
  1. Function StrToByte(strText As String, strCharset As String)
  2.     With CreateObject("adodb.stream")
  3.         .Mode = 3 'adModeReadWrite
  4.         .Type = 2 'adTypeText
  5.         .Charset = strCharset
  6.         .Open
  7.         .Writetext strText
  8.         .Position = 0
  9.         .Type = 1 'adTypeBinary
  10.         '.Position = 2 '保留BOM头则不需此行代码,去除三个字节的BOM头就填入3,去除两个字节的就填入2
  11.         StrToByte = .Read
  12.         .Close
  13.     End With
  14. End Function
复制代码
注:某些文本转为流后,前面会添加几个字节的BOM头,用来被某些软件识别是什么编码。如UTF-8编码的前面有三个字节的BOM头,Unicode前面有两个字节的BOM头。大家可以视情况选择保留或去除这些BOM头。
6、二进制流转成文件:
  1. Sub ByteToFile(arrByte, strFileName As String)
  2.     With CreateObject("Adodb.Stream")
  3.         .Type = 1 'adTypeBinary
  4.         .Open
  5.         .Write arrByte
  6.         .SaveToFile strFileName, 2 'adSaveCreateOverWrite
  7.         .Close
  8.     End With
  9. End Sub
复制代码
7、文本拷贝到剪贴板:
  1. Sub CopyToClipbox(strText As String)
  2.     '文本拷贝到剪贴板
  3.     With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
  4.         .SetText strText
  5.         .PutInClipboard
  6.     End With
  7. End Sub
复制代码
先上这些,以后觉得有必要再添加

呃,原谅我吧,我是个怀旧的人。我的机器的配置目前为止仍旧是32位的winXP+2003office,IE也刚升级到IE8,之前一直用的IE6。弦月大师(xmyjk)所点评的内容我没有办法提供呀。。甩泪。。。

=================================================
突然想起HtmlWindow也可以直接执行Javascript函数得出值。
用64位office的朋友可以测试一下下面的代码能不能通过:
替代上面自定义函数2的:
  1. Function EvalByHtml(strText As String) As String
  2.     With CreateObject("htmlfile")
  3.         .write "<html><script></script></html>"
  4.         EvalByHtml = CallByName(.parentwindow, "eval", VbMethod, strText)
  5.     End With
  6. End Function
复制代码
替代上面自定义函数3的:
  1. Function encodeURIByHtml(strText As String) As String
  2.     With CreateObject("htmlfile")
  3.         .write "<html><script></script></html>"
  4.         encodeURIByHtml = CallByName(.parentwindow, "encodeURIComponent", VbMethod, strText)
  5.     End With
  6. End Function
复制代码
给Dom添加一个空的script就可以直接执行js函数了,非常好用。

为防止vba自动篡改大小写,把js函数名作为文本放在callbyname的参数里。
作者: 无姓人    时间: 2014-10-21 13:55
感谢分享!!努力学习!!!!!!!
作者: wcymiss    时间: 2014-10-21 14:00
本帖最后由 wcymiss 于 2014-10-21 21:37 编辑

获取数据-直接获取-GET

再复制一次主体代码:

  1. Sub Main()
  2.     Dim strText As String
  3.     With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")
  4.         .Open "POST", "", False
  5.         .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  6.         .setRequestHeader "Referer", ""
  7.         .Send
  8.         strText = .responsetext
  9.         Debug.Print strText
  10.     End With
  11. End Sub
复制代码
xmlhttp/winhttp对象的Open方法的第一参数主要有两个值:GET 和 POST。(必须大写

如何知道应该用GET还是POST呢?很简单,看之前用fiddler的数据网页的Request框Raw里的内容(仍然用8楼的例子):
(, 下载次数: 215)
Raw里是“GET”,所以我们代码也用“GET”,Open方法的第二参数写入GET后面的Url
后面的setRequestHeader语句暂且注释掉。
这样代码就写好了:
  1. Sub Main()
  2.     Dim strText As String
  3.     With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")
  4.         .Open "GET", "http://www.cffex.com.cn/fzjy/tjsj/pztj/pzrtj/2014/index.xml", False
  5. '        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  6. '        .setRequestHeader "Referer", ""
  7.         .Send
  8.         strText = .responsetext
  9.         Debug.Print strText
  10.     End With
  11. End Sub
复制代码
运行下,查看立即窗口的结果:
(, 下载次数: 247)


数据成功获取。

本例是最直接的GET,不需添加setRequestHeader。

小贴士:
复制Request框内的Url时,为避免打开该链接,可以点击Request框右下角的“View in Notepad”按钮,从记事本内复制。

又:ResponseText在vba的立即窗口显示不全的原因是立即窗口只能容纳有限长度的文本。文本超长后,只能显示后面一部分的内容。
作者: wcymiss    时间: 2014-10-21 14:13
本帖最后由 wcymiss 于 2014-10-22 12:35 编辑

新手作业:
1、网站:http://data.bank.hexun.com/lccp/jrxp.aspx
     操作:点击“今日在售产品”,获取今日在售产品第一页的数据。

2、网站:http://www.caac.gov.cn/S1/GNCX/
     操作:点击“查询”,获取航班信息数据。

作业说明:因为仅仅是练习fiddler的使用以及最基本网抓代码的写法,所以代码只需在ResponseText获取到所需数据就行了。不需要整理,也不必考虑动态参数的问题。


作者: wcymiss    时间: 2014-10-21 14:29
本帖最后由 wcymiss 于 2014-10-21 16:01 编辑

获取数据-直接获取-POST

Open第一参数是“POST"的时候,Send方法一般会有参数。

举例:
网站:http://cn.zso8.com/odds/search/
操作:第一行,“联赛选择”内选择“英超”,然后点击最右边的“确定”,获取该数据。

用fiddler找到数据页面,查看Request框Raw里的内容:
(, 下载次数: 232)


同之前一样,填入“POST”,填入URL。然后,复制“type=2&CompanyID.......”这部分字符串,作为Send的参数。
代码成型:
  1. Sub Main()
  2.     Dim strText As String
  3.     With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")
  4.         .Open "POST", "http://cn.zso8.com/odds/search/", False
  5. '        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  6. '        .setRequestHeader "Referer", ""
  7.         .Send "type=2&CompanyID=11%7C%E6%BE%B3%E9%97%A8&leagueID=36&teamID=0&kind=1&port=&odds1=&do0=%E7%A1%AE%E5%AE%9A"
  8.         strText = .responsetext
  9.         Debug.Print strText
  10.     End With
  11. End Sub
复制代码
运行。。。。然后发现,没有成功!

立即窗口没有数据:
(, 下载次数: 205)

Response框里是有数据的:
(, 下载次数: 219)


为什么没有成功呢?因为没有模拟setRequestHeader!
经验:“POST”时,一般都需要模拟setRequestHeader的“Content-Type”字段(Header)。

再回头,拷贝出Request中的Content-Type后面的值:application/x-www-form-urlencoded,填入代码中。
(, 下载次数: 226)


第二次成型代码:
  1. Sub Main()
  2.     Dim strText As String
  3.     With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")
  4.         .Open "POST", "http://cn.zso8.com/odds/search/", False
  5.         .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  6. '        .setRequestHeader "Referer", ""
  7.         .Send "type=2&CompanyID=11%7C%E6%BE%B3%E9%97%A8&leagueID=36&teamID=0&kind=1&port=&odds1=&do0=%E7%A1%AE%E5%AE%9A"
  8.         strText = .responsetext
  9.         Debug.Print strText
  10.     End With
  11. End Sub
复制代码
运行,查看立即窗口,这次有数据了:
(, 下载次数: 211)


小贴士:
Content-Type后面的值大部分都是application/x-www-form-urlencoded,但也有些网页不是这样的内容。每次代码模拟一定要和Request框内的内容保持一致,不要掉以轻心。


作者: onlycxb    时间: 2014-10-21 15:19
来晚了。先占个听课板凳!
作者: wcymiss    时间: 2014-10-21 15:20
本帖最后由 wcymiss 于 2014-10-22 12:36 编辑

新手作业:
网站:http://www.pinble.com/Lottery.htm
操作:点击“各省体彩”---“江苏七星彩”,获取江苏七星彩的数据。
说明:同样,代码只需在ResponseText获取到所需数据就行了。不需要整理。



这个数据网页的确认稍有点难度,要有耐心。嘿嘿。

作者: f61393569    时间: 2014-10-21 15:22
本帖最后由 f61393569 于 2014-10-21 15:24 编辑

敢问楼主有听过火车头吗? 我经常使用来抓去数据啊,  文章  音频  视频  软件  系统 图片 招聘  新闻  企业信息。。。。。。。。等等等等   需要登录的论坛  网站都可以的

(, 下载次数: 169)

作者: wcymiss    时间: 2014-10-21 15:25
本帖最后由 wcymiss 于 2014-10-22 16:52 编辑

获取数据-直接获取-静态参数:

在Request框内经常能看到各种参数。

参数用于客户端与服务器的交互。
参数的结构形式是:
    参数名1=参数值1&参数名2=参数值2&参数名3=参数值3.....
参数存在于SendData中(即vba代码里Send方法后面的那部分,又称POSTData、SendBody等),也存在于URL中。

在15楼的例子,参数存在于SendData中:
type=2&CompanyID=11%7C%E6%BE%B3%E9%97%A8&leagueID=36&teamID=0&kind=1&port=&odds1=&do0=%E7%A1%AE%E5%AE%9A

14楼的作业,参数存在于URL里。

点击Request框的WebForms按钮可清楚的查看各参数:
上面的“QueryString”框内显示的是URL部分的参数明细;
下面“Body"框内显示的是SendData部分的参数明细。
(, 下载次数: 240)

通过多次对网站不同操作的抓包对比,可分析出每个参数各自对应的页面的选项。据此,在代码里定义多个变量,可动态获取各种不同的查询结果。

没有值的参数,大多时候可以省略。比如:
type=2&CompanyID=11%7C%E6%BE%B3%E9%97%A8&leagueID=36&teamID=0&kind=1&port=&odds1=&do0=%E7%A1%AE%E5%AE%9A
可以省略写成:
type=2&CompanyID=11%7C%E6%BE%B3%E9%97%A8&leagueID=36&teamID=0&kind=1&do0=%E7%A1%AE%E5%AE%9A


上述URL或SendData里的参数都是大部分都是静态的(14楼作业2里有一个参数非静态),也就是说,不管何时何地,只要服务器后台代码不改变,相同的页面选择,参数总也是相同的。

但很多网页都有动态参数。动态参数有防盗链的效果。即使你操作手法完全相同,动态参数也会有不同。这个在之后的知识点里会有具体讲解。

小贴士:查询的数据有多页时,这个页码会以参数的形式体现在发包头内。

作者: wcymiss    时间: 2014-10-21 16:10
本帖最后由 wcymiss 于 2014-10-30 10:11 编辑

获取数据-直接获取-转码:

在15楼的例子中:

从Request框的WebForms中可以看到:
CompanyID参数的值是“11|澳门”
do0参数的值是“确定”

但在Raw里看到的是:
CompanyID=11%7C%E6%BE%B3%E9%97%A8
do0=%E7%A1%AE%E5%AE%9A

这样的转换,可以用Javascript转换函数encodeURI或encodeURIComponent来实现(两者区别请自行百度)。

为了使代码容易解读,也为了让代码更换参数更加方便,我们将15楼的代码改动为:
  1. Sub Main()
  2.     Dim strText As String
  3.     With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")
  4.         .Open "POST", "http://cn.zso8.com/odds/search/", False
  5.         .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  6. '        .setRequestHeader "Referer", ""
  7.         .Send "type=2&CompanyID=" & encodeURI("11|澳门") & "&leagueID=36&teamID=0&kind=1&port=&odds1=&do0=" & encodeURI("确定")
  8.         strText = .responsetext
  9.         Debug.Print strText
  10.     End With
  11. End Sub
复制代码
自定义函数encodeURI请从11楼里复制。

但字符编码的类型有很多。上述只是一种比较常见的类型。一般来说,当一个中文转成3个16进制的码时(“%XX”为一个16进制码),适合用javascript的encodeURI或encodeURIComponent函数来解码。(实质是utf-8编码)

有时候是这样的编码:“abc一二三”转换为“abc%D2%BB%B6%FE%C8%FD” (ET的登录,用户名就是这样的编码)
在vba里,hex(asc("一"))="D2BB",所以,用循环及文本函数可以很容易写出转码的自定义函数:
  1. Function GBKEnCode(strText)
  2.     Dim i, s
  3.     For i = 1 To Len(strText)
  4.         s = Hex(Asc(Mid(strText, i, 1)))
  5.         If Len(s) = 4 Then s = Left(s, 2) & "%" & Right(s, 2)
  6.         GBKEnCode = GBKEnCode & "%" & s
  7.     Next
  8. End Function
复制代码
有人说,你这样连“abc”三个字符都转成“%61%62%63”了。。。没错,确实全部转了。但全部转了也可以Send成功的。不信你试试?

至于其他类型的编码,我想,只要你熟悉循环和文本函数,再了解下vba里的hex,asc,chr,ascw,chrw,总能写出自定义的转码函数的。

作者: wcymiss    时间: 2014-10-21 16:52
吐槽:
卡死我了,是EH慢还是我的网速慢?一下午就写了这点帖子!每次都要刷新好多次才能成功发帖!我的网速昨天下载速度还上了8M/s的。。。
作者: bluexuemei    时间: 2014-10-21 17:00
wcymiss 发表于 2014-10-21 16:52
吐槽:
卡死我了,是EH慢还是我的网速慢?一下午就写了这点帖子!每次都要刷新好多次才能成功发帖!我的网 ...

吴姐,好久不见你了,终于重出江湖了,江湖有你才叫江湖。你才一下午就写了这么多,太牛,只能仰望!你的网速下载速度竟能达到8M,羡慕嫉妒恨啊!
作者: onlycxb    时间: 2014-10-21 17:04
本帖最后由 onlycxb 于 2014-10-21 17:05 编辑
wcymiss 发表于 2014-10-21 14:13
新手作业:
1、网站:http://data.bank.hexun.com/lccp/jrxp.aspx
     操作:点击“今日在售产品”,获取 ...
  1. (, 下载次数: 782)
  2. Sub HomerWork1_1()
  3. '新手:DongYu
  4. '作业:1、网站:http://data.bank.hexun.com/lccp/jrxp.aspx
  5. '      操作:点击“今日在售产品”,获取今日在售产品第一页的数据。

  6.     Dim xml As New MSXML2.XMLHTTP, url As String, St As String
  7.     Dim arr, brr, ar, i, c
  8.     url = "http://data.bank.hexun.com/lccp/Jrxp.aspx?col=1&tag=desc&date=2014-10-21&page=2"
  9.     With xml
  10.         .Open "GET", url, False
  11.         .send
  12.         St = .responseText
  13.     End With
  14.     St = Split(Split(St, "<div class=""mark"">")(1), "</div>")(0)
  15.     arr = Split(St, "<tr align='center'>")
  16.     ReDim brr(1 To UBound(arr), 1 To 9)
  17.     For i = 1 To UBound(arr)
  18.         ar = arr(i)
  19.         brr(i, 1) = Split(Split(ar, "value='")(1), "'")(0) + Split(Split(ar, "<font class='cred'>")(1), "</font>")(0)
  20.         brr(i, 2) = Split(Split(ar, "</font></td><td class='hl'>")(1), "</td>")(0)
  21.         brr(i, 3) = Split(Split(ar, "<td  class='on'>")(1), "</td>")(0)
  22.         brr(i, 4) = Split(Split(ar, "<td  class='hl'>")(1), "</td>")(0)
  23.         brr(i, 5) = Split(Split(ar, "<td  class='hl'>")(2), "</td>")(0)
  24.         brr(i, 6) = Split(Split(ar, "<td  class='hl'>")(3), "</td>")(0)
  25.         brr(i, 7) = Split(Split(ar, "<td  class='hl'>")(4), "</td>")(0)
  26.         brr(i, 8) = Split(Split(ar, "<td  class='hl'>")(5), "</td>")(0)
  27.         brr(i, 9) = Split(Split(Split(ar, "<td  class='hl'>")(5), "</td>")(1), ">")(1)

  28.     Next i
  29.     With ActiveSheet
  30.         .Cells.Clear
  31.         .Columns("D:E").NumberFormatLocal = "yyyy-m-d"
  32.         .[a1].Resize(1, 10) = [{"对比","产品名称","银行","起售日","停售日","币种","管理期(月)","产品类型","预期收益(%)","收益"}]
  33.         .[b2].Resize(UBound(brr, 1), 9) = brr
  34.     End With
  35. End Sub
复制代码

作者: onlycxb    时间: 2014-10-21 17:08
先交半份作业,只提取一页。晚上再交另一份。
作者: VBA万岁    时间: 2014-10-21 17:14
正需要这个,多谢分享!
作者: blanksoul12    时间: 2014-10-21 17:22
真的很多謝妳,IE法略知一二,但面對網頁是表的時候,都希望用XMLHTTP來應對的,但真不知怎做,現在有妳這個,認知多了,但應該還有些技巧吧,能否再說下去呢?
作者: lolmuta    时间: 2014-10-21 17:39
有没有更平易近人的工具啊…?公司的电脑没有安装.net,不能用啊…
我一直都是用chrome来分析网页元素,因为非常的直觉,但是精细到分析post倒是从来没碰过
作者: lexiaoyao8848    时间: 2014-10-21 17:58
感谢wcymiss的精彩教程,期待继续!!!
作者: 张雄友    时间: 2014-10-21 18:41
看不懂,但楼主的确很有技术。
作者: onlycxb    时间: 2014-10-21 19:30
wcymiss 发表于 2014-10-21 11:45
fiddler的安装、设置、使用
安装:
下载链接:http://www.telerik.com/download/fiddler

在fiddler界面中,点击左下方的"Capturing"按钮停止fiddler抓包。

                                         再次点击继续抓包。!
作者: /wx萧湘剑雨    时间: 2014-10-21 19:41
顶起来看看
作者: renahu    时间: 2014-10-21 20:16
的确是好东西,帮顶!等有空一定学学
作者: wcymiss    时间: 2014-10-21 21:39
本帖最后由 wcymiss 于 2014-10-22 07:14 编辑

获取数据-防盗链的处理-模拟Referer:


当你的vba代码中:
GET部分后面的URL与Request框中的一摸一样;
或是POST的URL、SendData,与Request框中的一摸一样,Content-Type也没有忘记setRequestHeader;
但数据仍旧无法获取时,那你要获取的数据网页一定加了某种防盗链的措施。

此时要开始我们漫长的抓包调试过程了。(路漫漫其修远兮。。。)

调试这样的防盗链网页,如果在Request框中看到有这样的字样:
Referer: http://.......
那么,你首选模拟Referer(因为模拟Referer最简单)

在xmlhttp对象里模拟Referer是无效的。必须要用winhttp对象。


举例:
网站:http://www.sgs.gov.cn/lz/etpsInfo.do?method=index
操作:点选“企业名称”,在空白框内输入“通用技术集团医药控股有限公司”后点击“搜索”,在随后跳出的页面里点击“详细信息”,需要获取该公司的详细信息数据。

根据本楼之前的方法编写的代码:
  1. Sub Main()
  2.     Dim strText As String
  3.     With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")
  4.         .Open "POST", "http://www.sgs.gov.cn/lz/etpsInfo.do?method=viewDetail", False
  5.         .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  6. '        .setRequestHeader "Referer", ""
  7.         .send "etpsId=150000012002040300047"
  8.         strText = .responseText
  9.         Debug.Print strText
  10.     End With
  11. End Sub
复制代码
运行后,立即窗口显示:
(, 下载次数: 273)

模拟Referer后的代码:
Sub Main()
    Dim strText As String
    With CreateObject("WinHttp.WinHttpRequest.5.1") 'CreateObject("MSXML2.XMLHTTP") '
        .Open "POST", "http://www.sgs.gov.cn/lz/etpsInfo.do?method=viewDetail", False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .setRequestHeader "Referer", "http://www.sgs.gov.cn/lz/etpsInfo.do?method=doSearch"
        .send "etpsId=150000012002040300047"
        strText = .responseText
        Debug.Print strText
    End With
End Sub
再次运行,立即窗口即出现相关企业的详细信息。
(, 下载次数: 307)


小贴士:除了Content-Type、Referer和Cookie,其他setRequestHeader的情况很少见。
作者: wcymiss    时间: 2014-10-21 21:55
本帖最后由 acecrazy 于 2014-12-11 14:17 编辑

获取数据-防盗链的处理-模拟Cookie:

再次提醒,抓包前请先清除浏览器所有Cookie、缓存、历史数据。

举例:
网站:http://www.gzgczj.com:8080/costRegulatory/user.do?method=changeIndex&fareaId=1
操作:点击“控制价备案”,获取工程名称和招标控制价信息数据。

此网页模拟Referer后仍然无法获取数据。于是考虑模拟Cookie。
复制数据页面的cookie值,填入代码中(先不要去掉Referer的模拟):
(, 下载次数: 274)
  1. Sub Main()
  2.     Dim strText As String
  3.     With CreateObject("WinHttp.WinHttpRequest.5.1")
  4.         .Open "GET", "http://www.gzgczj.com:8080/costRegulatory/project.do?method=showProjectList&isVisitor=1&f_id=11011&t1413902083242", False
  5.         .setRequestHeader "Referer", "http://www.gzgczj.com:8080/costRegulatory/user.do?method=changeIndex&fareaId=1"
  6.         .setRequestHeader "Cookie", "E0685A9F6B708A1F1039BF2322B82A35"
  7.         .Send
  8.         strText = .responsetext
  9.         Debug.Print strText
  10.     End With
  11. End Sub
复制代码
运行,,立即窗口显示“请重新登录”!
(, 下载次数: 247)

这是为什么呢?这是因为Cookie失效了!我们需要模拟“新鲜”的Cookie才行!

模拟“新鲜”Cookie的方法:
1、复制上面Cookie值字符串。
2、搜索Session框内第一次出现此Cookie值的网页:
(, 下载次数: 264)

(, 下载次数: 256)

3、编写代码,获取该Cookie,然后模拟写入数据网页:
  1. Sub Main()
  2.     Dim strText As String
  3.     Dim strCookie As String
  4.    
  5.     With CreateObject("WinHttp.WinHttpRequest.5.1")
  6.         .Option(6) = False ' 禁止重定向,以获取原网页信息
  7.         .Open "GET", "http://www.gzgczj.com:8080/costRegulatory/user.do?method=changeIndex&fareaId=1", False
  8.         .Send
  9.         strText = .getAllResponseHeaders '获取所有的回应头信息
  10.         Debug.Print strText: Stop '在立即窗口里查看头信息
  11.         strCookie = Split(Split(strText, "Set-Cookie: ")(1), ";")(0) '取出Cookie值
  12.     End With
  13.    
  14.     '在同一个winhttp对象里能保留cookie,为了体现设置cookie的作用,启用一个新的winhttp对象
  15.     With CreateObject("WinHttp.WinHttpRequest.5.1")
  16.         .Open "GET", "http://www.gzgczj.com:8080/costRegulatory/project.do?method=showProjectList&isVisitor=1&f_id=11011&t1413902083242", False
  17.         .setRequestHeader "Referer", "http://www.gzgczj.com:8080/costRegulatory/user.do?method=changeIndex&fareaId=1"
  18.         .setRequestHeader "Cookie", strCookie '模拟Cookie
  19.         .Send
  20.         strText = .responsetext
  21.         Debug.Print strText
  22.     End With
  23. End Sub
复制代码
运行。。查看立即窗口,数据获取成功。
注意:本cookie是存在于重定向之前的网页的,要取到该cookie,必须禁用重定向。关于重定向,请参考108楼的帖子
不要用getResponseHeader("Set-Cookie")获取回应头信息中的Cookie值。如果有多个Cookie值,用getResponseHeader("Set-Cookie")获取不到完整的Cookie值。

你如果认为模拟Cookie只能写setRequestHeader的话,你就大错特错了。

xmlhttp对象和winhttp对象均可以保留Cookie。
也就是说,要获取某个网页的Cookie,可以先发送对此网页的请求(GET或POST)。只要xmlhttp对象或winhttp对象不关闭,此Cookie在对象运行期间全程有效。


据此,上述代码可以简化为:
  1. Sub Main()
  2.     Dim strText As String
  3.     With CreateObject("WinHttp.WinHttpRequest.5.1")
  4.         .Open "GET", "http://www.gzgczj.com:8080/costRegulatory/user.do?method=changeIndex&fareaId=1", False
  5.         .Send '此次send是为了获取cookie
  6.         .Open "GET", "http://www.gzgczj.com:8080/costRegulatory/project.do?method=showProjectList&isVisitor=1&f_id=11011&t1413902083242", False
  7.         .setRequestHeader "Referer", "http://www.gzgczj.com:8080/costRegulatory/user.do?method=changeIndex&fareaId=1"
  8.         .Send
  9.         strText = .responsetext
  10.         Debug.Print strText
  11.     End With
  12. End Sub
复制代码
运行。。查看立即窗口,数据同样获取成功。

小贴士:用setRequestHeader方法模拟Cookie时,要用winhttp对象。发送网页的请求获取Cookie则xmlhttp、winhttp都可以。


作者: dg831451    时间: 2014-10-21 21:58
wcymiss 发表于 2014-10-21 21:39
获取数据-防盗链的处理-模拟Referer:

不知道吴姐,有没有研究过https加密网站同时还要发送证书的
作者: dg831451    时间: 2014-10-21 22:13
回复弦月老师,其实也不算内网,用了证书可以登陆,不过公司有登陆日志。今天用ie方法获取856页数据,用了28分钟。。。
作者: wcymiss    时间: 2014-10-21 22:16
dg831451 发表于 2014-10-21 21:58
不知道吴姐,有没有研究过https加密网站同时还要发送证书的

https做过,但没遇到过有证书问题的网页。

winhttp有个选项可以忽略证书错误(Option(4) = 13056),但这可能不是你要的。


作者: suwenkai    时间: 2014-10-21 22:18
wcymiss 发表于 2014-10-21 14:13
新手作业:
1、网站:http://data.bank.hexun.com/lccp/jrxp.aspx
     操作:点击“今日在售产品”,获取 ...

第一题
  1. Sub 按钮1_单击()
  2.     Dim url, html
  3.     url = "http://data.bank.hexun.com/lccp/Jrxp.aspx?"
  4.     url = url & "col=1"
  5.     url = url & "&tag=desc"
  6.     url = url & "&date=2014-10-21" '查询日期
  7.     url = url & "&page=1" '查询页码

  8.     Set html = CreateObject("htmlfile")
  9.     With CreateObject("msxml2.xmlhttp")
  10.         .Open "get", url, False
  11.         .send
  12.         html.body.innerhtml = .responsetext
  13.         Set tb = html.all.tags("table")(1).Rows
  14.         For i = 0 To tb.Length - 1
  15.             For j = 1 To tb(i).Cells.Length - 1
  16.                 Cells(i + 1, j) = tb(i).Cells(j).innertext
  17.             Next
  18.         Next
  19.     End With
  20. End Sub
复制代码

作者: xmyjk    时间: 2014-10-21 22:19
好东西,一口气读了下来,继续期待后续,强烈推荐。
作者: 浮华、缠绕指尖    时间: 2014-10-21 22:30
本帖最后由 浮华、缠绕指尖 于 2014-10-21 22:43 编辑

吴姐,俺知道这是你一直以来蓄谋已久的大招。。。

俺的网抓部分也是你一步一步带起来的,哈哈其实吧,个人觉得,大部分人都是拿来主义,你讲细了很多人都不会去自己动手分析了,实际上网抓就是一个苦差事,1、POST时各种动态参数的寻找与分析,2、各种模拟头文件去伪造,3、相对轻松的字符串处理。

呵呵,你这也算是师傅带入门,修行看个人了。


作者: suwenkai    时间: 2014-10-21 22:39
wcymiss 发表于 2014-10-21 14:13
新手作业:
1、网站:http://data.bank.hexun.com/lccp/jrxp.aspx
     操作:点击“今日在售产品”,获取 ...

第二题
  1. Sub 按钮2_单击()
  2.     Dim url, html
  3.     url = "http://webflight.linkosky.com/WEB/Flight/FlightSearchResultDefault.aspx?JT=1"
  4.     url = url & "&OC=PEK"    '北京首都机场
  5.     url = url & "&DC=SHA"    '上海虹口机场
  6.     url = url & "&dstDesp=GUANGZHOU%B9%E3%D6%DD"
  7.     url = url & "&dst2=CAN"
  8.     url = url & "&DD=2014-10-22"    '查询日期
  9.     url = url & "&DT=7"
  10.     url = url & "&BD="
  11.     url = url & "&BT=7"
  12.     url = url & "&AL=ALL"    '全部航空
  13.     url = url & "&DR=true"
  14.     url = url & "&image.x=33"
  15.     url = url & "&image.y=9"
  16.     url = url & "&Sn=87bf24142bc0c78727610871f373e0a7"

  17.     Set html = CreateObject("htmlfile")
  18.     With CreateObject("msxml2.xmlhttp")
  19.         .Open "get", url, False
  20.         .send
  21.         html.body.innerhtml = .responsetext


  22.         Set tb = html.all.tags("div")
  23.         For i = 0 To tb.Length - 1
  24.             If tb(i).classname = "menu_layout2" Or tb(i).classname = "listone_layout" Or tb(i).classname = "listtwo_layout" Or tb(i).classname = "menu_content_small2" Then
  25.                 n = n + 1
  26.                 For j = 0 To tb(i).childnodes.Length - 1
  27.                     Cells(n, j + 1) = tb(i).childnodes(j).innertext
  28.                 Next

  29.             End If
  30.         Next
  31.     End With
  32. End Sub
复制代码

作者: 战战如疯    时间: 2014-10-21 23:12
期待大神完整作品,尤其是防盗链处理方面的知识。还有验证码的问题
作者: wcymiss    时间: 2014-10-22 06:58
本帖最后由 wcymiss 于 2014-10-22 07:07 编辑

继续唠叨Cookie。。。

33楼的例子里,Cookie值的最初来源,来自服务器返回的回应头信息的“Set-Cookie”,它对winhttp对象的Cookie进行了设置。这种Cookie来源,不需要写setRequestHeader来模拟Cookie,只需发送一下相关页面的请求即能获取该Cookie。

但有些网页的Cookie值,来源并非是回应头信息的“Set-Cookie”。它可能是responsetext中的一部分。这时就只能setRequestHeader了。

(刚刚想找一个我以前写过的Cookie存在于responsetext的例子,发现网站竟然改版了,也“Set-Cookie”了!!)
征求Cookie存在于responsetext的例子。。。。


作者: onlycxb    时间: 2014-10-22 08:25
本帖最后由 onlycxb 于 2014-10-22 08:31 编辑
wcymiss 发表于 2014-10-21 14:13
新手作业:
1、网站:http://data.bank.hexun.com/lccp/jrxp.aspx
     操作:点击“今日在售产品”,获取 ...

作业2、网站:http://www.caac.gov.cn/S1/GNCX/,     操作:点击“查询”,获取航班信息数据。
  1. Sub 作业1_2_获取航班信息数据()
  2. '网站:http://www.caac.gov.cn/S1/GNCX/
  3. '操作:点击“查询”,获取航班信息数据。
  4.     Dim St As String, Url$, arr, brr, Crr
  5.     Dim S1$, S2$, i%, j%, rng As Range
  6.     Url = "http://webflight.linkosky.com/WEB/Flight/FlightSearchResultDefault.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=9&Sn=87bf24142bc0c78727610871f373e0a7"
  7.     With CreateObject("WinHttp.WinHttpRequest.5.1")
  8.         .Open "GET", Url, False
  9.         .Send
  10.         St = .responsetext
  11.     End With
  12.     '
  13.     If InStr(St, "<div id=""FlightListFlight0"">") < 1 Then
  14.         Cells(1, 1) = "抱歉!没有满足条件的航班,请重新输入查询条件! "
  15.     Else
  16.         St = Split(Split(St, "<div id=""FlightListFlight0"">")(1), "</div><br>")(0)
  17.         With ActiveSheet
  18.             Cells(1, 1) = Split(Split(St, "<strong>")(1), "</strong>")(0)
  19.             arr = Split(St, "<div class=""menu_layout2"">")                                        '航空公司分组
  20.             For i = 1 To UBound(arr)
  21.                 S1 = arr(i)
  22.                 Crr = Split(S1, "<div class=""listtwo_layout"">")
  23.                 ReDim brr(1 To UBound(Crr) + 2, 1 To 5)                                         '班次UBound(S1) + 1,航空公司及机行+1,航线+1
  24.                 '航空公司
  25.                 brr(1, 1) = Trim(Split(Split(S1, "<div class=""menu_top1"">")(1), "</div>")(0))          '中国东方航空公司
  26.                 brr(1, 2) = Trim(Split(Split(S1, "<div class=""menu_top2"">")(1), "</div>")(0))          '航班
  27.                 brr(1, 2) = Trim(Split(Split(brr(1, 2), "font"">")(1), "</span>")(0))
  28.                 brr(1, 3) = Trim(Split(Split(S1, "<div class=""menu_top2"">")(2), "</div>")(0))          ''机型:333
  29.                 '飞行线路
  30.                
  31.                 brr(2, 1) = Trim(Split(Split(S1, "<div class=""menu1_layout"">")(1), "</div>")(0))       '北京首都机场
  32.                 brr(2, 2) = Trim(Split(Split(S1, "<div class=""menu2_layout"">")(1), "</div>")(0))       '(22:00)
  33.                 brr(2, 3) = Trim(Split(Split(S1, "<div class=""menu3_layout"">")(1), "</div>")(0))       '经停:0
  34.                 brr(2, 4) = Trim(Split(Split(S1, "<div class=""menu1_layout"">")(2), "</div>")(0))       '上海虹桥机场
  35.                 brr(2, 5) = Trim(Split(Split(S1, "<div class=""menu2_layout"">")(2), "</div>")(0))       '(23:55)
  36.                 '飞行班次
  37.                 For j = 1 To UBound(Crr)
  38.                 S2 = Crr(j)
  39.               '  Debug.Print S2
  40.                 brr(2 + j, 1) = Trim(Split(Split(S2, "<div class=""menu4_layout"">")(1), "</div>")(0)) '票价
  41.                 brr(2 + j, 2) = Trim(Split(Split(S2, "<div class=""menu5_layout"">")(1), "</div>")(0)) '舱位'
  42.                 brr(2 + j, 3) = Trim(Split(Split(S2, "<div class=""menu6_layout"">")(1), "</div>")(0)) '票数'
  43.                '……
  44.                
  45.                 Next j
  46.                 Set rng = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
  47.                 rng.Resize(UBound(brr, 1), 5) = brr
  48.    
  49.             Next i
  50.         End With
  51.     End If
  52. End Sub
复制代码
'顺便把航空公司抓了一下 (, 下载次数: 254)
  1. Sub 作业1_2_航空公司获取()
  2. '网站:http://www.caac.gov.cn/S1/GNCX/
  3. '操作:点击“查询”,获取航班信息数据。
  4.     Dim strText As String
  5.     With CreateObject("MSXML2.XMLHTTP")
  6.         .Open "GET", "http://www.caac.gov.cn/images/airlinecontrol.js", False
  7.         .Send
  8.         strText = .responsetext
  9.         Debug.Print ByteToStr(.responseBody, "GB2312")
  10.     End With
  11. End Sub

  12. Function ByteToStr(arrByte, strCharset As String) As String
  13.     With CreateObject("Adodb.Stream")
  14.         .Type = 1 'adTypeBinary
  15.         .Open
  16.         .Write arrByte
  17.         .Position = 0
  18.         .Type = 2 'adTypeText
  19.         .Charset = strCharset
  20.         ByteToStr = .Readtext
  21.         .Close
  22.     End With
  23. End Function






复制代码

作者: ammyc    时间: 2014-10-22 09:23
好好学习,天天向善
作者: wcymiss    时间: 2014-10-22 11:10
本帖最后由 wcymiss 于 2014-10-22 12:32 编辑

还是Cookie。。。

模拟Cookie的宗旨是向服务器发送一个它认可的Cookie。不管这个Cookie是回话Cookie还是持久Cookie,甚至该Cookie根本不存在你的电脑中(无论内存还是硬盘),只要服务器认可就行。

举例:
网站:http://club.excelhome.net/
操作:登录EH,在论坛首页点击“我发布的主题”,获取自己的主题帖数据。

EH的登录添加了验证码,这对我们初学网抓的人来说用xmlhttp/winhttp模拟登录EH是个无法克服的难题。

但是我们可以模拟Cookie来实现查询效果呀!

步骤:
1、抓包确认数据页面所在session。
2、点击该session的Request框的Cookie按钮可查看发送头内的Cookie内容。(挤在一起还是看不清楚)
(, 下载次数: 293)

3、点击Request框的Header按钮查看Cookie更清晰:
(, 下载次数: 300)

抓到的Cookie有很多,但不是每一个都需要模拟的。

经验:10位数字值一般都是用来记录时间的,这样的Cookie值一般不大会作为服务器的辨识标志,所以我们也一般不用模拟它。 (注意我用了“一般”这个词)

去除值为数字或空白的Cookie,只取值为字母数字混合物的Cookie写入代码中:
  1. Sub Main()
  2.     Dim strText As String
  3.     Const saltkey As String = "oUuXXXX"'请复制你自己的Cookie粘贴到这里。下同
  4.     Const sid As String = "tXXXX"
  5.     Const auth As String = "a30eEZTXXXXXXXXXXXXXXXXXXXX"
  6.     Const cookiereport As String = "f1fXXXXXXXXXXXXXXXXXXXXXXXX"
  7.     Const ulastactivity As String = "84cXXXXXXXXXXXXXXXXXXXX"
  8.     Const touclick As String = "70a9vPXXXXXXXXXXXXXXXXXXXX"
  9.     Const member_login_uid As String = "218917"
  10.     Const member_login_sid As String = "tXXXX"
  11.    
  12.     With CreateObject("WinHttp.WinHttpRequest.5.1")
  13.         .Open "GET", "http://club.excelhome.net/home.php?mod=space&do=thread&view=me ", False
  14.         .setRequestHeader "Cookie", _
  15.         "5WOj_b676_saltkey=" & saltkey _
  16.         & ";5WOj_b676_sid=" & sid _
  17.         & ";5WOj_b676_auth=" & auth _
  18.         & ";5WOj_b676_cookiereport=" & cookiereport _
  19.         & ";5WOj_b676_ulastactivity=" & ulastactivity _
  20.         & ";5WOj_b676_touclick=" & touclick _
  21.         & ";5WOj_b676_member_login_uid=" & member_login_uid _
  22.         & ";5WOj_b676_member_login_sid=" & member_login_sid
  23.         .Send
  24.         strText = .responsetext
  25.         Debug.Print strText
  26.     End With
  27. End Sub
复制代码
运行。。查看立即窗口,获取数据成功。

继续测试,去除一些对获取数据无影响的Cookie(连论坛ID都去除了,大跌眼镜),代码最后成型为:
  1. Sub Main()
  2.     Dim strText As String
  3.     Const saltkey As String = "oUuXXXX"
  4.     Const auth As String = "a30eEZTXXXXXXXXXXXXXXXXXXXX"
  5.    
  6.     With CreateObject("WinHttp.WinHttpRequest.5.1")
  7.         .Open "GET", "http://club.excelhome.net/home.php?mod=space&do=thread&view=me ", False
  8.         .setRequestHeader "Cookie", _
  9.         "5WOj_b676_saltkey=" & saltkey _
  10.         & ";5WOj_b676_auth=" & auth
  11.         .Send
  12.         strText = .responsetext
  13.         Debug.Print strText
  14.     End With
  15. End Sub
复制代码
这两个Cookie值就是EH的关键登录Cookie。它不需要保存在你的电脑里(本地电脑清除cookie、缓存后代码依旧运行成功)。我不知道它在服务器上的生存期有多长,我用了三天依然有效,哪怕在这三天内已经无数次的在不同地点手工重新登录过EH。有兴趣的话可以自己测试下它的生存期。
作者: wcymiss    时间: 2014-10-22 11:33
xmyjk 发表于 2014-10-21 22:19
好东西,一口气读了下来,继续期待后续,强烈推荐。

重定向在目录已经列出,在后面的知识点中会讲到。
作者: lolmuta    时间: 2014-10-22 11:45
本帖最后由 lolmuta 于 2014-10-22 12:11 编辑

真心不错                     
作者: 睡醒的我    时间: 2014-10-22 11:59
wcymiss 发表于 2014-10-22 11:10
还是Cookie。。。

模拟Cookie的宗旨是向服务器发送一个它认可的Cookie。不管这个Cookie是回话Cookie还是 ...

大师,如何抓取有用户名 和密码 等网站 里面的数据,用户名和密码要如何弄
作者: 睡醒的我    时间: 2014-10-22 12:00
suwenkai 发表于 2014-10-21 22:39
第二题

大师,如何抓取有用户名 和密码 等网站 里面的数据,用户名和密码要如何弄
作者: wcymiss    时间: 2014-10-22 12:30
本帖最后由 wcymiss 于 2014-10-22 13:54 编辑

新手作业:

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

作者: VBA万岁    时间: 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

作者: VBA万岁    时间: 2014-10-22 12:34
本帖最后由 VBA万岁 于 2014-10-22 12:40 编辑
VBA万岁 发表于 2014-10-22 12:33
ie法完成作业1:
Sub 今日在售银行产品()
'On Error Resume Next


附件如下地:
(, 下载次数: 510)
作者: VBA万岁    时间: 2014-10-22 12:51
suwenkai 发表于 2014-10-21 22:18
第一题

suwenkai大师的代码可作为23及52楼、53代码的改善版。
作者: 592rmb    时间: 2014-10-22 14:01
好,太需要这样图文并茂的教程了,感谢wcymiss强大的技术和博大的胸怀
作者: wcymiss    时间: 2014-10-22 15:30
获取数据-防盗链的处理-模拟User-Agent

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

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

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

我们在电脑上也可以利用fiddler伪装成手机哦!
步骤:
1、打开Fiddler,勾选“Rules”-“User-Agents”-“WinPhone7”
(, 下载次数: 377)

2、打开浏览器,打开EH论坛,点击任一用户名,点击“回帖数”。
(, 下载次数: 346)

(, 下载次数: 365)


3、在Fiddler里查找数据网页,复制User-Agent后的字符串,写入代码。
(, 下载次数: 358)

代码如下:


  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
复制代码

作者: wcymiss    时间: 2014-10-22 15:45
获取数据-防盗链的处理-其他发包头的模拟

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

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

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

作者: wcymiss    时间: 2014-10-22 16:45
本帖最后由 wcymiss 于 2014-10-28 16:12 编辑

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

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

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

数据网页的参数列表:
(, 下载次数: 357)

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值后再进行查询。

作者: wcymiss    时间: 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一起复制进去有可能搜索不到网页。

(, 下载次数: 345)

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

(, 下载次数: 364)

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

(, 下载次数: 370)

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

(, 下载次数: 359)

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

(, 下载次数: 352)

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

(, 下载次数: 351)

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

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

(, 下载次数: 372)

成型代码:
  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值还会有一部分内容是相同的。所以搜索到参数值后一定要校对整个字符串是否完全一致。
作者: VBA万岁    时间: 2014-10-22 17:09
本帖最后由 VBA万岁 于 2014-10-22 17:16 编辑
suwenkai 发表于 2014-10-21 22:39
第二题


以前只知道对html.all.tags("table")中的行及单元格进行循环,今方知还可对html.all.tags("div")的行列进行循环。
Mark如附件:
(, 下载次数: 731)

作者: VBA万岁    时间: 2014-10-22 17:14
wcymiss 发表于 2014-10-22 06:58
继续唠叨Cookie。。。

33楼的例子里,Cookie值的最初来源,来自服务器返回的回应头信息的“Set-Cookie” ...

好喜欢并期待着吴姐的唠叨......
作者: ak47ok    时间: 2014-10-22 21:15
每次回帖、谢谢!辛苦了。
作者: ak47ok    时间: 2014-10-22 21:18
wcymiss 发表于 2014-10-21 11:33
个人偏爱fiddler的原因:(唠叨话,可略过)

1、fiddler不需要寄生在浏览器中,且可抓到多个浏览器的包。 ...

请教吴姐: fiddler 与 httpwatch 如何比较?我一直在用httpwatch。
谢谢!
作者: oyxm727    时间: 2014-10-22 21:26
不懂啊
要学的东西真多
作者: 浮华、缠绕指尖    时间: 2014-10-22 22:23
ak47ok 发表于 2014-10-22 21:18
请教吴姐: fiddler 与 httpwatch 如何比较?我一直在用httpwatch。
谢谢!

也是一个道理。。抓数据之前最好清缓存,都差不多。。
作者: renahu    时间: 2014-10-22 22:48
VBA万岁 发表于 2014-10-22 17:14
好喜欢并期待着吴姐的唠叨......

从抓下来的一大团数据中用split摘出一个一个的有用信息,有什么规律吗?数据一大团,对于新手来说都晕菜了,高手给举个例子讲解一下,谢谢
作者: renahu    时间: 2014-10-23 07:47
renahu 发表于 2014-10-22 22:48
从抓下来的一大团数据中用split摘出一个一个的有用信息,有什么规律吗?数据一大团,对于新手来说都晕菜了 ...

看见别的同学的作业那么漂亮,真羡慕,期待新课。。。
作者: VBA万岁    时间: 2014-10-23 08:31
renahu 发表于 2014-10-22 22:48
从抓下来的一大团数据中用split摘出一个一个的有用信息,有什么规律吗?数据一大团,对于新手来说都晕菜了 ...

我也是新手,一同期待wcymiss老师更多更精彩的讲解......
作者: wcymiss    时间: 2014-10-23 09:53
本帖最后由 wcymiss 于 2014-10-23 10:06 编辑

之前提过,QQ软件也可以用Fiddler抓包。
我们来抓抓群成员的清单。
1、打开fiddler,打开群聊天窗口,“群设置”-“修改我的群名片”,等待出现了群成员列表后抓包结束。
2、在fiddler里搜索任意一个群成员的昵称或群名片(最好是纯英文的)或QQ号,确认数据网页。
看下数据网页的参数和Cookie:
(, 下载次数: 168)

(, 下载次数: 154)

经过测试,只需群号、qq号、bkn、skey这几个值就ok。
代码如下:
  1. Sub Main()
  2.     Const gc As String = "" '群号
  3.     Const bkn As String = "" '从fiddler中获取
  4.     Const uin As String = "" 'QQ号
  5.     Const skey As String = "" '从fiddler中获取
  6.     Dim strText As String
  7.     With CreateObject("WinHttp.WinHttpRequest.5.1")
  8.         .Open "GET", "http://qinfo.clt.qq.com/cgi-bin/qun_info/get_group_members_new?gc=" & gc & "&bkn=" & bkn, False
  9.         .setRequestHeader "Cookie", "uin=o" & uin & "; skey=" & skey
  10.         .Send
  11.         strText = .responsetext
  12.         Debug.Print strText
  13.     End With
  14. End Sub
复制代码
QQ群管的很多操作都可以抓包。比如,踢人,同意人员入群,上传群文件,管理群文件,等等。“bkn、skey在手,QQ群管不用愁”。
作者: ccwan    时间: 2014-10-23 11:31
吴姐终于出教程了啊,收藏了
作者: wcymiss    时间: 2014-10-23 12:13
说到skey和bkn,索性再唠叨一下用IE获取Cookie的例子。

QQ的skey用winhttp比较难以获取,当中包含了一些复杂的js算法。

不过没关系,我们可以利用IE。当然,你的QQ软件需要先登录。

手工用IE打开http://xui.ptlogin2.qq.com/div/qlogin_div.html,如果提示安装控件请下载安装。

运行下面的代码即可得到登录QQ的skey值。
如果登录了多个QQ,代码里需要加上判断。这个代码我就不写了,是IE的用法,不在本帖讨论的范围内。
  1. Sub Main()
  2.     Dim objDoc As Object
  3.     Dim strText As String
  4.     Dim skey As String, t
  5.    
  6.     With CreateObject("InternetExplorer.Application")
  7.         .Navigate "http://xui.ptlogin2.qq.com/div/qlogin_div.html"
  8.         While .readystate <> 4 Or .busy: Wend
  9.         For Each objDoc In .Document.getelementsbytagname("INPUT")
  10.             If objDoc.Type = "submit" Then Exit For
  11.         Next
  12.         objDoc.Click
  13.         t = Timer
  14.         While Timer < t + 4: Wend
  15.         strText = .Document.cookie
  16.         .Quit
  17.     End With
  18.     Debug.Print strText
  19.     skey = Split(Split(strText, "skey=")(1), ";")(0)
  20.     Debug.Print skey
  21. End Sub
复制代码
试试看,能不能获取到skey。

顺便分享下获取bkn的代码:
  1. Function GetBkn(skey As String) As String
  2.     With CreateObject("MSScriptControl.ScriptControl")
  3.         .Language = "javascript"
  4.         GetBkn = .Eval("bkn=function(a){for(var c=5381,b=0,d=a.length;b<d;++b)c+=(c<<5)+a.charAt(b).charCodeAt();return c&2147483647}('" & skey & "');")
  5.     End With
  6. End Function
复制代码

作者: onlycxb    时间: 2014-10-23 12:13
wcymiss 发表于 2014-10-22 12:30
新手作业:

网站:http://weibo.com/guide/welcome

近两天忙,作业一定补交的。
作者: 592rmb    时间: 2014-10-23 12:41
工作中遇到的问题,虽然一直在学习,但因非专业,到现在还不能完全自己解决,期待高手们相助,谢谢了!
作者: VBA万岁    时间: 2014-10-23 12:42
wcymiss 发表于 2014-10-22 16:56
再上一个动态参数的例子:

网站:http://www.abchina.com/cn/Public ... t20101217_45743.htm

将老师抓取到的数据导入Excel表如附件:
(, 下载次数: 587)

作者: renahu    时间: 2014-10-23 12:53
VBA万岁 发表于 2014-10-23 08:31
我也是新手,一同期待wcymiss老师更多更精彩的讲解......

我看了你的作业,真棒,特详细,适合我们这些基础差的研究,我正在一点一点看你的代码,终于看明白了,呵呵,多亏你的作业,谢谢
作者: wenwen000424    时间: 2014-10-23 12:54
记录一下,以便学习。
作者: 引子玄    时间: 2014-10-23 13:01
本帖最后由 引子玄 于 2014-10-23 13:09 编辑

我看,你的抓取方法,就叫“Fiddler抓取法”——很贴切很形象,借助Fiddler武器的抓。
不过我是习惯了徒手抓,啥武器都不用,但要用IE,否则徒手抓不了。


作者: coby001    时间: 2014-10-23 13:11
本帖最后由 coby001 于 2014-10-23 13:13 编辑
引子玄 发表于 2014-10-23 13:01
我看,你的抓取方法,就叫“Fiddler抓取法”——很贴切很形象,借助Fiddler武器的抓。
不过我是习惯了徒手 ...


算不上吧~
Fiddler只是辅助工具,又不是直接用菲德勒抓数据。


作者: kangatang    时间: 2014-10-23 13:14
本帖最后由 kangatang 于 2014-10-23 13:17 编辑
wcymiss 发表于 2014-10-21 16:52
吐槽:
卡死我了,是EH慢还是我的网速慢?一下午就写了这点帖子!每次都要刷新好多次才能成功发帖!我的网 ...

不知从什么时候开始,EH论坛变得有点卡顿,给你回复时,我3次重新打开浏览器,再登录EH论坛才得以操作成功。

学习吴女神课程,依据http协议向服务器发送requests。
两个关注:
1)Request Header的制作 (=>抓包工具分析后模拟制作)
2)发送的方式的选择,xmlhttp/winhttp....还有其它比较底层的发送方式:winsock、DOS命令等
作者: coby001    时间: 2014-10-23 13:27
kangatang 发表于 2014-10-23 13:14
不知从什么时候开始,EH论坛变得有点卡顿,给你回复时,我3次重新打开浏览器,再登录EH论坛才得以操作成功 ...
两个关注:
1)Request Header的制作 (=>抓包工具分析后模拟制作即可)
2)发送的方式的选择,xmlhttp/winhttp....还有其它比较底层的发送方式:winsock、DOS命令等



没必要学的如此深吧~
如果既要方式多样,又要方便灵活,学学python + requests模块 也不错。易于操控,功能强大。




作者: VBA万岁    时间: 2014-10-23 14:08
浮华、缠绕指尖 发表于 2014-10-22 22:23
也是一个道理。。抓数据之前最好清缓存,都差不多。。

吴姐也这样讲。
如何手动清缓存啊?——能给一个截图加以说明吗?

作者: wcymiss    时间: 2014-10-23 14:50
其实用fiddler网抓的方法写到这里基本可以告一段落了,剩下的就是多多操作,多写代码,多攒经验。有时候某个参数是否是动态,是否影响数据获取,经验多了,靠肉眼也能辨别个大概了。

登录和上传也一样是GET/POST+setRequestheade+Send,只不过登录的参数一般比较复杂,在fiddler里抓不到明码来源,需要解读js脚本代码;上传的SendData比较繁琐,所以这两项放在后面单独讲。

作者: wcymiss    时间: 2014-10-23 14:51
本帖最后由 wcymiss 于 2014-10-24 15:18 编辑

对获取数据作个小结
1、清除缓存cookie历史记录后用fiddler抓包。
2、搜索所需数据,找到数据真实网页(别忘了对fiddler事先进行设置,否则有可能搜不到数据)
3、用代码模拟Request框的Raw按钮下的内容:
   首先只写Open和Send,看是否有数据;(xmlhttp)(winhttp有时解析utf-8字符不成功,所以初始测试首选xmlhttp
   无数据的话,首选模拟Referer;(winhttp)
   仍然不行的话,观察Cookie或是URL或SendData中有无动态参数。有的话需要追根朔源。(这步需要时间和耐心)
   其他模拟一般都是小概率事件,如果遇到了我只能说你很不幸。

最后,祝你成功!



作者: 592rmb    时间: 2014-10-23 14:53
592rmb 发表于 2014-10-23 12:41
工作中遇到的问题,虽然一直在学习,但因非专业,到现在还不能完全自己解决,期待高手们相助,谢谢了!

我在查询结果页面的源码中找不到需要的数据,所以就不知道怎么搞了
作者: coby001    时间: 2014-10-23 15:04
592rmb 发表于 2014-10-23 14:53
我在查询结果页面的源码中找不到需要的数据,所以就不知道怎么搞了

说话要具体点。
网址?
要什么数据?

作者: VBA万岁    时间: 2014-10-23 15:12
VBA万岁 发表于 2014-10-23 14:08
吴姐也这样讲。
如何手动清缓存啊?——能给一个截图加以说明吗?

百度结果:
http://zhidao.baidu.com/link?url=-9S1gJlPKiBWbC-e_wBQ8lQUI409P4xuGZ-wtvLjLUZzvwEyDNbpFAU9K9tBMvZ_s79fBs2Ff6zRh11XIsbzDq
☆ IE61、点击工具菜单。
      2、选择 Internet 选项。
      3、点击常规标签。
      4、点击删除文件按钮。
      5、在确认 窗口中点击确定按钮。
      6、点击确定按钮关闭"Internet 选项"窗口。
☆ IE 71、点击工具菜单。如果您没找到该菜单,请按键盘上的 Alt 键来显示菜单。
      2、选择删除浏览的历史记录。
      3、点击删除文件按钮。
      4、在确认窗口中点击是按钮。
      5、点击关闭按钮。
☆ I E81、点击工具菜单。如果您没找到该菜单,请按键盘上的 Alt 键来显示菜单。
      2、选择删除浏览的历史记录。
      3、选中 Internet 临时文件复选框。
      4、点击删除按钮。
      5、将文件删除后,点击确定。
☆火狐浏览器Firefox要清空 Mozilla Firefox 的缓存,请按以下步骤操作:
      1、单击浏览器顶部的"Tools"(工具)菜单,并选 择"Options"(选项)。
      2、单击"Privacy"(隐私)。
      3、单击"Cache"(高速缓存)旁边的"Clear"(清空缓存)。
      4、单击"OK"(确定)。
☆傲游(Maxthon)1、单击浏览器顶部的"工具"菜单,并选择"Internet选项"。
      2、在常规下选择删除浏览历史记录。
      3、选择Internet临时文件
      4、将文件删除后,点击关闭。
☆谷歌浏览器chrome要清空chrome的缓存,请按以下步骤操作:
      1、 点击小扳手图标
      2、选择“选项”
      3、选择“个人资料”
      4、在浏览数据中,点击“清除浏览数据”
      5、弹出小窗 口点击“清除浏览数据”
☆360浏览器要清空360的缓存,请按以下步骤操作:
      1、单击浏览器顶部的"工具"菜单,并选择"IE选项"。
      2、在常规下选择删除浏览的历史记录。
      3、选中 Internet 临时文件复选框。
      4、点击删除按钮。
      5、将文件删除后,点击确定。重启浏览器~~

截图如下:
(, 下载次数: 153)

作者: 592rmb    时间: 2014-10-23 15:36
coby001 发表于 2014-10-23 15:04
说话要具体点。
网址?
要什么数据?

请看一下74楼的问题,是我工作中遇到的问题,但不会弄,麻烦帮忙弄一下,我希望我自己也能学会,谢谢了!
作者: bmdsjxyw    时间: 2014-10-23 15:49
好贴,留下学习的脚印,谢谢分享
作者: kangatang    时间: 2014-10-23 16:08
例子非常强大。。。。。一般的人找不全这么多的例子,感叹大师身经百战的传奇经历。这不是一个普通的知识贴,她在告诉我们什么叫 "实践出真知"。。。。。。越来越高大了。。。
作者: wcymiss    时间: 2014-10-23 16:12
本帖最后由 wcymiss 于 2014-10-30 18:19 编辑

缓存的困扰
用xmlhttp对象GET数据时,会优先从缓存中调取。

比如下面这段代码:
  1. Sub Main()
  2.     Dim strText As String
  3.     With CreateObject("MSXML2.XMLHTTP")
  4.         .Open "GET", "http://www.1396me.com/shishicai/", False
  5.         .Send
  6.         strText = .responsetext
  7.         Debug.Print "最新开奖期数:"; Left(Split(strText, "<p class=""p"">")(1), 12)
  8.         Debug.Print "最新开奖时间:"; Left(Split(strText, "<p class=""t"">")(1), 5)
  9.     End With
  10. End Sub
复制代码
运行后,不要关闭该excel,过10分钟再运行,仍然出现之前的结果,数据没有更新。但网页上已有更新。

这种现象是因为xmlhttp调用了缓存的数据。

这个缓存不是指浏览器的缓存,而是excel的缓存。不信你清除浏览器的缓存试试,代码结果仍然不会更新。

这个缓存随excel的进程结束而消失。

所以我们在网抓的调试中,为了验证一段代码能否真正获取到数据,除了清除浏览器的Cookie缓存种种,还必须关闭excel再重新打开excel后再运行代码。这时的运行结果才是代码的真正结果。

那么,除了关闭excel,有没有其他方法能避免这样的现象呢?

回答当然是“有”,而且有多种方法可以避免xmlhttp调用缓存的数据。

方法如下:

1、在URL后面添加随机参数。
   比如上述代码中,我们把Open语句改成:
   .Open "GET", "http://www.1396me.com/shishicai/?=" & Rnd(), False   然后代码就能实时更新了。

   这个方法最简单,但它未必对所有的网页适用。

2、添加setRequestHeader
   在代码的Send语句前加一句:
   .setRequestHeader "If-Modified-Since", "0"
   这句语句的具体含义请百度。在这里我们用它使代码效果实时更新。
   同样,未必对所有的网页都适用,而且效率比上种方法低下。

3、用winhttp代替xmlhttp
   winhttp不会从缓存中调取数据。
作者: blanksoul12    时间: 2014-10-23 16:24
不好意思,關於34樓的單獨拿取COOKIE那個練習,我不能單獨取出COOKIE來,請問有什麼問題呢?
作者: Sukey33    时间: 2014-10-23 16:26
必须马住!
作者: onlycxb    时间: 2014-10-23 16:39
wcymiss 发表于 2014-10-21 15:20
新手作业:
网站:http://www.pinble.com/Lottery.htm
操作:点击“各省体彩”---“江苏七星彩”,获取江 ...

新手作业
  1. Sub 江苏七星彩()
  2.     Dim objhq As New WinHttp.WinHttpRequest
  3.     Dim STxt As String, Url As String, i As Integer, j As Integer
  4.     Dim Pages As Integer, Pstr As String, arr, brr, rng As Range
  5.     Cells.Clear
  6.     With objhq
  7.         .Open "POST", "http://www.pinble.com/Template/WebService1.asmx/Present3DList", False
  8.         .SetRequestHeader "Content-Type", "application/json; charset=UTF-8"
  9.         .SetRequestHeader "Referer", "http://www.pinble.com/Lottery.htm"
  10.         .Send "{pageindex:'1',lottory:'TC7XCData_jiangS',pl3:'',name:'江苏七星彩',isgp: '0'}"
  11.         STxt = .ResponseText
  12.     End With
  13.     STxt = UTF8toChineseCharacters(STxt)                                                           'J3编码
  14.     Pages = Split(Split(Split(STxt, "分页")(1), "页")(0), "/")(1)

  15.     '循环各页取数,下面以取2页为例 ,实际总页数Pages
  16.     For i = 1 To 2
  17.         With objhq
  18.             .Open "POST", "http://www.pinble.com/Template/WebService1.asmx/Present3DList", False
  19.             .SetRequestHeader "Content-Type", "application/json; charset=UTF-8"
  20.             .SetRequestHeader "Referer", "http://www.pinble.com/Lottery.htm"
  21.             .Send "{pageindex:'" & i & "',lottory:'TC7XCData_jiangS',pl3:'',name:'江苏七星彩',isgp: '0'}"
  22.             STxt = UTF8toChineseCharacters(.ResponseText)
  23.         End With

  24.         Cells(1, 1) = "江苏七星彩 开奖信息": Cells(1, 2) = "开奖周期:周二、周四、周五、周日"
  25.         Cells(2, 1).Resize(1, 3) = Array("开奖时间", "期号", "开奖号码")
  26.         Pstr = "<tr style='backgro%und-color: White; border-color: #B6CBE8;'>"
  27.         arr = Split(STxt, Pstr)
  28.         ReDim brr(1 To UBound(arr) - 1, 1 To 3)
  29.         For j = 1 To UBound(arr) - 1
  30.             brr(j, 1) = Split(Split(arr(j), "</td>")(0), ">")(1)
  31.             brr(j, 2) = Split(Split(arr(j), "</td>")(1), ">")(1)
  32.             brr(j, 3) = Split(Split(Split(arr(j), "</td>")(2), "</span>")(0), "ctl02_lblHao'>")(1)
  33.         Next j
  34.         Set rng = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
  35.         rng.Resize(UBound(brr, 1), 3) = brr
  36.     Next i
  37.     Columns("A:A").NumberFormatLocal = "yyyy-m-d"
  38.     Columns("B:C").NumberFormatLocal = "@"
  39.     Columns("A:C").EntireColumn.AutoFit
  40. End Sub
  41. Function UTF8toChineseCharacters(szInput)
  42.     With CreateObject("MSScriptControl.ScriptControl")
  43.     .Language = "JavaScript"
  44.     .AddCode "function decode(str){return unescape(str.replace(/\u/g,'%u'));}"
  45.     UTF8toChineseCharacters = .Eval("decode('" & szInput & "')")
  46.     End With
  47. End Function
复制代码

补充内容 (2014-11-1 17:50):
\u是J3
作者: onlycxb    时间: 2014-10-23 16:44
wcymiss 发表于 2014-10-21 15:20
新手作业:
网站:http://www.pinble.com/Lottery.htm
操作:点击“各省体彩”---“江苏七星彩”,获取江 ...

新手作业
  1. Sub 江苏七星彩()
  2.     Dim objhq As New WinHttp.WinHttpRequest
  3.     Dim STxt As String, Url As String, i As Integer, j As Integer
  4.     Dim Pages As Integer, Pstr As String, arr, brr, rng As Range
  5.     Cells.Clear
  6.     With objhq
  7.         .Open "POST", "http://www.pinble.com/Template/WebService1.asmx/Present3DList", False
  8.         .SetRequestHeader "Content-Type", "application/json; charset=UTF-8"
  9.         .SetRequestHeader "Referer", "http://www.pinble.com/Lottery.htm"
  10.         .Send "{pageindex:'1',lottory:'TC7XCData_jiangS',pl3:'',name:'江苏七星彩',isgp: '0'}"
  11.         STxt = .ResponseText
  12.     End With
  13.     STxt = UTF8toChineseCharacters(STxt)                                                           'J3编码
  14.     Pages = Split(Split(Split(STxt, "分页")(1), "页")(0), "/")(1)

  15.     '循环各页取数,下面以取2页为例 ,实际总页数Pages
  16.     For i = 1 To 2
  17.         With objhq
  18.             .Open "POST", "http://www.pinble.com/Template/WebService1.asmx/Present3DList", False
  19.             .SetRequestHeader "Content-Type", "application/json; charset=UTF-8"
  20.             .SetRequestHeader "Referer", "http://www.pinble.com/Lottery.htm"
  21.             .Send "{pageindex:'" & i & "',lottory:'TC7XCData_jiangS',pl3:'',name:'江苏七星彩',isgp: '0'}"
  22.             STxt = UTF8toChineseCharacters(.ResponseText)
  23.         End With

  24.         Cells(1, 1) = "江苏七星彩 开奖信息": Cells(1, 2) = "开奖周期:周二、周四、周五、周日"
  25.         Cells(2, 1).Resize(1, 3) = Array("开奖时间", "期号", "开奖号码")
  26.         Pstr = "<tr style='backgro%und-color: White; border-color: #B6CBE8;'>"
  27.         arr = Split(STxt, Pstr)
  28.         ReDim brr(1 To UBound(arr) - 1, 1 To 3)
  29.         For j = 1 To UBound(arr) - 1
  30.             brr(j, 1) = Split(Split(arr(j), "</td>")(0), ">")(1)
  31.             brr(j, 2) = Split(Split(arr(j), "</td>")(1), ">")(1)
  32.             brr(j, 3) = Split(Split(Split(arr(j), "</td>")(2), "</span>")(0), "ctl02_lblHao'>")(1)
  33.         Next j
  34.         Set rng = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
  35.         rng.Resize(UBound(brr, 1), 3) = brr
  36.     Next i
  37.     Columns("A:A").NumberFormatLocal = "yyyy-m-d"
  38.     Columns("B:C").NumberFormatLocal = "@"
  39.     Columns("A:C").EntireColumn.AutoFit
  40. End Sub
  41. Function UTF8toChineseCharacters(szInput)
  42.     With CreateObject("MSScriptControl.ScriptControl")
  43.     .Language = "JavaScript"
  44.     .AddCode "function decode(str){return unescape(str.replace(/\u/g,'%u'));}"
  45.     UTF8toChineseCharacters = .Eval("decode('" & szInput & "')")
  46.     End With
  47. End Function
复制代码

作者: onlycxb    时间: 2014-10-23 16:46
这讲课速度也太快了。
作者: renahu    时间: 2014-10-23 16:59
VBA万岁 发表于 2014-10-22 12:33
ie法完成作业1:
Sub 今日在售银行产品()
'On Error Resume Next

这个怎么提示“445”错误,说对象不支持该动作
作者: VBA万岁    时间: 2014-10-23 17:22
renahu 发表于 2014-10-23 16:59
这个怎么提示“445”错误,说对象不支持该动作

将'On Error Resume Next
前面的逗号去掉看看。
作者: VBA万岁    时间: 2014-10-23 17:24
wcymiss 发表于 2014-10-23 16:12
缓存的困扰
用xmlhttp对象GET数据时,会优先从缓存中调取。

明天继续学习......
作者: blanksoul12    时间: 2014-10-23 17:49
blanksoul12 发表于 2014-10-23 16:24
不好意思,關於34樓的單獨拿取COOKIE那個練習,我不能單獨取出COOKIE來,請問有什麼問題呢?


在34樓第三點時,運行到 Debug.Print strText 這句後看即時窗時,只發現
Date: Thu, 23 Oct 2014 09:41:30 GMT
Transfer-Encoding: chunked
Content-Type: text/html;charset=UTF-8
Server: Apache-Coyote/1.1
所以到之後這句 strCookie = Split(Split(strText, "JSESSIONID=")(1), ";")(0) 時便出現 ERROR 了




欢迎光临 ExcelHome技术论坛 (https://club.excelhome.net/) Powered by Discuz! X3.4