Обновления для Microsoft Windows 7/Server 2008 R2 - [607] :: Microsoft Windows

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Arch = "32" ' Архитектура процессора
DUpdPath = "D:\Temp\Updates" & Arch & "\" ' Исходная папка с уже закачанными обновлениями
FSourceName = "Updates.html" ' Сохраненная страница "Рекомендации по обновлению ОС Windows 7 SP1" с forum.ru-board.com
FCmdName = "Upd_" & Arch & ".cmd" ' Создаваемый командный файл для установки обновлений
FDiffName = "ToLoad_" & Arch & "_" ' Создаваемый список ссылок на обновления, которые необходимо докачать
UpdDate = "" ' Для даты последнего обновления

Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSource = FSO.OpenTextFile(FSourceName, ForReading, True)
Set FCmd = FSO.OpenTextFile(FCmdName, 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," ") ' Разбиваем на подстроки по тегу 
 Do While pos1 <> 0 ' Реально вся полезная информация находится в одной длинной строке html-файла
 FTempLine = Trim(Mid(SourceLine,1,pos1-1))
 If InStr(FTempLine,"Список 2") <> 0 Then ' Обрабатываем до начала "Списка 2"
 Exit Do
 End If
 If (InStr(FTempLine,".msu") <> 0) or (InStr(FTempLine,".exe") <> 0) Then ' Только строки, содержащие информацию об обновлениях
 Parsing(FTempLine)
 End If
 SourceLine = Mid(SourceLine,pos1+4) ' Отрезаем обработанную часть длинной строки
 pos1 = InStr(SourceLine," ")
 Loop
Loop
FSource.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 UpdDate

Set f = fso.GetFile(FCmdName) ' Переименовываем скрипт по дате последнего обновления
f.Copy(DUpdPath & UpdDate & "_" & Arch & ".cmd")

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>|||"| |"
 Stro = objRegExp.Replace(Stro,"")

 objRegExp.Pattern = "<a href=" & CHR(34) & "http://forum.ru-board.com/mva/" & CHR(34) & " target=_blank>"
 Stro = objRegExp.Replace(Stro,"")

 ' Поиск информации об обновлении
 pos = InStr(Stro,">KB")
 If pos <> 0 Then
 UpdInfo = Mid(Stro,pos+1)
 End If

 ' Поиск даты обновления
 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

 ' Поиск ссылки на обновление
 Pattern = "http://\S*\.(msu|exe).{15,20}\[" & Arch & "\]" ' Подстрока, начинается с http://, содержит один и более непробельных (\S*) символов, заканчивается на .msu или .exe, после чего через 15-20 любых символов идет разрядность [Arch]
 objRegExp.Pattern = Pattern
 Set objMatches = objRegExp.Execute(Stro)

 For i = 0 To objMatches.Count - 1
 Set objMatch = objMatches.Item(i)
 UpdLink = objMatch.Value
 Next

 If UpdLink <> "" Then
 pos = InStr(UpdLink,Chr(34)) ' Вырезаем только ссылку (до кавычек)
 UpdLink = Left(UpdLink,pos-1)

 pos = InStrRev(UpdLink,"/") ' Находим имя файла в конце ссылки
 UpdFile = Mid(UpdLink,pos+1)

WriteIntoFiles nk, UpdFile, UpdLink, UpdYear, UpdInfo
End If
 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-файла

 ' Запись команда на установку обновления из cmd-файла
 If Right(FileName,3) = "msu" Then
 FCmd.WriteLine("start /wait wusa.exe %~dp0Update" & Year & "\" & FileName & " /quiet /norestart")
 Else
 prov = Left(FileName,6)
 Select Case prov
 Case "rvkroo" FCmd.WriteLine("start /wait %~dp0Update" & Year & "\" & FileName & " /Q")
 Case "msxml4" FCmd.WriteLine("start /wait %~dp0Update" & Year & "\" & FileName & " /quiet /norestart")
 Case Else MsgBox "Check update: " & nk & " " & FileName
 End Select
 End If

 AllFiles = AllFiles & FileName & "#" ' Добавляем имя файла в строку со всеми именами файлов

 If not FSO.FileExists(DUpdPath & "Update" & Year & "\" & FileName) Then ' Файл обновления не найден в папке с обновлениями
 Set FDiff = FSO.OpenTextFile(FDiffName & Year & ".txt", ForAppending, True)
FDiff.WriteLine(LinkName) ' Заносим ссылку на обновление в список докачки (по годах)
 FDiff.Close
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

Модерирует : KLASS, IFkO
articlebot (06-10-2016 09:49): Обновления для Microsoft Windows 7/Server 2008 R2 - IVчасть	Версия для печати • Подписаться • Добавить в закладки
На первую страницу • к этому сообщению • к последнему сообщению