前提

我正在尝试抓取这个网站。

如果您在搜索栏中输入组织 ID,然后按“Искать”,它会将您重定向到一个单独的页面,该页面的基本 URL 为https://pb.nalog.ru/search.html,哈希值为“#t=*&mode=search-all&queryAll=ID”,其中 t 是当前毫秒数(从 开始Date.gettime()

问题

如果我使用宏生成的 url 并手动将其放入浏览器中,它会返回正确的页面,但每当我尝试以编程方式执行此操作时,它都会返回404 页面未找到 网站虚拟;而且,它返回的 url 与我的不同:

  • 我得到的
  • 一个网站收到了

/search.html#t=1730356470622&mode=search-all&queryAll=9714055795

假设# 是 # 的转换,但我对此很陌生,不能肯定地说。我会尝试回答所有后续问题。

以下是有问题的代码:

Option Explicit

Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

Private Declare PtrSafe Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)

Function CurrentTimeMillis() As Double
    ' Returns the milliseconds from 1970/01/01 00:00:00.0 to system UTC
    Dim st As SYSTEMTIME
    GetSystemTime st
    Dim t_Start, t_Now
    t_Start = DateSerial(1970, 1, 1) ' Starting time for Linux
    t_Now = DateSerial(st.wYear, st.wMonth, st.wDay) + _
        TimeSerial(st.wHour, st.wMinute, st.wSecond)
    CurrentTimeMillis = DateDiff("s", t_Start, t_Now) * 1000 + st.wMilliseconds
End Function

Public Sub oopsie_doopsie()

    Dim http As New XMLHTTP60
    Dim html As New HTMLDocument
    Dim curr As Double
    
    curr = CurrentTimeMillis(): Debug.Print curr
    With http
        .Open "GET", "https://pb.nalog.ru/search.html#t=" & curr & "&mode=search-all&queryAll=" & "9714055795" & "", False
        Debug.Print "https://pb.nalog.ru/search.html#t=" & curr & "&mode=search-all&queryAll=" & "9714055795" & ""
        DoEvents
        .send
        DoEvents
        html.body.innerHTML = .responseText
    End With
    
    html.getElementsByClassName ("pb-subject-status pb-subject-status--active")
    
End Sub

1

  • 1
    例如,Chrome 通过按 F12 提供开发工具。我按照研究了请求标头。


    – 



最佳答案
2

据我所知,URL 上的页面不是静态的,pb-subject-status pb-subject-status--active即使您使用原始代码成功完成请求,该元素也不会可见。

另一方面,我认为有些元素正在从某些JSON来源得到填补。

我的语言不是俄语,因此我不明白下面试用代码中收到的响应。此代码将获取一些JSON数据并将其写入单元格中A1

只需检查数据,看看所需数据是否在文本中的某个地方。如果你在那里找到了数据,那么你可以用

Sub Test()
    Dim objHTTP As Object, strURL As String, PayLoad As String, requestID As String, strJSON As String
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP.6.0")
    
    strURL = "https://pb.nalog.ru/search-proc.json"
    
    PayLoad = "mode=search-all&queryAll=9714055795&queryUl=&okvedUl=&regionUl=&statusUl=&isMspUl=&mspUl1=1&mspUl2=1&mspUl3=1&queryIp=&okvedIp=&regionIp=&statusIp=&isMspIp=&mspIp1=1&mspIp2=1&mspIp3=1&taxIp=&queryUpr=&uprType1=1&uprType0=1&queryRdl=&dateRdl=&queryAddr=&regionAddr=&queryOgr=&ogrFl=1&ogrUl=1&ogrnUlDoc=&ogrnIpDoc=&npTypeDoc=1&nameUlDoc=&nameIpDoc=&formUlDoc=&formIpDoc=&ifnsDoc=&dateFromDoc=&dateToDoc=&page=1&pageSize=10&pbCaptchaToken=&token="
       
    objHTTP.Open "POST", strURL, False
    objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    objHTTP.send PayLoad
    
    strJSON = objHTTP.responseText
    requestID = Split(Split(strJSON, """id"":""")(1), """")(0)
        
    PayLoad = "id=" & requestID & "&method=get-response"
    
    strURL = "https://pb.nalog.ru/search-proc.json"
    objHTTP.Open "POST", strURL, False
    objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    objHTTP.send PayLoad
    
    strJSON = objHTTP.responseText
    
    Range("A1") = strJSON
    
    Set objHTTP = Nothing
End Sub

。页面截图添加如下:

7

  • 太棒了!你是怎么找到方法的?


    – 

  • 2
    我从控制台检查了源代码和网络流量。


    – 

  • 哇。您发现了一种内部 API。


    – 

  • 它返回 null,这可能是什么问题?PS:经过第三次尝试,它现在似乎可以正常工作了,我仍然无法理解您是如何做到的,但无论如何我都会接受它


    – 


  • 1
    @rotabor 和 AntiDrondert 谢谢你们的赞美。我只用了浏览器开发工具……


    – 

我猜您需要使用 XMLHTTP60.setRequestHeader 来创建服务器接受的标头:

    With http
        .Open "GET", "https://pb.nalog.ru/search.html#t=" & curr & "&mode=search-all&queryAll=" & "9714055795" & "", False
        .setRequestHeader bstrHeader, bstrValue
    ... 

使用 Postman 之类的工具来研究任何浏览器发送的标头。

我猜测服务器需要一些元信息来呈现与客户端浏览器相关的页面,例如。