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:
@@ -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
|
||||
|
||||
If http.Status = 200 Then
|
||||
' ResponseBody -> ADODB.Stream for reliable UTF-8 decoding
|
||||
Dim bodyBytes() As Byte
|
||||
bodyBytes = http.responseBody
|
||||
|
||||
' Read file as UTF-8 (for Russian text)
|
||||
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"
|
||||
.Open
|
||||
.LoadFromFile tempFile
|
||||
FetchWithCurl = .ReadText
|
||||
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
|
||||
|
||||
' ===========================================================================
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user