скачать скрипт Const ForReading = 1, ForWriting = 2, ForAppending = 8
Arch = "x64" ' Архитектура процессора
DUpdPath = "D:\Temp\Updates64\" ' Исходная папка с уже закачанными обновлениями
FSourceName="Updates.html" ' Исходная страница "Рекомендации по обновлению ОС Windows 7 SP1" с forum.ru-board.com
FCmdName="Upd_" & Arch & ".cmd" ' Создаваемый командный файл для установки обновлений
FDiffName="ToLoad_" & Arch & ".txt" ' Создаваемый список ссылок на обновления, которые необходимо докачать
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSource = FSO.OpenTextFile(FSourceName, ForReading, True)
Set FCmd = FSO.OpenTextFile(FCmdName, ForWriting, True)
Set FDiff = FSO.OpenTextFile(FDiffName, ForWriting, True)
FCmd.WriteLine("@echo off")
FCmd.WriteLine("ECHO.")
FCmd.WriteLine("ECHO Installing Hotfixes for Microsoft Windows 7")
FCmd.WriteLine("ECHO -------------------------------------------------")
' Разбор html-файла:
AllFiles = "" ' Для сохранения всех названий файлов (используется при поиске устаревших обновлений)
nk = 1
Do While FSource.AtEndOfStream <> True ' Просмотр всех строк html-файла
SourceLine = FSource.ReadLine
pos1 = InStr(SourceLine,"<br>") ' Разбиваем на подстроки по тегу <br>
Do While pos1 <> 0 ' Реально вся полезная информация находится в одной длинной строке html-файла (пока №66)
FTempLine = Trim(Mid(SourceLine,1,pos1-1))
If InStr(FTempLine,"<b>Список 2</b></font>") <> 0 Then ' Обрабатываем до начала "Списка 2"
Exit Do
End If
If (InStr(FTempLine,".msu") <> 0) and (Left(FTempLine,5) <> "start") Then ' Только строки, содержащие информацию об обновлениях, причем пример cmd-файла игнорируем
Parsing(FTempLine)
End If
SourceLine = Mid(SourceLine,pos1+4) ' Отрезаем обработанную часть длинной строки
pos1 = InStr(SourceLine,"<br>")
Loop
Loop
FSource.Close
FDiff.Close
FCmd.WriteLine("echo.")
FCmd.WriteLine("echo Done! Please reboot your computer to complete installation!")
FCmd.WriteLine("echo.")
FCmd.Write("pause")
FCmd.Close
WorkDir = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\")) ' Рабочий каталог скрипта
FindObsoleteUpdates ' Находим устаревшие обновления в папке с уже закачанными обновлениями
MsgBox("Done...")
' ===================================================================================
' Разбор строки со ссылками на обновления
Sub Parsing(Stro)
Set objRegExp = CreateObject("VBScript.RegExp") ' используем регулярные выражения
objRegExp.Global = True
' Очистка от мусора
objRegExp.Pattern = "<a href=" & CHR(34) & "http://forum.ru-board.com/microsoft_st/" & CHR(34) & " target=_blank>|</a>|<font color=" & CHR(34) & "#FF0000" & CHR(34) & ">|</font>|"| |</b>"
Stro = objRegExp.Replace(Stro,"")
objRegExp.Pattern = "<a href=" & CHR(34) & "http://forum.ru-board.com/mva/" & CHR(34) & " target=_blank>"
Stro = objRegExp.Replace(Stro,"")
' Поиск даты обновления
objRegExp.Pattern = "\d{2}\.\d{2}\.\d{2}" ' \d - только цифры, {2} - точно 2 символа
Set objMatches = objRegExp.Execute(Stro)
For i = 0 To objMatches.Count - 1
Set objMatch = objMatches.Item(i)
' найденное значение (подстрока) & индекс первого символа найденной подстроки в строке-оригинале & длина найденной подстроки
' MsgBox objMatch.Value & ", " & "FirstIndex=" & objMatch.FirstIndex & ", " & "Length=" & objMatch.Length
UpdDate = objMatch.Value
UpdYear = Right(UpdDate,2)
Next
' Поиск информации об обновлении
pos = InStr(Stro,">KB")
If pos <> 0 Then
UpdInfo = Mid(Stro,pos+1)
End If
' Поиск ссылок на обновления
objRegExp.Pattern = "http://(\S*).msu" ' Строка, начинается с http://, содержит один и более непробельных (\S*) символов и заканчивается на .msu
Set objMatches = objRegExp.Execute(Stro)
For i = 0 To objMatches.Count - 1 ' Перебор всех найденных объектов
Set objMatch = objMatches.Item(i)
UpdLink = objMatch.Value
pos = InStrRev(UpdLink,"/") ' Находим имя файла в конце ссылки
UpdFile = Mid(UpdLink,pos+1)
If Arch = "x86" Then ' Проверка соответствия обновления выбранной архитектуре процессора
If InStr(UpdLink,"x86") <> 0 Then
WriteIntoFiles nk, UpdFile, UpdLink, UpdYear, UpdInfo
End If
Else
If InStr(UpdLink,"x64") <> 0 Then
WriteIntoFiles nk, UpdFile, UpdLink, UpdYear, UpdInfo
End If
End If
Next
nk = nk + 1
End Sub
' ===================================================================================
' Формирование строк cmd-файла и файла со списком ссылок
Sub WriteIntoFiles(num,FileName,LinkName,Year,Info)
If num <= 9 Then ' Номера вида 01, 02, 03 и т.д.
num_s = "0" & num
Else
num_s = num
End If
Info = ANSItoOEM(Info)
FCmd.WriteLine("ECHO " & num_s & "-" & Info) ' Информационная строка cmd-файла
FCmd.WriteLine("start /wait wusa.exe %~dp0Update" & Year & "\" & FileName & " /quiet /norestart") ' Команда на установку обновления из cmd-файла
AllFiles = AllFiles & FileName & "#" ' Добавляем имя файла в строку со всеми именами файлов
If not FSO.FileExists(DUpdPath & "Update" & Year & "\" & FileName) Then ' Файл обновления не найден в папке с обновлениями
FDiff.WriteLine(LinkName) ' Заносим ссылку на обновление в список докачки
End If
End Sub
' ===================================================================================
' Пришлось разбивать на две процедуры (ниже), т.к. внутри вложенного цикла GetFolder не срабатывает
Sub FindObsoleteUpdates()
Set DSet = FSO.GetFolder(DUpdPath)
For Each D In DSet.SubFolders ' Ищем вложенные папки в папке с обновлениями
FindFiles(DUpdPath & D.Name) ' Ищем все файлы в каждой из вложенных папок
Next
End Sub
' ===================================================================================
' Ищем все файлы в заданной папке
Sub FindFiles(Dir)
Set FSet = FSO.GetFolder(Dir)
For Each F In FSet.Files
If InStr(AllFiles,F.Name) = 0 Then ' В cmd-файле упоминания об искомом файле нет - значит обновление устарело
FSO.MoveFile F,WorkDir ' Перемещаем файл из заданной папки в папку со скриптом
End If
Next
End Sub
' ===================================================================================
' Перекодировка символа (http://www.sql.ru/forum/actualthread.aspx?tid=374964)
Function CharANSItoOEM(symbol)
code = Asc(symbol)
If ((code >= 176) and (code <= 239)) Then
If (code = 185) then
res = Chr(code+67)
Else
res = Chr(code-64)
End If
Else
If ((code >= 240) and (code <= 255)) Then
res = Chr(code-16)
Else
res = symbol
End If
End If
CharANSItoOEM = res
End Function
' ===================================================================================
' Перекодировка строки (http://www.sql.ru/forum/actualthread.aspx?tid=374964)
Function ANSItoOEM(st)
slen = Len(st)
i = 0
tmp = ""
While (i < sLen)
i = i + 1
tmp = tmp + CharANSItoOEM(Mid(st,i,1))
Wend
ANSItoOEM = tmp
End Function pre> objRegExp.Pattern = | 
