Question

我正在尝试通过VB脚本仅安装Security Essentials的定义更新，而且我遇到了一些麻烦。

我已经浏览了MS提供的脚本here，其中一个下载并安装了所有的Windows更新，这些更新是有风险的，而且我还尝试了特定的更新脚本，这些脚本无法播放提供我希望下载和安装的定义的全名时的球。

这是MS代码...我希望做的是在脚本中弹出一些“定义更新”并每天运行以检查定期更新

任何线索都会非常受欢迎问候 ç

`Set updateSession = CreateObject("Microsoft.Update.Session")
updateSession.ClientApplicationID = "MSDN Sample Script"

'Get update title to search for
WScript.Echo "Enter the title of the update: " & _
"(for example, Update for Windows Rights Management client 1.0)"
updateTitle = WScript.StdIn.Readline

WScript.Echo vbCRLF & "Searching for: " & updateTitle & "..."

Set updateSearcher = updateSession.CreateupdateSearcher()

'Search for all software updates, already installed and not installed
Set searchResult = _
updateSearcher.Search("Type='Software'")

Set updateToInstall = CreateObject("Microsoft.Update.UpdateColl")

updateIsApplicable = False

'Cycle through search results to look for the update title
For i = 0 To searchResult.Updates.Count-1
   Set update = searchResult.Updates.Item(i)
   If UCase(update.Title) = UCase(updateTitle) Then
   'Update in list of applicable updates 
   'Determine if it is already installed or not
      If update.IsInstalled = False Then
         WScript.Echo vbCRLF & _
         "Result: Update applicable, not installed."
         updateIsApplicable = True
         updateToInstall.Add(update)
      Else 
         'Update is installed so notify user and quit
         WScript.Echo vbCRLF & _
         "Result: Update applicable, already installed."
         updateIsApplicable = True
         WScript.Quit 
      End If
   End If 
Next

If updateIsApplicable = False Then
   WScript.Echo "Result: Update is not applicable to this machine."
   WScript.Quit
End If

WScript.Echo vbCRLF & "Would you like to install now? (Y/N)"
stdInput = WScript.StdIn.Readline

If (strInput = "N" or strInput = "n") Then 
   WScript.Quit
ElseIf  (stdInput = "Y" OR stdInput = "y") Then
   'Download update
   Set downloader = updateSession.CreateUpdateDownloader() 
   downloader.Updates = updateToInstall
   WScript.Echo vbCRLF & "Downloading..."
   Set downloadResult = downloader.Download()
   WScript.Echo "Download Result: " & downloadResult.ResultCode

   'Install Update
   Set installer = updateSession.CreateUpdateInstaller()
   WScript.Echo vbCRLF & "Installing..."
   installer.Updates = updateToInstall
   Set installationResult = installer.Install()

   'Output the result of the installation
   WScript.Echo "Installation Result: " & _
   installationResult.ResultCode
   WScript.Echo "Reboot Required: " & _
   installationResult.RebootRequired 
End If
`

Answer 1

多么巧合。我刚刚根据这里的定义更新的直接链接提出了一个解决方案：http://support.microsoft.com/kb/971606。下载的文件大约为90 MB，但只有在预设的时间间隔内发布新定义时才会下载。只需将所有内容保存到脚本文件，然后根据您选择的时间间隔执行任务以运行脚本。在XP和win7上测试过。

Option Explicit

DefinitionUpdate 24 'for checking every 24 hours

Sub DefinitionUpdate(interval)
    'Updates definition files for Microsoft Security Essentials
    Dim aUrl, sFile, dMod, dTime
    If OSBits = 32 Then
        aUrl = UrlTarget("http://go.microsoft.com/fwlink/?LinkID=87342")
    Else
        aUrl = UrlTarget("http://go.microsoft.com/fwlink/?LinkID=87341")
    End If
    dMod = Replace(Split(Filter(aUrl, "Last-Modified")(0), ",")(1), "GMT", "")
    'exit if no update in interval
    If DateDiff("h", dMod, UTCDate(Now)) > interval Then Exit Sub
    With CreateObject("Scripting.FileSystemObject")
        'save to temporary folder
        sFile = .GetSpecialFolder(2) & "\" & Mid(aUrl(0), InStrRev(aUrl(0), "/") + 1)
        If .FileExists(sFile) Then .DeleteFile sFile, True
        HttpSave aUrl(0), sFile
        'wait max 3 min for file
        dTime = Now + TimeSerial(0, 3, 0)
        Do While Not .FileExists(sFile) And Now < dTime
            WScript.Sleep 1000
        Loop
        If .FileExists(sFile) Then
            With CreateObject("WScript.Shell")
                .Run sFile, 1, True
            End With
            .DeleteFile sFile, True
        End If
    End With
End Sub

Function UrlTarget(sUrl)
    'Returns array with url after redirections together with all responsheaders
    UrlTarget = sUrl
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        Do
            .Option(6) = False  'no auto redirect
            .SetTimeouts 5000,5000,30000,5000
            On Error Resume Next
            .Open "HEAD", UrlTarget, False
            .Send
            If .Status = 301 Or .Status = 302 Then  'permanent / temporary redirection
                UrlTarget = .GetResponseHeader("Location")
            ElseIf .Status = 200 Then
                UrlTarget = Split(UrlTarget & vbNewLine & .GetAllResponseHeaders, vbNewLine)
                Exit Do
            End If
        Loop
    End With
End Function

Sub HttpSave(sUrl, sFileName)
    'Save url to file
    Dim xHttp
    Set xHttp = CreateObject("Microsoft.XMLHTTP")
    xHttp.Open "GET", sUrl, False
    xHttp.send
    With CreateObject("Adodb.Stream")
        .type = 1 '//binary
        .Open
        .write xHttp.responseBody
        .savetofile sFileName, 2 '//overwrite
    End With
    Set xHttp = Nothing
End Sub

Function UTCDate(dateTime)
    'Returns UTC for dateTime
    With CreateObject("WbemScripting.SWbemDateTime")
        .SetVarDate(dateTime)
        UTCDate = .GetVarDate(False)
    End With
End Function

Function OSBits()
    'Returns 32 eller 64
    OSBits = GetObject("winmgmts:root\cimv2:Win32_Processor='cpu0'").AddressWidth
End Function

通过VBS Windows Update安装Microsoft Security Essentials的定义更新

1 个答案: