不懂html也来学网抓（xmlhttp/winhttp+fiddler）

VBA万岁

VBA万岁 发表于 2014-10-24 11:18
onlycxb大侠，想请教你一个问题：
我想提取如下数据：

老师，我补齐了Referer，可还是报同样的错，不知为何？
我按你提供的地址下载安装了fiddler，抓包时界面好像同先前的一样host都省略了。
Sub 按钮1_单击()
    Dim Url, html
    Url = "http://www.pinble.com/Template/WebService1.asmx/PresentLis"

    Set html = CreateObject("htmlfile")
    With CreateObject("msxml2.xmlhttp")
        .Open "POST", Url, False
        .setRequestHeader "Content-Type", "application/json"
        .setRequestHeader "Referer", "http://www.pinble.com/Template/WebService1.asmx/PresentLis"
        .send
        html.body.innerhtml = .responseText
        Cells(1, 1) = .responseText
        Set tb = html.all.tags("table")(4).Rows
        For i = 0 To tb.Length - 1
            For j = 1 To tb(i).Cells.Length - 1
                Cells(i + 1, j) = tb(i).Cells(j).innertext
            Next
        Next
    End With
End Sub

onlycxb

VBA万岁 发表于 2014-10-24 11:18
onlycxb大侠，想请教你一个问题：
我想提取如下数据：
"Referer"

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/PresentList", False
   
8.         .SetRequestHeader "Content-Type", "application/json; charset=UTF-8"
   
9.         .SetRequestHeader "Referer", "http://www.pinble.com/Lottery.htm" '121楼， .XMLHTTP中应用 .SetRequestHeader "Referer"是无效的。这里要采取HttpRequest方式
   
10.         .Send "{type:'各省福彩'}"    '121楼，send 这里有发送的内容，一定要写上。
    
11.         STxt = .ResponseText
    
12.     End With
    
13.     Debug.Print UTF8toChineseCharacters(STxt)                                                               '这里是Java编码格式，需要转换
    
14. End Sub
    
15. Function UTF8toChineseCharacters(szInput)
    
16.     With CreateObject("MSScriptControl.ScriptControl")
    
17.     .Language = "JavaScript"
    
18.     .AddCode "function decode(str){return unescape(str.replace(/\u/g,'%u'));}"
    
19.     UTF8toChineseCharacters = .Eval("decode('" & szInput & "')")
    
20.     End With
    
21. End Function
    

复制代码

wcymiss

转码

1、有时我们获取到的数据，有很多乱码。
这是因为，Responsetext是按照UTF-8的编码格式来解析获取到的数据的，如果数据不是UTF-8编码的字符，就无法正确显示。
这时需要我们获取ResponseBody（这是源生态的没有经过任何编码的数据），然后自行对其进行解析。

比如，116楼例子的网址：http://20140507.ip138.com/ic.asp，因为字符编码是GB2312(charset=gb2312),我们直接显示ResponseText时，中文字符就显示为乱码。



转码最方便的就是利用adostream控件
转码的自定义函数参考11楼代码


2、"\uxxxx"类型的转码
17楼作业中的例子的responsetext包含了很多"\uxxxx"这样的字符，



这是一种unicode格式编码。我们需要对其还原本身的unicode字符。
jscript的unescape就是专门干这个的。

自定义转码函数：

1. Function unescape(strTobecoded As String) As String
   
2.     With CreateObject("msscriptcontrol.scriptcontrol")
   
3.         .Language = "JavaScript"
   
4.         unescape = .Eval("unescape('" & strTobecoded & "');")
   
5.     End With
   
6. End Function

复制代码

其实，jscript的eval可以直接转换"\uxxxx"

1. Function JSEval(s As String) As String
   
2.     With CreateObject("MSScriptControl.ScriptControl")
   
3.         .Language = "javascript"
   
4.         JSEval = .Eval(s)
   
5.     End With
   
6. End Function

复制代码

不管是用unescape还是直接Eval，都要注意文本的引号问题。这就好比你在excel的单元格内输入 ="excel" 不会出错，输入 =excel 就会提示出错一样。


3、HTML字符实体的转换
HTML字符实体就是诸如

1.    "

复制代码

1. &#20320；///这里应该是半角分号，但我写半角分号发帖时会直接解析为汉字

复制代码

这样的字符串。

例子我暂时还没有找到。
先上转换的自定义函数，因为没找到网页测试，如果有bug请一定告诉我。

1. Function EnCodeByHTML(strText As String)
   
2.     With CreateObject("htmlfile")
   
3.         .write strText
   
4.         EnCodeByHTML = .body.innertext
   
5.     End With
   
6. End Function

复制代码

4、如果你手头还有其他转码类型，请一定告诉我。

================================================================
有坛友问ResponseBody和ResponseText的区别，这里补充说下：
1、ResponseBody是二进制的数据，是服务器传来的没有经过任何加工的数据。在网络中，文本一般都是以utf-8编码，所以xmlhttp/winhttp对象的ResponseText是按照utf-8编码把ResponseBody转换而成，也就是：ResponseText=ByteToStr(ResponseBody,"UTF-8")
至于问“为什么ByteToStr(ResponseText,"GB2312")没有结果”，原因是：一是参数类型不对，ByteToStr的第一参数是二进制数据的Byte数组类型，ResponseText是文本类型，系统提示出错；二是，即使进行了将文本转成二进制数据的转换（如下面代码里的b7=s这样的转换），这种转换也是按照某种编码进行的，这样的二进制已经进行过一次编码加工了，你再用ByteToStr就得不到原来的字符了。

2、对于StrConv和BytetoStr有什么区别，可以测试下面的代码：

1. Sub Test()
   
2.     Const s As String = "a我"
   
3.     Dim b1() As Byte, b2() As Byte, b3() As Byte, b4() As Byte, b5() As Byte, b6() As Byte, b7() As Byte
   
4.     b1 = StrToByte(s, "GB2312")
   
5.     b2 = StrConv(s, vbFromUnicode) '系统默认
   
6.     b3 = StrConv(s, vbFromUnicode, "2052") '内地中文
   
7.     b4 = StrConv(s, vbFromUnicode, "1028") '台湾中文
   
8.     b5 = StrToByte(s, "BIG5")
   
9.     b6 = StrConv(s, vbUnicode)
   
10.     b7 = s
    
11.     Stop '查看本地窗口里以上几个变量
    
12. End Sub

复制代码

有兴趣的还可以看看asc、ascw、chr、chrw这几个函数。

liu-aguang

wcymiss 发表于 2014-10-21 11:15
目录：

一、前期准备：

俺喜欢这种条理清楚的贴子,收藏备学.

liu-aguang

wcymiss 发表于 2014-10-21 12:51
更多Fiddler的使用方法，敬请参考《Fiddler调试权威指南》一书。
电子书下载地址：http://pan.baidu.com/s ...

谢谢无私分享.

snailzlf

wcymiss 发表于 2014-10-24 14:04
转码

1、有时我们获取到的数据，有很多乱码。

老师你好 请教下 如果网页上能看到数据，但是网页源码里面该数据没有显示，这样的数据怎么抓取
因为回复里发不了图片 我贴下我的帖子http://club.excelhome.net/thread-1160614-1-1.html  老师如果有时间帮忙看下 万分感谢

ak47ok

wcymiss 发表于 2014-10-24 10:57
代理
如果服务器对同一IP有访问次数的限制，我们就要使用代理服务器了。

到代理了，http://club.excelhome.net/thread-1146118-1-1.html的我至今未得到答案。谢谢！

snailzlf

snailzlf 发表于 2014-10-24 14:22
老师你好 请教下 如果网页上能看到数据，但是网页源码里面该数据没有显示，这样的数据怎么抓取
因为回复 ...

可能是我浏览的比价快 没看到 现在马上去看  谢谢老师

VBA万岁

onlycxb 发表于 2014-10-24 13:39

多谢onlycxb大侠，经你的指点，增加了如下代码，终于通过：
.Send "{type:'各省福彩'}

另，提取七星彩数据，在你代码的基础上，用另一种方法提取如下：
Sub 江苏七星彩2()
Dim html
Dim objhq As New MSXML2.xmlhttp
Dim STxt As String, Url As String, i As Integer, j As Integer
Dim Pages As Integer, Pstr As String, arr, brr, rng As Range
Cells.Clear
With objhq
    .Open "POST", "http://www.pinble.com/Template/WebService1.asmx/Present3DList", False
    .SetRequestHeader "Content-Type", "application/json; charset=UTF-8"
    .SetRequestHeader "Referer", "http://www.pinble.com/Lottery.htm"
    .Send "{pageindex:'1',lottory:'TC7XCData_jiangS',pl3:'',name:'江苏七星彩',isgp: '0'}"
    STxt = .ResponseText
End With
STxt = UTF8toChineseCharacters(STxt)                                                           'J3编码
Pages = Split(Split(Split(STxt, "分页")(1), "页")(0), "/")(1)

'循环各页取数，下面以取2页为例 ，实际总页数Pages
Set html = CreateObject("htmlfile")
For p = 1 To 2
    With objhq
        .Open "POST", "http://www.pinble.com/Template/WebService1.asmx/Present3DList", False
        .SetRequestHeader "Content-Type", "application/json; charset=UTF-8"
        .SetRequestHeader "Referer", "http://www.pinble.com/Lottery.htm"
        .Send "{pageindex:'" & p & "',lottory:'TC7XCData_jiangS',pl3:'',name:'江苏七星彩',isgp: '0'}"
        html.body.innerhtml = UTF8toChineseCharacters(.ResponseText)

        Set tb = html.all.tags("table")(2).Rows
        For i = 0 To tb.Length - 1
            For j = 0 To tb(i).Cells.Length - 1
                Cells((p - 1) * 41 + i + 1, j + 1) = tb(i).Cells(j).innertext
            Next j
        Next i
   End With
Next p
Columns("A:A").NumberFormatLocal = "yyyy-m-d"
Columns("B:C").NumberFormatLocal = "@"
End Sub

Function UTF8toChineseCharacters(szInput)
    With CreateObject("MSScriptControl.ScriptControl")
    .Language = "JavaScript"
    .AddCode "function decode(str){return unescape(str.replace(/\u/g,'%u'));}"
    UTF8toChineseCharacters = .Eval("decode('" & szInput & "')")
    End With
End Function

VBA万岁

VBA万岁 发表于 2014-10-24 15:26
多谢onlycxb大侠，经你的指点，增加了如下代码，终于通过：
.Send "{type:'各省福彩'}

附件如下：
江苏七星彩.zip (1.94 MB, 下载次数: 458)

2014-10-24 15:39 上传

点击文件名下载附件