网页采集(网页抓取)教程第二课-用WinHTTP提交Post，viewstate获取和URLEncode编码方法

kevin_liu1970

代码也贴一下，省去大师们下载附件的麻烦：
Option Explicit

Private Sub CommandButton1_Click()

    Dim n As Long
    Dim yema As Integer
    Dim oDoc As Object
    Dim tt
    Dim s1 As String
    Dim s2 As String
    Dim s3 As String
    Dim s4 As String
    Dim a As String
    Dim i As Long
    Dim j As Long
    Dim p As Integer
    Dim 省份 As String
    Dim 年份 As String
    Dim 科类 As String
    Dim r As Object
        
  
    On Error Resume Next
    n = Range("c65536").End(xlUp).row
    If n > 1 Then
        Range(Cells(2, 1), Cells(n, "H")).Clear
    End If
    Range("A2:H2") = Split("专业名称，省份地区，年份，科类，学制，培养方式，计划人数，报考要求", "，")      '以全角的逗号为分隔符
   
    Set oDoc = CreateObject("htmlfile")

'首先以get方式提交，从返回页面中获取下次POST方式提交的数据取值
    With CreateObject("MSXML2.ServerXMLHTTP")
        .Open "GET", "http://zsw.bjtu.edu.cn/JHFS/Default.aspx", False
        .send
        tt = .responsetext
'返回数据放入剪切板供调试使用，其中{}内的数值为剪切板的CLSID，可以通过windows注册表获得。
        With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
            .SetText tt
            .PutInClipboard
        End With
      
        a = "__EVENTTARGET=ctl04%24sysq&__EVENTARGUMENT=&__LASTFOCUS=&"
        s1 = "__VIEWSTATE=" & EncodePostdata(Split(Split(tt, "__VIEWSTATE"" value=""")(1), """")(0))
        a = a & s1 & "&"
        s2 = "__VIEWSTATEGENERATOR=" & EncodePostdata(Split(Split(tt, "VIEWSTATEGENERATOR"" value=""")(1), """")(0))
        a = a & s2 & "&"
        s3 = "__PREVIOUSPAGE=" & EncodePostdata(Split(Split(tt, "PREVIOUSPAGE"" value=""")(1), """")(0))
        a = a & s3 & "&"
        s4 = "__EVENTVALIDATION=" & EncodePostdata(Split(Split(tt, "__EVENTVALIDATION"" value=""")(1), """")(0))
        a = a & s4 & "&"
        省份 = Range("C1").Value
        年份 = Range("E1").Value
        科类 = Range("G1").Value
        a = a & "ctl04%24sysq=" & EncodePostdata(省份) & "&"
        a = a & "ctl04%24nf=" & EncodePostdata(年份) & "&"
        a = a & "ctl04%24xkml=" & EncodePostdata(科类) & "&"
        a = a & "ctl04%24zymc=%B2%BB%CF%DE&ctl04%24pyfs=%B2%BB%CF%DE"
'构造的上述数据，在fiddler中发送后，可正常返回，但在本程序中不行，why？
'填入拟查询的条件，POST提交查询，返回的数据是首页数据（后来发现是把ctl04误写为了ct104导致的，字母l和数字1吆）
'为了测试，把抓包的数据先ctrl+V复制到剪贴板，然后放到这儿来发，看看到底如何？结果仍然是错误的请求。
'
'    Dim mydataobj As New DataObject
'    mydataobj.GetFromClipboard
'    a = mydataobj.GetText
'    Set mydataobj = Nothing
'    Debug.Print a
   
        .Open "POST", "http://zsw.bjtu.edu.cn/JHFS/Default.aspx", False
        .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .SetRequestHeader "Connection", "Keep-Alive"
        .send a
            
        With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
            .SetText a
            .PutInClipboard
        End With
        
        tt = ""
        tt = .responsetext
        With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
            .SetText tt
            .PutInClipboard
        End With
'解读返回数据，获取总页数
        yema = CInt(Left(Split(tt, " style=""color:Black;"">")(UBound(Split(tt, " style=""color:Black;"">"))), 1))
'按照分页查询的方式组织POST数据，逐页获取网站数据
        For p = 1 To yema
            a = "__EVENTTARGET=ctl04%24zsjh&" & "__EVENTARGUMENT=Page%24" & p & "&"
            s1 = "__VIEWSTATE=" & EncodePostdata(Split(Split(tt, "__VIEWSTATE"" value=""")(1), """")(0))
            a = a & s1 & "&"
            s2 = "__PREVIOUSPAGE="
            s2 = s2 & EncodePostdata(Split(Split(tt, "PREVIOUSPAGE"" value=""")(1), """")(0))
            a = a & s2 & "&"
            s3 = "__EVENTVALIDATION=" & EncodePostdata(Split(Split(tt, "__EVENTVALIDATION"" value=""")(1), """")(0))
            a = a & s3
            省份 = Range("C1").Value
            年份 = Range("E1").Value
            科类 = Range("G1").Value
            a = a & "&ctl04%24sysq=" & EncodePostdata(省份)
            a = a & "&ctl04%24nf=" & EncodePostdata(年份)
            a = a & "&ctl04%24xkml=" & EncodePostdata(科类)
            a = a & "&ctl04%24zymc=%B2%BB%CF%DE&ctl04%24pyfs=%B2%BB%CF%DE"
            n = Range("c65536").End(xlUp).row
            .Open "POST", "http://zsw.bjtu.edu.cn/JHFS/Default.aspx", False
            .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
            .SetRequestHeader "Connection", "keep-alive"
            .send a
            
        With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
            .SetText a
            .PutInClipboard
        End With
        
            tt = ""
            tt = .responsetext
        With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
            .SetText tt
            .PutInClipboard
        End With

            oDoc.body.innerHTML = .responsetext
            Set r = oDoc.getElementById("ctl04_zsjh").Rows
            For i = 1 To r.Length - 1
                For j = 0 To r(i).Cells.Length - 1
                    Cells(i + n, j + 1) = r(i).Cells(j).innerText
                Next j
            Next i
        Next p
    End With
End Sub

Private Function EncodePostdata(szInput)
    Dim i As Long
    Dim x() As Byte
    Dim szRet As String
    szRet = ""
    x = StrConv(szInput, vbFromUnicode)
    For i = LBound(x) To UBound(x)
        If x(i) >= 48 And x(i) <= 57 Or x(i) >= 65 And x(i) <= 90 Or x(i) >= 97 And x(i) <= 122 Then
            szRet = szRet & Chr(x(i))
        Else
            szRet = szRet & "%" & Hex(x(i))
        End If
    Next
    EncodePostdata = szRet
End Function

suwenkai

回91楼

1. Function URLEncodePlus(strURL)
   
2. 'ANSI编码,空格处理成+号
   
3.     Dim i
   
4.     Dim tempStr
   
5.     For i = 1 To Len(strURL)
   
6.         If Asc(Mid(strURL, i, 1)) < 0 Then
   
7.             tempStr = "%" & Right(CStr(Hex(Asc(Mid(strURL, i, 1)))), 2)
   
8.             tempStr = "%" & Left(CStr(Hex(Asc(Mid(strURL, i, 1)))), Len(CStr(Hex(Asc(Mid(strURL, i, 1))))) - 2) & tempStr
   
9.             URLEncodePlus = URLEncodePlus & tempStr
   
10.         ElseIf (Asc(Mid(strURL, i, 1)) >= 65 And Asc(Mid(strURL, i, 1)) <= 90) Or _
    
11.                  (Asc(Mid(strURL, i, 1)) >= 97 And Asc(Mid(strURL, i, 1)) <= 122) Or _
    
12.                  (Asc(Mid(strURL, i, 1)) >= 48 And Asc(Mid(strURL, i, 1)) <= 57) Then
    
13.             URLEncodePlus = URLEncodePlus & Mid(strURL, i, 1)
    
14.         Else
    
15.             tempStr = Mid(strURL, i, 1)
    
16.             Select Case tempStr
    
17.             Case ".", "-", "~", "_"                                               '如果发现网站有其他不需要编码的字符，放在这里
    
18.                 URLEncodePlus = URLEncodePlus & tempStr
    
19.             Case " "
    
20.                 URLEncodePlus = URLEncodePlus & "+"
    
21.             Case Else
    
22.                 URLEncodePlus = URLEncodePlus & "%" & Hex(Asc(tempStr))
    
23.             End Select
    
24.         End If
    
25.     Next
    
26. End Function
    
27. 
    
28. 
    
29. 
    
30. Sub 按钮1_单击()
    
31.     Dim url, html
    
32.     url = "http://zsw.bjtu.edu.cn/JHFS/Default.aspx"
    
33.     Set html = CreateObject("htmlfile")
    
34.     n = 1
    
35.     With CreateObject("msxml2.xmlhttp")
    
36.         .Open "get", url, False
    
37.         .send
    
38.         html.body.innerhtml = .responsetext
    
39.         Set tb = html.all.tags("tr")
    
40.         For i = 0 To tb.Length - 1
    
41.             If tb(i).classname = "common_title" Then
    
42.                 n = n + 1
    
43.                 For j = 0 To tb(i).Cells.Length - 1
    
44.                     Cells(n, j + 1) = tb(i).Cells(j).innertext
    
45.                 Next
    
46.             End If
    
47.         Next
    
48. 
    
49. 
    
50. 
    
51. 
    
52.         For p = 2 To 3 '只做了3页
    
53.             VIEWSTATE = URLEncodePlus(html.getElementById("__VIEWSTATE").Value)
    
54.             VIEWSTATEGENERATOR = URLEncodePlus(html.getElementById("__VIEWSTATEGENERATOR").Value)
    
55.             PREVIOUSPAGE = URLEncodePlus(html.getElementById("__PREVIOUSPAGE").Value)
    
56.             EVENTVALIDATION = URLEncodePlus(html.getElementById("__EVENTVALIDATION").Value)
    
57.             pd = "__EVENTTARGET=ctl04%24zsjh"
    
58.             pd = pd & "&__EVENTARGUMENT=Page%24" & p
    
59.             pd = pd & "&__LASTFOCUS="
    
60.             pd = pd & "&__VIEWSTATE=" & VIEWSTATE
    
61.             pd = pd & "&__VIEWSTATEGENERATOR=" & VIEWSTATEGENERATOR
    
62.             pd = pd & "&__PREVIOUSPAGE=" & PREVIOUSPAGE
    
63.             pd = pd & "&__EVENTVALIDATION=" & EVENTVALIDATION
    
64.             pd = pd & "&ctl04%24sysq=%B2%BB%CF%DE"
    
65.             pd = pd & "&ctl04%24nf=%B2%BB%CF%DE"
    
66.             pd = pd & "&ctl04%24xkml=%B2%BB%CF%DE"
    
67.             pd = pd & "&ctl04%24zymc=%B2%BB%CF%DE"
    
68.             pd = pd & "&ctl04%24pyfs=%B2%BB%CF%DE"
    
69.             .Open "POST", url, False
    
70.             .setRequestheader "Host", "zsw.bjtu.edu.cn"
    
71.             .setRequestheader "User-Agent", "Mozilla/5.0 (Windows NT 5.1; rv:32.0) Gecko/20100101 Firefox/32.0"
    
72.             .setRequestheader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
    
73.             .setRequestheader "Accept-Language", "zh-cn,zh;q=0.8,en-us;q=0.5,en;q=0.3"
    
74.             .setRequestheader "Accept-Encoding", "gzip, deflate"
    
75.             .setRequestheader "Referer", "http://zsw.bjtu.edu.cn/JHFS/Default.aspx"
    
76.             .setRequestheader "Connection", "keep-alive"
    
77.             .setRequestheader "Content-Type", "application/x-www-form-urlencoded"
    
78.             .send (pd)
    
79. 
    
80.             html.body.innerhtml = .responsetext
    
81.             Set tb = html.all.tags("tr")
    
82.             For i = 0 To tb.Length - 1
    
83.                 If tb(i).classname = "common_title" Then
    
84.                     n = n + 1
    
85.                     For j = 0 To tb(i).Cells.Length - 1
    
86.                         Cells(n, j + 1) = tb(i).Cells(j).innertext
    
87. 
    
88.                     Next
    
89.                 End If
    
90.             Next
    
91.         Next
    
92.     End With
    
93. End Sub
    
94. 
    
95. 
    
96. 
    
97. Sub 按钮2_单击()
    
98. Range("a2:h65536").ClearContents
    
99. 
    
100. End Sub
     

复制代码

kevin_liu1970

谢谢suwenkai大师的帮助。不过我将MSXML2.ServerXMLHTTP替换为MSXML2.XMLHTTP，其他的地方不用改，也能接收到正常的数据了，所以还是迷惑提取网页的几个对象到底有啥区别？

kevin_liu1970

作为一个新人，学习中有很多的知识都不清楚，会问一些比较初级的问题，请大师们不吝赐教。uwenkai大师您的代码中有很多对htmlfile对象的操作，这个能从哪儿得到帮助文件吗？

heric221

折腾了很久，还是不知如何获取在其他页（首页除外）中做POST提交的VIEWSTATE等动态参数
总是重复导入第1页的信息。

heric221

suwenkai 发表于 2014-9-16 22:17
回91楼

参照您的代码，终于知道如何获取做POST提交的viewstate等动态参数了，非常感谢！
同时谢谢kangatang的点评。

本人五笔输入

Cookie里面的参数很多，如何确定哪些是必要参数？必须传递啊啊？

VBA万岁

liucqa 发表于 2012-7-17 14:15
调用函数  Call getPostData(objWinhttp, URL) ，提取第一次POST需要的参数

2楼的代码中，EncodePostdata是转码函数吗？在哪里有？

VBA万岁

liucqa 发表于 2012-7-17 14:16
调用 getMultiPageData函数，通过Post获取首页数据和下一次做POST提交的VIEWSTATE等参数

再回首，似有所悟......
于是，Mark如附件：
网页采集(网页抓取)教程第二课.zip (1.57 MB, 下载次数: 182)

2014-12-19 12:23 上传

点击文件名下载附件

瓦琢

经典教程，拜读了！