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

zongyj

新手作业：江苏七星彩

1. Sub qxc()
   
2.     Dim xml As New XMLHTTP, str As String, nam As String, send1 As String
   
3.     Dim ar, arr, i, j, n, pag
   
4.     pag = Sheet5.Range("f1")
   
5.     send1 = "{pageindex:'"
   
6.     send1 = send1 & pag
   
7.     send1 = send1 & "',lottory:'TC7XCData_jiangS',pl3:'',name:'江苏七星彩',isgp: '0'}"
   
8.     With xml
   
9.         .Open "POST", "http://www.pinble.com/Template/WebService1.asmx/Present3DList", False
   
10.         .setRequestHeader "Content-Type", "application/json; charset=utf-8"
    
11.         .setRequestHeader "Referer", "http://www.pinble.com/Lottery.htm"
    
12.               .send send1
    
13.         str = .responseText
    
14.         Debug.Print str
    
15.     End With
    
16.     Dim reg As New RegExp
    
17.     With reg
    
18.         .Global = True
    
19.         .MultiLine = True
    
20.                 .Pattern = "20%;\\u0027\\u003e(.*?)\s*\\u.*?20%;\\u0027\\u003e(.*?)\s.*?lblHao\\u0027\\u003e(.*?)\\u"
    
21.         Set ar = .Execute(str)
    
22.         ReDim arr(0 To ar.Count - 1, 2)
    
23.         For i = 0 To ar.Count - 1
    
24.             For j = 0 To 2
    
25.                 arr(i, j) = ar.Item(i).SubMatches(j)
    
26.             Next
    
27.         Next
    
28.     End With
    
29.     Sheet5.Cells(3, 1).Resize(65533, 4).ClearContents
    
30.     n = Sheet5.Range("a65533").End(xlUp).Row
    
31.     Sheet5.Cells(n + 1, 1).Resize(ar.Count - 1, 3) = arr
    
32. End Sub

复制代码

hacker85

此文必须留名，我正在学习网抓事宜。

zongyj

zongyj 发表于 2014-12-4 10:09
新手作业：江苏七星彩

wcymiss  你很喜欢用正则啊。setRequestHeader "Referer" 对 xmlhttp是无效的。
是的，在企业信息获取时得到“您刚才访问的网页盗用了上海工商网站的页面，不能访问。
更改为：
”Dim xml As New WinHttpRequest, str As String,得到数据

zongyj

企业信息查询

1. Sub qyxx()
   
2. '在xmlhttp对象里模拟Referer是无效的。必须要用winhttp对象。
   
3.     Dim xml As New WinHttpRequest, str As String, html, tb
   
4.     Dim i, j
   
5.     With xml
   
6.         Set html = CreateObject("htmlfile")
   
7.         .Open "POST", "http://www.sgs.gov.cn/lz/etpsInfo.do?method=viewDetail", False
   
8.         .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
   
9.         .setRequestHeader "Referer", "http://www.sgs.gov.cn/lz/etpsInfo.do?method=doSearch"
   
10.         .send "etpsId=150000012002040300047"
    
11.         html.body.innerhtml = .responseText
    
12.         Sheet6.Cells(1, 1).Resize(65533, 4).ClearContents
    
13.         Set tb = html.all.tags("table")(4)
    
14.         For i = 0 To tb.Rows.Length - 1
    
15.             For j = 0 To tb.Rows(i).Cells.Length - 1
    
16.                 Sheet6.Cells(i + 1, j + 1) = tb.Rows(i).Cells(j).innertext
    
17.             Next
    
18.         Next
    
19.     End With
    
20. End Sub
    

复制代码

zongyj

工程造价模拟cookie

1. Sub gcjs()
   
2.     Dim xml As New WinHttpRequest, str As String, html, tb
   
3.     Dim ar, arr, i, j
   
4.     With xml
   
5.         .Open "GET", "http://www.gzgczj.com:8080/costRegulatory/user.do?method=changeIndex&fareaId=1 ", False
   
6.         .send
   
7.         .Open "GET", "http://www.gzgczj.com:8080/costRegulatory/project.do?method=showProjectList&isVisitor=1&f_id=11011&t1417678766110", False
   
8.         .setRequestHeader "Referer", "http://www.gzgczj.com:8080/costRegulatory/user.do?method=changeIndex&fareaId=1"
   
9.         .setRequestHeader "Content-Type", "text/html;charset=UTF-8"
   
10.         .send
    
11.          Set html = CreateObject("htmlfile")
    
12.          html.body.innerhtml = .responseText
    
13.            Sheet7.Cells(1, 1).Resize(65533, 4).ClearContents
    
14.         Set tb = html.all.tags("table")(1)
    
15.         For i = 0 To tb.Rows.Length - 2
    
16.             For j = 0 To tb.Rows(i).Cells.Length - 1
    
17.                 Sheet7.Cells(i + 1, j + 1) = tb.Rows(i).Cells(j).innertext
    
18.             Next
    
19.         Next
    
20.     End With
    
21. End Sub
    

复制代码

function2046

先顶后看！！！！！！！！！！！

zongyj

自己发布主题抓取

1. Sub mm()
   
2. 
   
3.     Dim xml As New WinHttpRequest, str As String, html, tb
   
4.     Dim i, j
   
5. 
   
6.     With xml
   
7.         .Open "GET", "http://club.excelhome.net/home.php?mod=space&do=thread&view=me ", False
   
8.         .setRequestHeader "Content-Type", "text/html; charset=gbk"
   
9.         .setRequestHeader "Referer", "http://club.excelhome.net/forum.php"
   
10.         .setRequestHeader "cookie", _
    
11.                           "5WOj_b676_auth=axxxxxxxxxxxxxxxxxxxxxxx" & _
    
12.                           ";5WOj_b676_saltkey=xxxxxxxxx"
    
13.         .send
    
14.         Set html = CreateObject("htmlfile")
    
15.         html.body.innerhtml = .responseText
    
16.         Sheet8.Cells(1, 1).Resize(65533, 4).ClearContents
    
17.         Set tb = html.all.tags("table")(2)
    
18.         For i = 0 To tb.Rows.Length - 1
    
19.             For j = 0 To tb.Rows(i).Cells.Length - 1
    
20.                 Sheet8.Cells(i + 1, j + 1) = tb.Rows(i).Cells(j).innertext
    
21.             Next
    
22.         Next
    
23.     End With
    
24. End Sub
    

复制代码

a4569874

如果仅仅是保存网页,而不需要对数据进行处理的VBA该怎么写?

bailanhong

吴姐帮我看看这个网页防盗链如何处理？http://rep.iplant.cn/protlist
Sub Main()
    Dim strText As String, i As Integer
    For i = 1 To 2
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", "http://rep.iplant.cn/protlist?page=" & "i", False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .setRequestHeader "Referer", "http://rep.iplant.cn/protlist"
        .setRequestHeader "Cookie", "Hm_lvt_b4979f700f0c20e8d06bf352ba97189c=1417692454,1417853523; Hm_lpvt_b4979f700f0c20e8d06bf352ba97189c=1417853523"
        .Send
        strText = .responsetext
        Debug.Print strText
    End With
    Debug.Print strText
    Next
End Sub

coby001

wcymiss 发表于 2014-10-28 11:50
初识登录

登录其实没那么神秘。它也就是向服务器发送的一个POST请求。

：



password竟然是明码，小小鄙视下网易。

别鄙视网易了 ~~注意看链接的协议： https
这是个加密传输协议。你之所以看到明码，是因为Fiddle替换了 加密证书。
在Fiddle之外，看到的都是密文，包括GFW。

--
以前都没仔细看内容，renahu 问多了才来看了看，顺便提醒一下~~

-