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
' 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
' ===========================================================================