Немного доработал скрипт...
| Код |
Option Explicit
On Error Resume Next
Const FOR_APPENDING = 8
Const DeleteReadOnly = True
Dim strLogFileName
Dim strHTTPFileName
Dim strFileName
Dim strScriptFolder
Dim objFSO
Dim intCount
Dim intGetResult
strHTTPFileName = "http://download.microsoft.com/download/DefinitionUpdates/mpam-fe.exe"
strFileName = "mpam-fe.exe"
strLogFileName = "Log.log"
strScriptFolder = WScript.ScriptFullName
strScriptFolder = Mid (strScriptFolder, 1, InStrRev(strScriptFolder, "\"))
strLogFileName = strScriptFolder + strLogFileName
strFileName = strScriptFolder + strFileName
StrToLog strLogFileName, "Начало работы: " & CStr(Now)
' Проверим "наличие Интернета" :-)
If Not Ping ("www.ya.ru") Then
StrToLog strLogFileName, "Интернета нет!!!"
StrToLog strLogFileName, "Конец работы: " & CStr(Now) & vbCrLf
WScript.Quit
Else
StrToLog strLogFileName, "www.ya.ru доступен..."
End If
' Пишем лог в сличае ошибки
If Err.Number <> 0 Then
StrToLog strLogFileName, Err.Number & " - " & Err.Description
Err.Clear
End If
' Удаляем ненужный больше старый файл
StrToLog strLogFileName, "Удаляем ненужный больше старый файл"
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile strFileName, DeleteReadOnly
Set objFSO = Nothing
' Пишем лог в сличае ошибки
If Err.Number <> 0 Then
StrToLog strLogFileName, Err.Number & " - " & Err.Description
Err.Clear
End If
' Закачиваем нужный нам файл...
' В случае неудач при скачивании, сдаёмся только после 5-й попытки
StrToLog strLogFileName, "Закачиваем нужный нам файл"
intCount = 0
Do
intCount = intCount + 1
intGetResult = HTTPFileGet (strHTTPFileName, strFileName)
' Пишем лог в сличае ошибки
If Err.Number <> 0 Then
StrToLog strLogFileName, Err.Number & " - " & Err.Description
Err.Clear
End If
WScript.Sleep 1000
Loop Until (intGetResult = 0) Or (intCount = 5)
' Пишем лог в сличае ошибки
If Err.Number <> 0 Then
StrToLog strLogFileName, Err.Number & " - " & Err.Description
Err.Clear
End If
StrToLog strLogFileName, "Конец работы: " & CStr(Now) & vbCrLf
' Выходим из программы...
WScript.Quit
Function HTTPFileGet(strFileURL, strFileSave)
Dim objXMLHTTP, objADOStream, objFSO
HTTPFileGet = 1
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
Set objADOStream = CreateObject("ADODB.Stream")
Set objFSO = Createobject("Scripting.FileSystemObject")
objXMLHTTP.Open "GET", strFileURL, False
objXMLHTTP.Send()
If objXMLHTTP.Status = 200 Then
objADOStream.Open
objADOStream.Type = 1
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0
If objFSO.FileExists(strFileSave) Then objFSO.DeleteFile strFileSave
objADOStream.SaveToFile strFileSave
objADOStream.Close
HTTPFileGet = 0
End If
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'#
'# Процедура StrToLog()
'# Описание: Записывает строку в лог файл
'# Вход :
'# Выход :
'#
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub StrToLog (ByVal strLogFileName, ByVal strS)
Dim objFS, objTS
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.OpenTextFile(strLogFileName,FOR_APPENDING, True)
objTS.Write strS & VbCrLf
Set objTS = Nothing
Set objFS = Nothing
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'#
'# Функция Ping()
'# Описание: Пингует один/несколько хостов в Интернете
'# Вход :
'# Выход :
'#
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Ping (ByVal strMachines)
Dim intResponseTime
Dim intResult
Dim aMachines
Dim machine
Dim objPing
Dim objStatus
' Параметры конфигурации
intResponseTime = 50 ' Максимально допустимое время отклика
intResult = 0 ' Результат доступности/недоступности серверов
' Начало скрипта
aMachines = split(strMachines, ";")
For Each machine in aMachines
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}")._
ExecQuery("select * from Win32_PingStatus where address = '"_
& machine & "'")
For Each objStatus in objPing
If IsNull(objStatus.StatusCode) or objStatus.StatusCode<>0 Then
' Код обработки ситуации, когда ресурс недоступен
intResult = intResult + 1
Else
End If
Next
Set objPing = Nothing
Next
If intResult = 0 Then Ping = True Else Ping = False
End Function
|
|
)