Replace curl.exe with native COM HTTP fetching

Use MSXML2.XMLHTTP.6.0 (primary) and WinHttp.WinHttpRequest.5.1
(fallback) instead of shelling out to curl.exe. Fetch functions now
accept a url parameter for reusability.

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
This commit is contained in:
2026-02-28 22:23:16 +03:00
parent 245fac3efc
commit e48bca907d
2 changed files with 85 additions and 45 deletions

View File

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

Binary file not shown.