在VBA中通过代理下载文件

时间:2020-04-19 12:16:57

标签: vba proxy download xmlhttprequest

我有指向文件的URL链接数组。这些文件只能通过代理连接进行下载。我在循环中使用以下功能来做到这一点(以及获取网页的HTTP代码以获取文件数组):

Public Function GetRequest(ByVal UrlStr As String, Optional ByVal ProxyStr As Boolean, Optional SaveFilePath As String) As Object
dim XMLHTTP         As Object
Dim oStream         As Object
Dim xmlDoc          As New HTMLDocument
Dim ret             As String
On Error GoTo 0

k= 0
0:
Set XMLHTTP = Nothing
Set XMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")

'here there was a cycle to get working proxy, I threw it off when paste code to the forum
'the result of cycle was ProxyString, e.g. "165.227.23.166:8080"

XMLHTTP.setProxy 1, ProxyString
'the function is working in 2 modes:
' mode 1 (SaveFilePath="") - to get http code of the web page (also via proxy) - no problems with that part
' mode 2 (SaveFilePath<>"") - to download file from UrlStr to SaveFilePath
With XMLHTTP
    If SaveFilePath = "" Then
'------------ here is mode 1, no problems ---------------------------------
        .Open "GET", UrlStr, True
        .setRequestHeader "Content-Type", "text/html; charset=utf-8"
        .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
        If ProxyStr Then .setRequestHeader "Proxy-Connection", "Keep-Alive"
'---------------------------------------------------------------------------
    Else
        .Open "GET", UrlStr, True
' the following 2 strings (requestheaders) have no changes on error 
'        .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
'        If ProxyStr Then .setRequestHeader "Proxy-Connection", "Keep-Alive"
    End If
    .send

'after .send method I've got either different errors (is request is sync),
'or constantly .readystate=1 (if request is asynchronous)

Time1 = Now
Do Until .readyState = 4
    Application.Wait (Now() + 2 / 24 / 60 / 60) 'wait for 2 sec and check again
    DoEvents
    If Now - Time1 > 10 / 24 / 60 / 60 Then     'wait for 10 sec, abort request and try all code again - not all proxies can get access to webpage
        .abort
        GoTo 0
    End If
Loop


If .Status = 200 Then
    If SaveFilePath <> "" Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write .responseBody
        oStream.SaveToFile SaveFilePath, adSaveCreateOverWrite
        oStream.Close
        Set xmlDoc = Nothing
    Else
        xmlDoc.body.innerHTML = .responseText
    End If
Else
    GoTo 0
End If
End With
Set GetRequest = xmlDoc
End Function

我也试图关闭防火墙,但没有成功。 具有同步请求的.send方法中的错误是: 运行时错误-2147012739:“安全通道支持中发生错误”。调试并尝试再次运行此步骤后,我得到了类似“在send方法调用后无法调用此方法”的信息(在.send方法上)。

文件数组包含指向mp3的链接,例如: https://some_very_long_url/092f57537047fcd24a6fcb5d3cff57f2/6004767

也许我出错了,因为url中没有文件扩展名?但是,当我将此链接粘贴到浏览器时,建议我立即保存文件。

有人知道哪里出了问题吗?也许还有其他方法可以通过代理在url上下载文件?我以前使用过URLDownloadToFile,但不能使用代理。

0 个答案:

没有答案