VBS /批量检查下载是否完成

是否有任何方式使用VBS的默认选项(没有WGet ,PowerShell等)来检查下载的文件是否完全100%下载?

我正在使用的脚本成功下载文件,但我不知道如何检查文件是否100%下载,并没有find一种方法来使用默认的Windows(7/8)function(没有必须启用自定义function)。

或者,如果在VBS脚本中使用批处理(或者其他任何默认的Windowsfunction),这也是可以接受的。

Solutions Collecting From Web of "VBS /批量检查下载是否完成"

这是一个混合脚本[批/ VBScript]从用户从inputBox输入的URL下载文件。

@echo off mode con:cols=70 lines=8 & Color 9B Title -==*==- Batch Downloader file by Hackoo -==*==- ( echo Option Explicit echo. echo Dim Message, result echo Dim Title, Text1, Text2 echo. echo Message = "Type the URL of the file to download." echo Title = "Download a file from URL by Hackoo" echo Text1 = "You canceled" echo. echo result = InputBox^(Message, Title, "http://www.gametop.com/online-free-games/anti-terror-force-online/game.swf", 900, 900^) echo. echo. echo If result = "" Then echo WScript.Echo Text1 echo Else echo WScript.Echo result echo End If )>"%tmp%\inputbox.vbs" for /f "tokens=* delims=*" %%a in ('Cscript "%tmp%\inputbox.vbs" //nologo') do (set "a=%%a") ( echo path = "%A%" echo pos = InStrRev(path, "/"^) +1 echo Const DownloadDest = "%A%" echo LocalFile = Mid(path, pos^) echo Const webUser = "admin" echo Const webPass = "admin" echo Const DownloadType = "binary" echo dim strURL echo. echo function getit(^) echo dim xmlhttp echo. echo set xmlhttp=createobject("MSXML2.XMLHTTP.3.0"^) echo 'xmlhttp.SetOption 2, 13056 'If https -^) Ignorer toutes les erreurs SSL echo strURL = DownloadDest echo Wscript.Echo "Download-URL: " ^& strURL echo. echo 'Pour l'authentification de base, utilisez la liste ci-dessous, ainsi que les variables + d'utilisateurs? laisser passer echo 'xmlhttp.Open "GET", strURL, false, WebUser, WebPass echo xmlhttp.Open "GET", strURL, false echo. echo xmlhttp.Send echo Wscript.Echo "Download-Status: " ^& xmlhttp.Status ^& " " ^& xmlhttp.statusText echo. echo If xmlhttp.Status = 200 Then echo Dim objStream echo set objStream = CreateObject("ADODB.Stream"^) echo objStream.Type = 1 'adTypeBinary echo objStream.Open echo objStream.Write xmlhttp.responseBody echo objStream.SaveToFile LocalFile,2 echo objStream.Close echo set objStream = Nothing echo End If echo. echo. echo set xmlhttp=Nothing echo End function echo. echo '======================================================================= echo ' Fin Defs de fonction, Start Page echo '======================================================================= echo getit(^) echo Wscript.Echo "Download Completed. Check " ^& LocalFile ^& " for success." echo Wscript.Quit(intOK^) )>"%tmp%\httpdownload.vbs" ::Debut echo Please wait ... The downloading file is in progress ... echo. for /f "tokens=* delims=*" %%a in ('Cscript "%tmp%\httpdownload.vbs" //nologo') do (echo "%%a") Del %tmp%\httpdownload.vbs ::fin pause>nul 

我在HTA中用一个Waiting Bar做了另一个Vbscript,用于下载一个大文件,所以你可以尝试一下,我希望它能在Windows 8上工作,因为我还没有在这个环境下测试它。

在这里输入图像说明

 Option Explicit Dim Title,WaitingMsg,oExec,fso,ws,Temp,ExampleURL,URL,PathScript,Question,MaCmd Title = "Downloading File by © Hackoo 2014" Set ws = CreateObject("wscript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") Temp = ws.ExpandEnvironmentStrings("%Temp%") ExampleURL = "http://promodj.com/download/4126268/Chris%20Parker%20-%20Life%20MIX%20%282011%20-%202013%29%20%28promodj.com%29.mp3" URL = InputBox("Type or paste the URL in the inputbox Example : " & Dblquote(ExampleURL) & "",Title,ExampleURL) If URL = "" Then Wscript.Quit() Call DownloadingFile(URL) 'Downloading the file '******************************************************************************************************************** Sub DownloadingFile(URL) Dim Title,objFSO,Ws,objXMLHTTP,PathScript,Tab,strHDLocation,objADOStream,Command,Start,File Dim MsgTitle,WaitingMsg,StartTime,DurationTime,ProtocoleHTTP Set objFSO = Createobject("Scripting.FileSystemObject") Set Ws = CreateObject("wscript.Shell") PathScript = fso.GetParentFolderName(wscript.ScriptFullName) 'Path of this Vbscript ProtocoleHTTP = "http://" If URL = "" Then WScript.Quit If Left(URL,7) <> ProtocoleHTTP Then URL = ProtocoleHTTP & URL End if Tab = split(url,"/") File = Tab(UBound(Tab)) File = Replace(File,"%20"," ") File = Replace(File,"%28","(") File = Replace(File,"%29",")") WaitingMsg = "Please wait ... "& DblQuote(File) &" is in progress..." Set objXMLHTTP = CreateObject("MSXML2.serverXMLHTTP.3.0") strHDLocation = PathScript & "\" & File Title = "Downloading "& DblQuote(File) &" by © Hackoo 2014" Call CreateProgressBar(Title,WaitingMsg)'Creation of Waiting Bar Call LancerProgressBar() 'Launch of the Waiting Bar StartTime = Timer 'Start the Timer Counter On Error Resume Next objXMLHTTP.open "GET",URL,false objXMLHTTP.send() If Err.number <> 0 Then Call FermerProgressBar()'Closing Waiting Bar MsgBox err.description,16,err.description Exit Sub Else If objXMLHTTP.Status = 200 Then strHDLocation = PathScript & "\" & File Set objADOStream = CreateObject("ADODB.Stream") objADOStream.Open objADOStream.Type = 1 'adTypeBinary objADOStream.Write objXMLHTTP.ResponseBody objADOStream.Position = 0 'Set the stream position to the start objADOStream.SaveToFile strHDLocation,2 objADOStream.Close Set objADOStream = Nothing End If End if Set objXMLHTTP = Nothing DurationTime = FormatNumber(Timer - StartTime, 0) & " seconds." 'The duration of the script Call FermerProgressBar() 'Closing Waiting Bar ws.Popup "The Download of " & Dblquote(File) & " is finished in " & DurationTime &" !","5","The Download of " & Dblquote(File) & " is finished in " & DurationTime &" !",64 End Sub '*********************************************************************************************************** Sub CreateProgressBar(Title,WaitingMsg) Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec Set ws = CreateObject("wscript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") Temp = WS.ExpandEnvironmentStrings("%Temp%") PathOutPutHTML = Temp & "\Barre.hta" Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True) fhta.WriteLine "<HTML>" fhta.WriteLine "<HEAD>" fhta.WriteLine "<Title> " & Title & "</Title>" fhta.WriteLine "<HTA:APPLICATION" fhta.WriteLine "ICON = ""magnify.exe"" " fhta.WriteLine "BORDER=""THIN"" " fhta.WriteLine "INNERBORDER=""NO"" " fhta.WriteLine "MAXIMIZEBUTTON=""NO"" " fhta.WriteLine "MINIMIZEBUTTON=""NO"" " fhta.WriteLine "SCROLL=""NO"" " fhta.WriteLine "SYSMENU=""NO"" " fhta.WriteLine "SELECTION=""NO"" " fhta.WriteLine "SINGLEINSTANCE=""YES"">" fhta.WriteLine "</HEAD>" fhta.WriteLine "<BODY text=""white""><CENTER>" fhta.WriteLine "<marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & WaitingMsg &"</font></marquee>" fhta.WriteLine "<img src=""data:image/gif;base64,R0lGODlhgAAPAPIAAP////INPvvI0/q1xPVLb/INPgAAAAAAACH/C05FVFNDQVBFMi4wAwEAAAAh/hpDcmVhdGVkIHdpdGggYWpheGxvYWQuaW5mbwAh+QQJCgAAACwAAAAAgAAPAAAD5wiyC/6sPRfFpPGqfKv2HTeBowiZGLORq1lJqfuW7Gud9YzLud3zQNVOGCO2jDZaEHZk+nRFJ7R5i1apSuQ0OZT+nleuNetdhrfob1kLXrvPariZLGfPuz66Hr8f8/9+gVh4YoOChYhpd4eKdgwDkJEDE5KRlJWTD5iZDpuXlZ+SoZaamKOQp5wAm56loK6isKSdprKotqqttK+7sb2zq6y8wcO6xL7HwMbLtb+3zrnNycKp1bjW0NjT0cXSzMLK3uLd5Mjf5uPo5eDa5+Hrz9vt6e/qosO/GvjJ+sj5F/sC+uMHcCCoBAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/4ixgeloM5erDHonOWBFFlJoxiiTFtqWwa/Jhx/86nKdc7vuJ6mxaABbUaUTvljBo++pxO5nFQFxMY1aW12pV+q9yYGk6NlW5bAPQuh7yl6Hg/TLeu2fssf7/19Zn9meYFpd3J1bnCMiY0RhYCSgoaIdoqDhxoFnJ0FFAOhogOgo6GlpqijqqKspw+mrw6xpLCxrrWzsZ6duL62qcCrwq3EsgC0v7rBy8PNorycysi3xrnUzNjO2sXPx8nW07TRn+Hm3tfg6OLV6+fc37vR7Nnq8Ont9/Tb9v3yvPu66Xvnr16+gvwO3gKIIdszDw65Qdz2sCFFiRYFVmQFIAEBACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9J2qd1AoM9MYeF4KaWJKWmaJXxEyulI3zWa/39Xh6/vkT3q/DC/JiBFjMSCM2hUybUwrdFa3Pqw+pdEVxU3AViKVqwz30cKzmQpZl8ZlNn9uzeLPH7eCrv2l1eXKDgXd6Gn5+goiEjYaFa4eOFopwZJh/cZCPkpGAnhoFo6QFE6WkEwOrrAOqrauvsLKttKy2sQ+wuQ67rrq7uAOoo6fEwsjAs8q1zLfOvAC+yb3B0MPHD8Sm19TS1tXL4c3jz+XR093X28ao3unnv/Hv4N/i9uT45vqr7NrZ89QFHMhPXkF69+AV9OeA4UGBDwkqnFiPYsJg7jBktMXhD165jvk+YvCoD+Q+kRwTAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJdCLnC/S+nsCFo1dq5zeRoFlJ1Du91hOq3b3qNo/5OdZPGDT1QrSZDLIcGp2o47MYheJuImmVer0lmRVlWNslYndm4Jmctba5gm9sPI+gp2v3fZuH78t4Xk0Kg3J+bH9vfYtqjWlIhZF0h3qIlpWYlJpYhp2DjI+BoXyOoqYaBamqBROrqq2urA8DtLUDE7a1uLm3s7y7ucC2wrq+wca2sbIOyrCuxLTQvQ680wDV0tnIxdS/27TND+HMsdrdx+fD39bY6+bX3um14wD09O3y0e77+ezx8OgAqutnr5w4g/3e4RPIjaG+hPwc+stV8NlBixAzSlT4bxqhx46/MF5MxUGkPA4BT15IyRDlwG0uG55MAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPECwbnu3gUKH1h2ZziNKVlJWDW9FvSuI/nkusPjrF0OaBIGfTna7GaTNTPGIvK4GUZRV1WV+ssKlE/G0hmDTqVbdPeMZWvX6XacAy6LwzAF092b9+GAVnxEcjx1emSIZop3g16Eb4J+kH+ShnuMeYeHgVyWn56hakmYm6WYnaOihaCqrh0FsbIFE7Oytba0D7m6DgO/wAMTwcDDxMIPx8i+x8bEzsHQwLy4ttWz17fJzdvP3dHfxeG/0uTjywDK1Lu52bHuvenczN704Pbi+Ob66MrlA+scBAQwcKC/c/8SIlzI71/BduysRcTGUF49i/cw5tO4jytjv3keH0oUCJHkSI8KG1Y8qLIlypMm312ASZCiNA0X8eHMqPNCTo07iyUAACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9F8mk8ap8hffaB3ZiWJKfmaJgJWHV5FqQK9uPuDr6yPeTniAIzBV/utktVmPCOE8GUTc9Ia0AYXWXPXaTuOhr4yRDzVIjVY3VsrnuK7ynbJ7rYlp+6/u2vXF+c2tyHnhoY4eKYYJ9gY+AkYSNAotllneMkJObf5ySIphpe3ajiHqUfENvjqCDniIFsrMFE7Sztre1D7q7Dr0TA8LDA8HEwsbHycTLw83ID8fCwLy6ubfXtNm40dLPxd3K4czjzuXQDtID1L/W1djv2vHc6d7n4PXi+eT75v3oANSxAzCwoLt28P7hC2hP4beH974ZTEjwYEWKA9VBdBixLSNHhRPlIRR5kWTGhgz1peS30l9LgBojUhzpa56GmSVr9tOgcueFni15styZAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKsWIPiFwhia4kWWKrl5UGXFMFa/nJ0Da+r0rF9vAiQOH0DZTMeYKJ0y6O2JPApXRmxVe3VtSVSmRLzENWm7MM+65ra93dNXHgep71H0mSzdFec+b3SCgX91AnhTeXx6Y2aOhoRBkllwlICIi49liWmaapGhbKJuSZ+niqmeN6SWrYOvIAWztAUTtbS3uLYPu7wOvrq4EwPFxgPEx8XJyszHzsbQxcG9u8K117nVw9vYD8rL3+DSyOLN5s/oxtTA1t3a7dzx3vPwAODlDvjk/Orh+uDYARBI0F29WdkQ+st3b9zCfgDPRTxWUN5AgxctVqTXUDNix3QToz0cGXIaxo32UCo8+OujyJIM95F0+Y8mMov1NODMuPKdTo4hNXgMemGoS6HPEgAAIfkECQoAAAAsAAAAAIAADwAAA/8ItAv+rD0XyaTxqnyr9pcgitpIhmaZouMGYq/LwbPMTJVE34/Z9j7BJCgE+obBnAWSwzWZMaUz+nQQkUfjyhrEmqTQGnins5XH5iU3u94Crtpfe4SuV9NT8R0Nn5/8RYBedHuFVId6iDyCcX9vXY2Bjz52imeGiZmLk259nHKfjkSVmpeWanhhm56skIyABbGyBROzsrW2tA+5ug68uLbAsxMDxcYDxMfFycrMx87Gv7u5wrfTwdfD2da+1A/Ky9/g0OEO4MjiytLd2Oza7twA6/Le8LHk6Obj6c/8xvjzAtaj147gO4Px5p3Dx9BfOQDnBBaUeJBiwoELHeaDuE8uXzONFu9tE2mvF0KSJ00q7Mjxo8d+L/9pRKihILyaB29esEnzgkt/Gn7GDPosAQAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKv2HTcJJKmV5oUKJ7qBGPyKMzNVUkzjFoSPK9YjKHQQgSve7eeTKZs7ps4GpRqDSNcQu01Kazlwbxp+ksfipezY1V5X2ZI5XS1/5/j7l/12A/h/QXlOeoSGUYdWgXBtJXEpfXKFiJSKg5V2a1yRkIt+RJeWk6KJmZhogKmbniUFrq8FE7CvsrOxD7a3Drm1s72wv7QPA8TFAxPGxcjJx8PMvLi2wa7TugDQu9LRvtvAzsnL4N/G4cbY19rZ3Ore7MLu1N3v6OsAzM0O9+XK48Xn/+notRM4D2C9c/r6Edu3UOEAgwMhFgwoMR48awnzMWOIzyfeM4ogD4aMOHJivYwexWlUmZJcPXcaXhKMORDmBZkyWa5suE8DuAQAIfkECQoAAAAsAAAAAIAADwAAA/8ItAv+rD0XyaTxqnyr9h03gZNgmtqJXqqwka8YM2NlQXYN2ze254/WyiF0BYU8nSyJ+zmXQB8UViwJrS2mlNacerlbSbg3E5fJ1WMLq9KeleB3N+6uR+XEq1rFPtmfdHd/X2aDcWl5a3t+go2AhY6EZIZmiACWRZSTkYGPm55wlXqJfIsmBaipBROqqaytqw+wsQ6zr623qrmusrATA8DBA7/CwMTFtr24yrrMvLW+zqi709K0AMkOxcYP28Pd29nY0dDL5c3nz+Pm6+jt6uLex8LzweL35O/V6fv61/js4m2rx01buHwA3SWEh7BhwHzywBUjOGBhP4v/HCrUyJAbXUSDEyXSY5dOA8l3Jt2VvHCypUoAIetpmJgAACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9F8mk8ap8q/YdN4Gj+AgoqqVqJWHkFrsW5Jbzbee8yaaTH4qGMxF3Rh0s2WMUnUioQygICo9LqYzJ1WK3XiX4Na5Nhdbfdy1mN8nuLlxMTbPi4be5/Jzr+3tfdSdXbYZ/UX5ygYeLdkCEao15jomMiFmKlFqDZz8FoKEFE6KhpKWjD6ipDqunpa+isaaqqLOgEwO6uwO5vLqutbDCssS0rbbGuMqsAMHIw9DFDr+6vr/PzsnSx9rR3tPg3dnk2+LL1NXXvOXf7eHv4+bx6OfN1b0P+PTN/Lf98wK6ExgO37pd/pj9W6iwIbd6CdP9OmjtGzcNFsVhDHfxDELGjxw1Xpg4kheABAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKv2HTeBowiZjqCqG9malYS5sXXScYnvcP6swJqux2MMjTeiEjlbyl5MAHAlTEarzasv+8RCu9uvjTuWTgXedFhdBLfLbGf5jF7b30e3PA+/739ncVp4VnqDf2R8ioBTgoaPfYSJhZGIYhN0BZqbBROcm56fnQ+iow6loZ+pnKugpKKtmrGmAAO2twOor6q7rL2up7C/ssO0usG8yL7KwLW4tscA0dPCzMTWxtXS2tTJ297P0Nzj3t3L3+fmzerX6M3hueTp8uv07ezZ5fa08Piz/8UAYhPo7t6+CfDcafDGbOG5hhcYKoz4cGIrh80cPAOQAAAh+QQJCgAAACwAAAAAgAAPAAAD5wi0C/6sPRfJpPGqfKv2HTeBowiZGLORq1lJqfuW7Gud9YzLud3zQNVOGCO2jDZaEHZk+nRFJ7R5i1apSuQ0OZT+nleuNetdhrfob1kLXrvPariZLGfPuz66Hr8f8/9+gVh4YoOChYhpd4eKdgwFkJEFE5KRlJWTD5iZDpuXlZ+SoZaamKOQp5wAm56loK6isKSdprKotqqttK+7sb2zq6y8wcO6xL7HwMbLtb+3zrnNycKp1bjW0NjT0cXSzMLK3uLd5Mjf5uPo5eDa5+Hrz9vt6e/qosO/GvjJ+sj5F/sC+uMHcCCoBAA7AAAAAAAAAAAA"" />" fhta.WriteLine "</CENTER></BODY></HTML>" fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> " fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")" fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")" fhta.WriteLine "Sub window_onload()" fhta.WriteLine " CenterWindow 490,110" fhta.WriteLine " Self.document.bgColor = ""DarkOrange"" " fhta.WriteLine " End Sub" fhta.WriteLine " Sub CenterWindow(x,y)" fhta.WriteLine " Dim iLeft,itop" fhta.WriteLine " window.resizeTo x,y" fhta.WriteLine " iLeft = window.screen.availWidth/2 - x/2" fhta.WriteLine " itop = window.screen.availHeight/2 - y/2" fhta.WriteLine " window.moveTo ileft,itop" fhta.WriteLine "End Sub" fhta.WriteLine "</script>" fhta.close End Sub '********************************************************************************************** Sub LancerProgressBar() Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta") End Sub '********************************************************************************************** Sub FermerProgressBar() oExec.Terminate End Sub '********************************************************************************************** Function DblQuote(Str) DblQuote = Chr(34) & Str & Chr(34) End Function '**********************************************************************************************