我正在尝试通过WinHttpRequest从以下Url导入JSON格式的信息：https://bet.hkjc.com/football/getJSON.aspx?jsontype=odds_allodds.aspx&matchid=default
Sub test()
Dim xmlhttp As Object
Dim strUrl As String: strUrl = "https://bet.hkjc.com/football/getJSON.aspx?jsontype=odds_allodds.aspx&matchid=default"
Dim objRequest As Object
Set objRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
With objRequest
.Open "GET", strUrl, False
.send
End With
Debug.Print objRequest.responseText
End Sub
但是，它只显示与Url类似的内容，但却显示了大量乱码。
我想知道如何解决这个问题。如果我使用其他Url，代码工作正常。
我相信该页面有机器人预防措施，如果它怀疑你是一个机器人，则需要javascript来运行挑战。如果成功运行，则会发出XHR请求，其中包含来自标题中的质询的信息，如果您要使用浏览器，则会导致您的内容正确更新以显示预期值。
我第一次运行GET请求时得到了预期的json响应，之后我得到了以下内容：
<HTML>
<head>
<script>
Challenge=649275;
ChallengeId=473313563;
GenericErrorMessageCookies="Cookies must be enabled in order to view this page.";
</script>
<script>
function test(var1)
{
var var_str=""+Challenge;
var var_arr=var_str.split("");
var LastDig=var_arr.reverse()[0];
var minDig=var_arr.sort()[0];
var subvar1 = (2 * (var_arr[2]))+(var_arr[1]*1);
var subvar2 = (2 * var_arr[2])+var_arr[1];
var my_pow=Math.pow(((var_arr[0]*1)+2),var_arr[1]);
var x=(var1*3+subvar1)*1;
var y=Math.cos(Math.PI*subvar2);
var answer=x*y;
answer-=my_pow*1;
answer+=(minDig*1)-(LastDig*1);
answer=answer+subvar2;
return answer;
}
</script>
<script>
client = null;
if (window.XMLHttpRequest)
{
var client=new XMLHttpRequest();
}
else
{
if (window.ActiveXObject)
{
client = new ActiveXObject('MSXML2.XMLHTTP.3.0');
};
}
if (!((!!client)&&(!!Math.pow)&&(!!Math.cos)&&(!![].sort)&&(!![].reverse)))
{
document.write("Not all needed JavaScript methods are supported.<BR>");
}
else
{
client.onreadystatechange = function()
{
if(client.readyState == 4)
{
var MyCookie=client.getResponseHeader("X-AA-Cookie-Value");
if ((MyCookie == null) || (MyCookie==""))
{
document.write(client.responseText);
return;
}
var cookieName = MyCookie.split('=')[0];
if (document.cookie.indexOf(cookieName)==-1)
{
document.write(GenericErrorMessageCookies);
return;
}
window.location.reload(true);
}
};
y=test(Challenge);
client.open("POST",window.location,true);
client.setRequestHeader('X-AA-Challenge-ID', ChallengeId);
client.setRequestHeader('X-AA-Challenge-Result',y);
client.setRequestHeader('X-AA-Challenge',Challenge);
client.setRequestHeader('Content-Type' , 'text/plain');
client.send();
}
</script>
</head>
<body>无论你是模仿javascript正在做什么，还是作为一个新的XHR传递，我都不确定（看得很近）。
你也可以尝试浏览器自动化IE通过微软互联网控制或Chrome / FF等通过Selenium Basic，看看是否让javascript在页面上运行可以解决这个问题。
我开始考虑尝试处理这个问题。目前，我一直得到json响应，所以没有完全测试底部。我希望有一分钟*我们在乎吗？如果只是因为Math.PI给3.141592653589793，而Application.PI给3.14159265358979，误差幅度
Option Explicit
Public Sub GetInfo()
Dim json As Object, s As String, re As Object, ws As Worksheet
Dim pattern1 As String, pattern2 As String, challenge As Long, challengeId As Long
Const URL As String = "https://bet.hkjc.com/football/getJSON.aspx?jsontype=odds_allodds.aspx&matchid=default"
pattern1 = "Challenge=(\d+);"
pattern2 = "ChallengeId=(\d+);"
Set re = CreateObject("vbscript.regexp")
Set ws = ThisWorkbook.Worksheets("Sheet1")
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.send
s = .responseText
On Error Resume Next
Set json = JsonConverter.ParseJson(s)
On Error GoTo 0
If Not json Is Nothing Then
Debug.Print "No challenge issued"
Debug.Print .responseText
Else
On Error GoTo errhand
challenge = GetId(re, s, pattern1)
If challenge = 999 Then Exit Sub 'should really use more unlikely value.
challengeId = GetId(re, s, pattern2)
.Open "POST", URL, False
.setRequestHeader "X-AA-Challenge-ID", challengeId
.setRequestHeader "X-AA-Challenge-Result", CLng(GetAnswer(challenge))
.setRequestHeader "X-AA-Challenge", challenge
.setRequestHeader "Content-Type", "text/plain"
.send ""
Debug.Print .Status, .responseText
If .Status = 200 Then
.Open "GET", URL, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.send
s = .responseText
Debug.Print s
End If
End If
End With
Exit Sub
errhand:
Debug.Print Err.Number, Err.Description
End Sub
Public Function GetId(ByVal re As Object, ByVal s As String, ByVal pattern As String) As Long
With re
.Global = True
.MultiLine = True
.IgnoreCase = False
.pattern = pattern
If .TEST(s) Then
GetId = .Execute(s)(0).SubMatches(0)
Else
GetId = 999 '<probably should use a more unlikely number here!
End If
End With
End Function
Public Function GetAnswer(ByVal challenge As Long) As String 'var1 'challenge
Dim var_str As String, var_arr() As Long, LastDig As Long, minDig As Long
Dim i As Long
var_str = Chr$(34) & challenge & Chr$(34)
ReDim var_arr(0 To Len(var_str) - 3)
For i = 2 To Len(var_str) - 1
var_arr(i - 2) = CLng(Mid$(var_str, i, 1))
Next i
LastDig = var_arr(UBound(var_arr))
minDig = Application.Min(var_arr)
Dim my_pow As Long, x As Long, y As Long, answer As Variant
Dim subvar1 As Long, subvar2 As String
subvar1 = 2 * Application.Small(var_arr, 3) + Application.Small(var_arr, 2)
subvar2 = CStr(2 * Application.Small(var_arr, 3)) & CStr(Application.Small(var_arr, 2))
my_pow = (minDig + 2) ^ Application.Small(var_arr, 2)
x = challenge * 3 + (subvar1 * 1)
y = Evaluate("=COS(PI()* " & CLng(subvar2) & ")")
answer = x * y
answer = answer - my_pow
answer = answer + minDig - LastDig
answer = CStr(answer) & subvar2
GetAnswer = answer
End Function
使用Microsoft Internet Controls的标准IE自动化会导致SaveAs / Open Dialog提示。
使用selenium可以避免此提示并从pre元素中获取数据。使用selenium可以让您受益于隐式等待，允许页面完成发出的任何挑战。您可以使用显式等待条件增加等待。
Option Explicit
'download selenium https://github.com/florentbr/SeleniumBasic/releases/tag/v2.0.9.0
'Ensure latest applicable driver e.g. ChromeDriver.exe in Selenium folder
'VBE > Tools > References > Add reference to selenium type library
Public Sub DownloadFile()
Dim d As WebDriver, jsonText As String
Set d = New ChromeDriver
Const URL = "https://bet.hkjc.com/football/getJSON.aspx?jsontype=odds_allodds.aspx&matchid=default"
With d
.Start "Chrome"
.get URL
jsonText = .FindElementByCss("pre").Text
Debug.Print jsonText
Stop
.Quit
End With
End Sub
注意我使用的是json parser。从该链接添加.bas后，您需要进入VBE>工具>引用>添加对Microsoft Scripting Runtime的引用。