将网站全部下载下来的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
'*************************************************************************************************
'*************************************************************************************************
' 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