скачать скрипт Const ForReading = 1, ForWriting = 2, ForAppending = 8
DUpdPath = "D:\Temp\Upd\Updates\" ' Исходная папка с уже закачанными обновлениями
FSourceName = "Updates.html" ' Исходная страница "Рекомендации по обновлению ОС Windows XP SP3" с forum.ru-board.com
FCmdName = "Upd_XP.cmd" ' Создаваемый командный файл для установки обновлений
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 XP")
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-файла (пока №41)
FTempLine = Trim(Mid(SourceLine,1,pos1-1))
If InStr(FTempLine,"<b>Список 2</b></font>") <> 0 Then ' Обрабатываем до начала "Списка 2"
Exit Do
End If
If (InStr(FTempLine,".exe") <> 0) and (InStr(FTempLine,"-<a href=") <> 0) Then ' Только строки, содержащие информацию об обновлениях, причем пример cmd-файла игнорируем
Parsing(FTempLine)
End If
SourceLine = Mid(SourceLine,pos1+4) ' Отрезаем обработанную часть длинной строки
pos1 = InStr(SourceLine,"<br>")
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 ' Находим устаревшие обновления в папке с уже закачанными обновлениями
Set f = fso.GetFile(FCmdName) ' Переименовываем скрипт по дате последнего обновления
f.Copy(DUpdPath & UpdDate & ".cmd")
MsgBox("Done...")
' ===================================================================================
' Разбор строки со ссылками на обновления
Sub Parsing(Stro)
Set objRegExp = CreateObject("VBScript.RegExp") ' используем регулярные выражения
objRegExp.Global = True
'Поиск даты обновления
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)
UpdBegin = Mid(Stro,1,pos-1)
Else
pos = InStr(Stro,">WU")
If pos <> 0 Then
UpdInfo = Mid(Stro,pos+1)
UpdBegin = Mid(Stro,1,pos-1)
End If
End If
' Поиск ссылок на обновления
objRegExp.Pattern = "http:(\S*).exe" ' Строка, начинается с http:, содержит один и более непробельных (\S*) символов и заканчивается на .exe
Set objMatches = objRegExp.Execute(UpdBegin)
For i = 0 To objMatches.Count - 1 ' Перебор всех найденных объектов
' Последний найденный файл это или русская версия обновления (идет второй, если есть рус-англ) или английская (если нет)
Set objMatch = objMatches.Item(i)
UpdLink = objMatch.Value
pos = InStrRev(UpdLink,"/") ' Находим имя файла в конце ссылки
UpdFile = Mid(UpdLink,pos+1)
Next
' Очистка комментария от мусора
If InStr(UpdInfo,"WGA LegitCheckControl") <> 0 Then
UpdInfo = "KB892130 30.03.08 WGA LegitCheckControl v1.7.0069.2"
UpdFile = "WindowsXP-KB892130-ENU-x86.exe"
Else
If InStr(UpdFile,"981669") <> 0 Then
UpdInfo = "KB981669 26.04.10 Обновление для Windows Installer 4.5"
Else
objRegExp.Pattern = " |</b>|</a>|<a href=|http:(\S*)| target=_blank>|</span>|CScript\WScript"
UpdInfo = objRegExp.Replace(UpdInfo,"")
End If
End If
WriteIntoFiles nk, UpdFile, UpdLink, UpdYear, UpdInfo
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)
If (InStr(FileName,"root") <> 0) or (InStr(Info,"LegitCheckControl") <> 0) Then
Params = " /Q"
Else
If InStr(FileName,"updateagent") <> 0 Then
Params = " /wuforce /quiet /norestart"
Else
If InStr(FileName,"RightsManagementServices") <> 0 Then
Params = " -override 1 /I MsDrmClient.msi REBOOT=ReallySuppress /q -override 2 /I RmClientBackCompat.msi REBOOT=ReallySuppress /q"
Else
If InStr(FileName,"msxml4") <> 0 Then
Params = " /quiet /norestart"
Else
Params = " /Q /O /N /Z"
End If
End If
End If
End If
FCmd.WriteLine("ECHO " & num_s & "-" & Info) ' Информационная строка cmd-файла
FCmd.WriteLine("start /wait .\Update" & Year & "\" & FileName & Params) ' Команда на установку обновления из cmd-файла
AllFiles = AllFiles & FileName & "#" ' Добавляем имя файла в строку со всеми именами файлов
If not FSO.FileExists(DUpdPath & "Update" & Year & "\" & FileName) Then ' Файл обновления не найден в папке с обновлениями
Set FDiff = FSO.OpenTextFile("ToLoad_XP" & 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 |