VBA网抓 RAS加密后连接

筱悠

各位EH大神好！ 鄙人在用excel抓取一个网站数据时，遇到个问题无法解决，QQ群里有大神提示，但鄙人资质愚钝做不出来，请大神帮忙看看 http://www.lzfc.com.cn:8080/LFGI ... 1_FCFA_AF6F8F530B2F  抓取这个网站点击左侧楼号列蓝色数字后的连接  如这里点后为 http://www.lzfc.com.cn:8080/LFGI ... cfd8e51eb7a4482aee0  请诸位大神赐教，在此先行谢过！

liucqa

buildingCode = encryptedString(bodyRSA(), encodeURIComponent(buildingCode));       
调用一下这个函数

筱悠

谢谢大神，但是我不知道怎么调用，传递哪个参数

kldxlb

我这个你分析了大半个小时，你说你咋感谢我吧

1. Sub test()
   
2.     With CreateObject("WinHttp.WinHttpRequest.5.1")
   
3.         .Open "GET", "http://www.lzfc.com.cn:8080/LFGIS/servlet/QueryBuild?BaseCode=6E85E23B_F775_E551_FCFA_AF6F8F530B2F", False
   
4.         .Send
   
5.         s = ByteToStr(.ResponseBody, "GBK")
   
6.         buildingCode = Split(Split(s, "onclick=comInfoView('")(1), "'")(0)
   
7.         .Open "GET", "http://www.lzfc.com.cn:8080/LFGIS/Loupanbiao/LoupanbiaoJs/rsa/RSA.js", False
   
8.         .Send
   
9.         s = ByteToStr(.ResponseBody, "GBK")
   
10.         .Open "GET", "http://www.lzfc.com.cn:8080/LFGIS/Loupanbiao/LoupanbiaoJs/rsa/Barrett.js", False
    
11.         .Send
    
12.         s = s & ByteToStr(.ResponseBody, "GBK")
    
13.         .Open "GET", "http://www.lzfc.com.cn:8080/LFGIS/Loupanbiao/LoupanbiaoJs/rsa/BigInt.js", False
    
14.         .Send
    
15.         s = s & ByteToStr(.ResponseBody, "GBK")
    
16.         With CreateObject("msscriptcontrol.scriptcontrol")
    
17.             .Language = "javascript"
    
18.             buildingCode = .Eval(s & "var ss = encryptedString(bodyRSA(), encodeURIComponent('" & buildingCode & "'));ss")
    
19.         End With
    
20.         url = "http://www.lzfc.com.cn:8080/LFGIS/buildingTb/buildingInfoShow.action?buildingCode=" & buildingCode
    
21.         MsgBox url
    
22.     End With
    
23. End Sub
    
24. 
    
25. Function ByteToStr(arrByte, strCharset As String) As String
    
26.     '二进制数据转字符
    
27.     With CreateObject("Adodb.Stream")
    
28.         .Type = 1 'adTypeBinary
    
29.         .Open
    
30.         .Write arrByte
    
31.         .Position = 0
    
32.         .Type = 2 'adTypeText
    
33.         .charset = strCharset
    
34.         ByteToStr = .Readtext
    
35.         .Close
    
36.     End With
    
37. End Function

复制代码

liu-aguang

筱悠 发表于 2017-3-30 15:23
谢谢大神，但是我不知道怎么调用，传递哪个参数

1. Sub URL重写()
   
2.     Dim oDom As Object, oWin As Object, oHttp As Object, URL As String
   
3.     URL = "http://www.lzfc.com.cn:8080/LFGIS/servlet/QueryBuild?BaseCode=6E85E23B_F775_E551_FCFA_AF6F8F530B2F"
   
4.     Set oDom = CreateObject("htmlfile")
   
5.     Set oWin = oDom.parentWindow
   
6.     Set oHttp = CreateObject("MSXML2.XMLHTTP")
   
7.     httpRequest oHttp, "http://www.lzfc.com.cn:8080/LFGIS/Loupanbiao/LoupanbiaoJs/rsa/RSA.js"
   
8.     httpRequest oHttp, "http://www.lzfc.com.cn:8080/LFGIS/Loupanbiao/LoupanbiaoJs/rsa/BigInt.js"
   
9.     httpRequest oHttp, "http://www.lzfc.com.cn:8080/LFGIS/Loupanbiao/LoupanbiaoJs/rsa/Barrett.js"
   
10.     resText = httpRequest(oHttp, URL)
    
11.     buildingCode = Split(Split(resText, "comInfoView('")(1), "'")(0)
    
12.     oDom.Write "<script src='http://www.lzfc.com.cn:8080/LFGIS/Loupanbiao/LoupanbiaoJs/rsa/RSA.js'></script>" & _
    
13.             "<script src='http://www.lzfc.com.cn:8080/LFGIS/Loupanbiao/LoupanbiaoJs/rsa/BigInt.js'></script>" & _
    
14.             "<script src='http://www.lzfc.com.cn:8080/LFGIS/Loupanbiao/LoupanbiaoJs/rsa/Barrett.js'></script>"
    
15.     buildingCode = oWin.eval("encryptedString(bodyRSA(), encodeURIComponent('" & buildingCode & "'))")
    
16.     URL = "http://www.lzfc.com.cn:8080/LFGIS/buildingTb/buildingInfoShow.action?buildingCode=" & buildingCode
    
17.     resText = httpRequest(oHttp, URL)
    
18.     '........................
    
19. End Sub
    
20. Function httpRequest(o As Object, sURL As String) As String
    
21.     o.Open "GET", sURL, False
    
22.     o.send
    
23.     httpRequest = o.responseText
    
24. End Function
    

复制代码

筱悠

谢谢两位大神  你们简直厉害的不要不要的！！！！

kldxlb

liu-aguang 发表于 2017-3-30 18:38

请问大神，您第7、8、9行三个httpRequest有什么用吗？我把它注释掉好像也能得到返回结果啊。没用过htmlfile对象，还请求指点

liu-aguang

kldxlb 发表于 2017-3-31 10:09
请问大神，您第7、8、9行三个httpRequest有什么用吗？我把它注释掉好像也能得到返回结果啊。没用过htmlfi ...

实际上用你的方法把几个js文本读出来,再用eval解析,更为简单.
12,13,14三行其中一个功能就有7/8/9的作用:把三个js文件下载到临时目录中,所以不要7/8/9也可运行. 但12/13/14运行工作有时还没有结束,vba就开始执行后续代码从而会出错. 这里7/8/9行作用是保证js下载完成.当然如果你已经执行过一次该代码或事先用浏览器打开过该网页,那么js文件已经在临时目录中,也可不要7/8/9三行.
用文档对象的父窗口对象执行javascript代码的优点是,它在64位的Excel中也能正常运行.
优化后代码:

1. Sub test()
   
2.     Dim oHttp As Object
   
3.     Set oHttp = CreateObject("MSXML2.XMLHTTP")
   
4.     resText = httpRequest(oHttp, "http://www.lzfc.com.cn:8080/LFGIS/servlet/QueryBuild?BaseCode=6E85E23B_F775_E551_FCFA_AF6F8F530B2F")
   
5.     buildingCode = Split(Split(resText, "onclick=comInfoView('")(1), "'")(0)
   
6.     resText = httpRequest(oHttp, "http://www.lzfc.com.cn:8080/LFGIS/Loupanbiao/LoupanbiaoJs/rsa/RSA.js")
   
7.     resText = resText & httpRequest(oHttp, "http://www.lzfc.com.cn:8080/LFGIS/Loupanbiao/LoupanbiaoJs/rsa/BigInt.js")
   
8.     resText = resText & httpRequest(oHttp, "http://www.lzfc.com.cn:8080/LFGIS/Loupanbiao/LoupanbiaoJs/rsa/Barrett.js")
   
9.     Set oDom = CreateObject("htmlfile")
   
10.     Set oWin = oDom.parentWindow
    
11.     oWin.execScript
    
12.     buildingCode = oWin.eval(resText & "encryptedString(bodyRSA(), encodeURIComponent('" & buildingCode & "'))")
    
13.     URL = "http://www.lzfc.com.cn:8080/LFGIS/buildingTb/buildingInfoShow.action?buildingCode=" & buildingCode
    
14.     MsgBox URL
    
15. End Sub
    
16. Function httpRequest(o As Object, sURL As String) As String
    
17.     o.Open "GET", sURL, False
    
18.     o.Send
    
19.     httpRequest = o.responseText
    
20. End Function
    

复制代码

lqh123109

buildingCode = Split(Split(s, "onclick=comInfoView('")(1), "'")(0)  
这个提取什么？一段JS代码？ 能否buildingCode =s？
另外，我修改后执行我的代码，在这句提示缺少标识符buildingCode = oWin.eval(resText & "encryptedString(bodyRSA(), encodeURIComponent('" & buildingCode & "'))")

lqh123109

buildingCode = .Eval(s
执行到这里总是提示错误，是不是下载JS如果本来有语法错误，如带有CLASS WINDOW字样，会导致解析错误，那么有没有办法忽略JS错误呢？