使用VBS下载文件

27

我有一个VBS脚本,能够生成从我的网络服务器下载文件的URL。现在我需要将该文件下载到"C:\rWallpaper\wallpaper.png",URL被存储在变量"url"中。

我希望它能像Linux上的wget一样工作,只需下载并保存文件到指定位置。

6个回答

49

您可以使用XMLHTTP进行下载,并利用ADO流来写入二进制数据。

dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
dim bStrm: Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", "http://example.com/someimage.png", False
xHttp.Send

with bStrm
    .type = 1 '//binary
    .open
    .write xHttp.responseBody
    .savetofile "c:\temp\someimage.png", 2 '//overwrite
end with

这个方法很有效,对我帮助很大,但你必须指定目标名称。问题是如果你想使用服务器建议的原始文件名。 - Racky
9
.send 之后(如果服务器选择这样做),建议的文件名可以通过 hdr = xHttp.getResponseHeader("Content-Disposition") 获取 filename= 标记后的名称。请注意,翻译保持原意、通俗易懂,并且不提供额外解释。 - Alex K.
谢谢,很好用 - 我只是将它封装成一个函数,然后就万事大吉了。 - Derrick Dennis
终于!这个代码既适用于 http 又适用于 https,并且与我在 stackoverflow 上检查过的其他 3 种“解决方案”并列,而那些都不能在 https 下工作。你应该得到一枚奖牌! :) - Apostolos
用户需要选择保存位置的选项。否则他们将不知道下载是否成功,也不知道在哪里找到它。 - WilliamK
如果你想将它变成一个函数或子程序,那么你需要在这一行之后加上.Close。.savetofile "c:\temp\someimage.png", 2 '//overwrite - undefined

9
上面的答案对我来说抛出了错误写入文件失败。代码:800A0BBC,然而这个方法有效:
HTTPDownload "http://www.emagcloud.com/europeansealing/FSA_ESA_Compression_Packing_Technical_Manual_v3/pubData/source/images/pages/page10.jpg", "C:\"

在哪里

Sub HTTPDownload( myURL, myPath )
    ' This Sub downloads the FILE specified in myURL to the path specified in myPath.
    '
    ' myURL must always end with a file name
    ' myPath may be a directory or a file name; in either case the directory must exist
    '
    ' Written by Rob van der Woude
    ' http://www.robvanderwoude.com
    '
    ' Based on a script found on the Thai Visa forum
    ' http://www.thaivisa.com/forum/index.php?showtopic=21832
    
        ' Standard housekeeping
        Dim i, objFile, objFSO, objHTTP, strFile, strMsg
        Const ForReading = 1, ForWriting = 2, ForAppending = 8
    
        ' Create a File System Object
        Set objFSO = CreateObject( "Scripting.FileSystemObject" )
    
        ' Check if the specified target file or folder exists,
        ' and build the fully qualified path of the target file
        If objFSO.FolderExists( myPath ) Then
            strFile = objFSO.BuildPath( myPath, Mid( myURL, InStrRev( myURL, "/" ) + 1 ) )
        ElseIf objFSO.FolderExists( Left( myPath, InStrRev( myPath, "\" ) - 1 ) ) Then
            strFile = myPath
        Else
            WScript.Echo "ERROR: Target folder not found."
            Exit Sub
        End If
    
        ' Create or open the target file
        Set objFile = objFSO.OpenTextFile( strFile, ForWriting, True )
    
        ' Create an HTTP object
        Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
    
        ' Download the specified URL
        objHTTP.Open "GET", myURL, False
        objHTTP.Send
    
        ' Write the downloaded byte stream to the target file
        For i = 1 To LenB( objHTTP.ResponseBody )
            objFile.Write Chr( AscB( MidB( objHTTP.ResponseBody, i, 1 ) ) )
        Next
    
        ' Close the target file
        objFile.Close( )
End Sub

如果接受的答案在遇到特定错误时失败,那么问题就是写入文件夹的权限,这并不难解决。 - user692942
1
你说得对,我通过使用提供的代码解决了这个问题。 - Charles Clayton
4
当文件大小较大时(例如400k的PDF文件,我需要20秒才能下载),您的方法非常缓慢,而标记答案仅需2秒即可下载相同的文件。 - Vin.X
我正在尝试下载一个png文件。它创建了新文件,但是png文件要么不完整,要么就是其他东西 - 它没有图像。 - bgmCoder

6
除了Alex K的回答,如果有帮助的话,我使用了以下内容:
定义对象
Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")

使用文件(在我们的情况下为图像)调用下载链接

URL = "https://www.grupya.com/public/assets/img/logo.png"
objWinHttp.open "GET", URL, False
objWinHttp.send ""

将二进制数据保存到磁盘

SaveBinaryData "c:\temp\my.png",objWinHttp.responseBody

SaveBinaryData Function

Function SaveBinaryData(FileName, Data)

' adTypeText for binary = 1
Const adTypeText = 1
Const adSaveCreateOverWrite = 2

' Create Stream object
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")

' Specify stream type - we want To save Data/string data.
BinaryStream.Type = adTypeText

' Open the stream And write binary data To the object
BinaryStream.Open
BinaryStream.Write Data

' Save binary data To disk
BinaryStream.SaveToFile FileName, adSaveCreateOverWrite

End Function

我觉得你指的是在这一行中使用adTypeBinary而不是adTypeText:BinaryStream.Type = adTypeText - undefined

1

我发现映射驱动器可能是一个不错的方法

   dim Z
   Z = "http:// .... " '(base url)
   Set FSO = CreateObject("Scripting.Filesystemobject")
    Set objNetwork = CreateObject("WScript.Network") 
    '## This is for network drives
    
    If FSO.driveExists ("Z:") then 
        objNetwork.RemoveNetworkDrive "Z:", True, True
    End If      

    '## for adding
    'Set objNetwork = CreateObject("WScript.Network")
    objNetwork.MapNetworkDrive "Z:" , Z

从那里,你可以定义文件的其余url

SourceFileName = "Z:\" & ...

以及目标文件名

DestinFileName = "..."

然后你可以使用

 FSO.CopyFile SourceFileName, DestinFileName, True

有趣,谢谢。我猜这只适用于远程HTTP服务启用了WebDAV扩展:https://social.technet.microsoft.com/Forums/lync/en-US/ea5a16b8-f6ae-48fc-8f0f-f5e8957d7b16/map-http-drive - saulius2

0

这篇文章已经有些年头了,但第一个代码答案中的错误在于你需要拥有写入 C:\ 的权限,尝试在桌面或者 %temp% 中操作,就可以正常工作了。


-1

尝试:

CreateObject("WScript.Shell").Run "curl -o "Path and filename"

3
虽然此代码片段可能解决问题,但包括解释确实有助于提高您的帖子质量。请记住,您正在为将来的读者回答问题,这些人可能不知道您提出代码建议的原因。 - 31piy
2
这需要在目标机器上安装curl,而大多数Windows机器并不具备此功能。 - Arcath

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接