将网站全部下载下来的ASP代码

Description:

A script that downloads files from a remote web server to a local mirror site (you can use it for just downloading files to anywhere you want...)

Script:

'*************************************************************************************************
' Download.vbs - Download files from the internet to local mirror servers
' Created by Martin77 (version 1.0)
'*************************************************************************************************
Option Explicit
On Error Resume Next

Dim LogPath, SourceURL, TargetPath, Files2Download

'*************************************************************************************************
'            Edit these variables only!
'*************************************************************************************************
            'Where to save the log file:
            LogPath = "C:/Inetpub/wwwroot/Logs/"

            'From where download the files:
            SourceURL = "http://www.somesite.com/rootfolder/otherfolder/"
                            
            'Where to save the downloaded files:
            TargetPath = "C:/Inetpub/wwwroot/LocalSite/"
                            
            'What files to download (separated by ','):
            Files2Download = "file1.txt,file2.exe,file3.zip"

'*************************************************************************************************
    Main 'Run the main process
'*************************************************************************************************
'Main process:
Sub Main
    Dim strOutputFile, strErrCode, strOutPut, i
    Dim objArgs, objFSO, objOutputFile, objHTTP
    Dim arrFiles2Download
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    arrFiles2Download = Split(Files2Download,",")
    strOutputFile = LogPath & "Download-Log-" & Replace(Date,"/","-") & ".log"

    'Parse Arguments (from App. Center URL Health Monitor):
    Set objArgs = Wscript.Arguments
    For i = 0 To objArgs.count - 1
        strErrCode = strErrCode & objArgs(i) & " "
    Next
    Set objArgs = Nothing
    strOutPut = Now & " - " & strErrCode

    'Download files:
    For i = 0 To Ubound(arrFiles2Download)
        If SaveWebBinary(SourceURL & arrFiles2Download(i), TargetPath & arrFiles2Download(i)) Then
            'Download OK:
            strOutPut = strOutPut & vbCrLf & Now & " - Downloaded file: " & arrFiles2Download(i)
        Else
            'Download Error
            strOutPut = strOutPut & vbCrLf & Now & " - Error downloading file: " & arrFiles2Download(i)
        End If
    Next
    'Write LogFile:
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objOutputFile = objFSO.OpenTextFile(strOutputFile, ForAppending, True)
    objOutputFile.Write "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-" & vbCrLf
    objOutputFile.Write strOutPut & vbCrLf
    objOutputFile.Write "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-" & vbCrLf
    objOutputFile.Close
    Set objFSO = Nothing
    Set objOutputFile = Nothing
End Sub
'*************************************************************************************************
'Download the file from %strUrl% to %strFile% - returns True / False
Function SaveWebBinary(strUrl, strFile) 'As Boolean
    Const adTypeBinary = 1
    Const adSaveCreateOverWrite = 2
    Const ForWriting = 2
    Dim web, varByteArray, strData, strBuffer, lngCounter, ado
    Err.Clear
    Set web = Nothing
    Set web = CreateObject("WinHttp.WinHttpRequest.5.1")
    If web Is Nothing Then Set web = CreateObject("WinHttp.WinHttpRequest")
    If web Is Nothing Then Set web = CreateObject("MSXML2.ServerXMLHTTP")
    If web Is Nothing Then Set web = CreateObject("Microsoft.XMLHTTP")
    web.Open "GET", strURL, False
    web.Send
    If Err.Number <> 0 Then
        SaveWebBinary = False
        Set web = Nothing
        Exit Function
    End If
    If web.Status <> "200" Then
        SaveWebBinary = False
        Set web = Nothing
        Exit Function
    End If
    varByteArray = web.ResponseBody
    Set web = Nothing
    
    'Save the file
    On Error Resume Next
    Set ado = Nothing
    Set ado = CreateObject("ADODB.Stream")
    If ado Is Nothing Then
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set ts = fs.OpenTextFile(strFile, ForWriting, True)
        strData = ""
        strBuffer = ""
        For lngCounter = 0 to UBound(varByteArray)
            ts.Write Chr(255 And Ascb(Midb(varByteArray,lngCounter + 1, 1)))
        Next
        ts.Close
    Else
        ado.Type = adTypeBinary
        ado.Open
        ado.Write varByteArray
        ado.SaveToFile strFile, adSaveCreateOverWrite
        ado.Close
    End If
    SaveWebBinary = True
End Function
'*************************************************************************************************

Keywords: Dwonload, Savewebbinary, Winhttp.winhttprequest.5.1, Winhttp.winhttprequest, Msxml2.serverxmlhttp, Microsoft.xmlhttp