ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 3849|回复: 9

[求助] VBA网抓 RAS加密后连接

[复制链接]

TA的精华主题

TA的得分主题

发表于 2017-3-30 14:39 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:网页交互
各位EH大神好! 鄙人在用excel抓取一个网站数据时,遇到个问题无法解决,QQ群里有大神提示,但鄙人资质愚钝做不出来,请大神帮忙看看 http://www.lzfc.com.cn:8080/LFGI ... 1_FCFA_AF6F8F530B2F  抓取这个网站点击左侧楼号列蓝色数字后的连接  如这里点后为 http://www.lzfc.com.cn:8080/LFGI ... cfd8e51eb7a4482aee0  请诸位大神赐教,在此先行谢过!

TA的精华主题

TA的得分主题

发表于 2017-3-30 14:56 | 显示全部楼层
buildingCode = encryptedString(bodyRSA(), encodeURIComponent(buildingCode));       
调用一下这个函数

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-3-30 15:23 | 显示全部楼层
谢谢大神,但是我不知道怎么调用,传递哪个参数

TA的精华主题

TA的得分主题

发表于 2017-3-30 18:18 | 显示全部楼层
我这个你分析了大半个小时,你说你咋感谢我吧
  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. Function ByteToStr(arrByte, strCharset As String) As String
  25.     '二进制数据转字符
  26.     With CreateObject("Adodb.Stream")
  27.         .Type = 1 'adTypeBinary
  28.         .Open
  29.         .Write arrByte
  30.         .Position = 0
  31.         .Type = 2 'adTypeText
  32.         .charset = strCharset
  33.         ByteToStr = .Readtext
  34.         .Close
  35.     End With
  36. End Function
复制代码


QQ截图20170330181632.jpg

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2017-3-30 18:38 | 显示全部楼层
筱悠 发表于 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
复制代码

评分

2

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-3-31 08:55 | 显示全部楼层
谢谢两位大神  你们简直厉害的不要不要的!!!!

TA的精华主题

TA的得分主题

发表于 2017-3-31 10:09 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

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

TA的精华主题

TA的得分主题

发表于 2017-3-31 11:03 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
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
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-10-20 10:07 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
buildingCode = Split(Split(s, "onclick=comInfoView('")(1), "'")(0)  
这个提取什么?一段JS代码? 能否buildingCode =s?
另外,我修改后执行我的代码,在这句提示缺少标识符buildingCode = oWin.eval(resText & "encryptedString(bodyRSA(), encodeURIComponent('" & buildingCode & "'))")

TA的精华主题

TA的得分主题

发表于 2019-10-21 17:16 | 显示全部楼层
buildingCode = .Eval(s
执行到这里总是提示错误,是不是下载JS如果本来有语法错误,如带有CLASS WINDOW字样,会导致解析错误,那么有没有办法忽略JS错误呢?
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-28 20:18 , Processed in 0.068019 second(s), 16 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表