diff --git a/MarathonStats.bas b/MarathonStats.bas index ed327e4..8adc7ec 100644 --- a/MarathonStats.bas +++ b/MarathonStats.bas @@ -8,7 +8,7 @@ Attribute VB_Name = "MarathonStats" ' URL: https://www.marathonbet.by/su/live/45356 ' Usage: Run macro "FetchMarathonStats" from Excel (Alt+F8) ' -' Fetch method: curl.exe (handles gzip and bypasses server restrictions) +' Fetch method: MSXML2.XMLHTTP (primary) / WinHttp (fallback) ' Parse method: InStr-based HTML parsing targeting Marathon's DOM markers '========================================================================== Option Explicit @@ -62,18 +62,18 @@ Public Sub FetchMarathonStats() Dim ws As Worksheet Set ws = SetupSheet() - ' --- Fetch HTML via curl --- - Application.StatusBar = "Fetching page with curl..." + ' --- Fetch HTML via COM HTTP --- + Application.StatusBar = "Fetching page..." Dim html As String - html = FetchWithCurl() + html = FetchPage(PAGE_URL) If Len(html) < 200 Then ws.Range("A" & DATA_START_ROW).Value = _ - "Failed to fetch page. Ensure curl.exe is available and internet is connected." + "Failed to fetch page. Check internet connection." ws.Range("A" & DATA_START_ROW).Font.Italic = True Application.StatusBar = False MsgBox "Could not retrieve page content." & vbCrLf & _ - "Verify curl.exe is in PATH and network is available.", _ + "Verify network is available.", _ vbCritical, "Fetch Error" GoTo Done End If @@ -114,54 +114,94 @@ Done: End Sub ' =========================================================================== -' FETCH: Use curl.exe to download page HTML +' FETCH: Try multiple COM HTTP methods ' =========================================================================== -Private Function FetchWithCurl() As String - On Error GoTo CurlFail +Private Function FetchPage(url As String) As String + ' Method 1: MSXML2.XMLHTTP.6.0 (auto-decompresses gzip) + FetchPage = FetchWithXMLHTTP(url) + If Len(FetchPage) > 200 Then Exit Function - Dim tempFile As String - tempFile = Environ("TEMP") & "\marathon_live_page.html" + ' Method 2: WinHttp with identity encoding (no gzip) + FetchPage = FetchWithWinHTTP(url) +End Function - ' Build curl command with browser-like headers - Dim cmd As String - cmd = "cmd /c curl.exe -s -L -k --compressed --max-time 20 " & _ - "-H ""User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64) " & _ - "AppleWebKit/537.36 (KHTML, like Gecko) Chrome/120.0.0.0 Safari/537.36"" " & _ - "-H ""Accept-Language: ru-RU,ru;q=0.9"" " & _ - "-H ""Accept: text/html,application/xhtml+xml"" " & _ - """" & PAGE_URL & """ > """ & tempFile & """" +' --- Primary: MSXML2.XMLHTTP.6.0 --- +Private Function FetchWithXMLHTTP(url As String) As String + On Error GoTo Fail - ' Execute synchronously - Dim wsh As Object - Set wsh = CreateObject("WScript.Shell") - wsh.Run cmd, 0, True ' 0=hidden, True=wait + Dim http As Object + Set http = CreateObject("MSXML2.XMLHTTP.6.0") - ' Verify file exists and has content - Dim fso As Object - Set fso = CreateObject("Scripting.FileSystemObject") - If Not fso.FileExists(tempFile) Then GoTo CurlFail - If fso.GetFile(tempFile).Size < 100 Then GoTo CurlFail + http.Open "GET", url, False + http.setRequestHeader "User-Agent", _ + "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 " & _ + "(KHTML, like Gecko) Chrome/120.0.0.0 Safari/537.36" + http.setRequestHeader "Accept-Language", "ru-RU,ru;q=0.9" + http.setRequestHeader "Accept", "text/html,application/xhtml+xml" + http.Send - ' Read file as UTF-8 (for Russian text) - Dim stream As Object - Set stream = CreateObject("ADODB.Stream") - With stream - .Type = 2 ' text - .Charset = "UTF-8" - .Open - .LoadFromFile tempFile - FetchWithCurl = .ReadText - .Close - End With + If http.Status = 200 Then + ' ResponseBody -> ADODB.Stream for reliable UTF-8 decoding + Dim bodyBytes() As Byte + bodyBytes = http.responseBody + + Dim stream As Object + Set stream = CreateObject("ADODB.Stream") + With stream + .Type = 1 ' binary + .Open + .Write bodyBytes + .Position = 0 + .Type = 2 ' text + .Charset = "UTF-8" + FetchWithXMLHTTP = .ReadText + .Close + End With + End If - ' Clean up temp file - On Error Resume Next - fso.DeleteFile tempFile - On Error GoTo 0 Exit Function +Fail: + FetchWithXMLHTTP = "" +End Function -CurlFail: - FetchWithCurl = "" +' --- Fallback: WinHttp.WinHttpRequest.5.1 with identity encoding --- +Private Function FetchWithWinHTTP(url As String) As String + On Error GoTo Fail + + Dim http As Object + Set http = CreateObject("WinHttp.WinHttpRequest.5.1") + + http.Open "GET", url, False + http.setRequestHeader "User-Agent", _ + "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 " & _ + "(KHTML, like Gecko) Chrome/120.0.0.0 Safari/537.36" + http.setRequestHeader "Accept-Language", "ru-RU,ru;q=0.9" + http.setRequestHeader "Accept", "text/html,application/xhtml+xml" + http.setRequestHeader "Accept-Encoding", "identity" + http.Send + + If http.Status = 200 Then + ' ResponseBody -> ADODB.Stream for reliable UTF-8 decoding + Dim bodyBytes() As Byte + bodyBytes = http.responseBody + + Dim stream As Object + Set stream = CreateObject("ADODB.Stream") + With stream + .Type = 1 ' binary + .Open + .Write bodyBytes + .Position = 0 + .Type = 2 ' text + .Charset = "UTF-8" + FetchWithWinHTTP = .ReadText + .Close + End With + End If + + Exit Function +Fail: + FetchWithWinHTTP = "" End Function ' =========================================================================== diff --git a/MarathonStats.xlsm b/MarathonStats.xlsm index ca47522..c94b466 100644 Binary files a/MarathonStats.xlsm and b/MarathonStats.xlsm differ