尝试将 URL Json 导入到 Excel 时出错
Error when try to import URL Json to Excel
我正在尝试通过 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.
代码工作正常
XHR:
我相信该页面已采取机器人程序预防措施，如果它怀疑您是机器人程序，则会提出挑战，要求 javascript 到 运行。如果 运行 成功发出 XHR 请求，其中包含来自 headers 中挑战的信息，并且如果您使用的是浏览器，将导致您的内容被正确更新以显示预期值。
我第一次 运行 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 通过我不确定（没有仔细观察）。
您也可以尝试浏览器自动化，例如通过 Microsoft Internet Controls 的 IE 或通过 Selenium Basic 的 Chrome/FF 等，看看让页面上的 javascript 运行 是否可以解决这个问题。
处理挑战：（WIP）
我开始考虑尝试处理这个问题。目前，我不断收到 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 控件的标准 IE 自动化导致 SaveAs/Open 对话框提示。
使用 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。从 link 添加 .bas 后，您需要转到 VBE > 工具 > 参考 > 添加对 Microsoft 脚本运行时的参考。
我正在尝试通过 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.
代码工作正常XHR:
我相信该页面已采取机器人程序预防措施，如果它怀疑您是机器人程序，则会提出挑战，要求 javascript 到 运行。如果 运行 成功发出 XHR 请求，其中包含来自 headers 中挑战的信息，并且如果您使用的是浏览器，将导致您的内容被正确更新以显示预期值。
我第一次 运行 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 通过我不确定（没有仔细观察）。
您也可以尝试浏览器自动化，例如通过 Microsoft Internet Controls 的 IE 或通过 Selenium Basic 的 Chrome/FF 等，看看让页面上的 javascript 运行 是否可以解决这个问题。
处理挑战：（WIP）
我开始考虑尝试处理这个问题。目前，我不断收到 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 控件的标准 IE 自动化导致 SaveAs/Open 对话框提示。
使用 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。从 link 添加 .bas 后，您需要转到 VBE > 工具 > 参考 > 添加对 Microsoft 脚本运行时的参考。