frmupdatecheck.frm

VB利用网络编写的一个实用小工具

Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Download by http://www.codefans.net
Option Explicit

Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long

Private Sub cmdGoOnline_Click()
    
    LaunchURLInNewBrowser "http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wua_sdk/wua/portal_client.asp"

End Sub

Private Sub cmdInstall_Click()
If lvUpdateNotInstalled.SelectedItem Is Nothing Then Exit Sub

MousePointer = 11

Dim objCollection As Object
Dim objSearcher As Object
Dim objResults As Object
Dim colUpdates As Object

    'install update
    Set objCollection = CreateObject("Microsoft.Update.UpdateColl")
    Set objSearcher = CreateObject("Microsoft.Update.Searcher")
    Set objResults = objSearcher.Search("UpdateID='" & lvUpdateNotInstalled.SelectedItem.SubItems(6) & "'")

    'Debug.Print "total:" & objResults.Updates.Count
    
    Set colUpdates = objResults.Updates 'ISearchResult.Updates
    objCollection.Add (colUpdates.Item(0))

    Dim updateSession As Object
    Dim downloader As Object
    Dim downloadResult As Object
    
    Set updateSession = CreateObject("Microsoft.Update.Session")
    Set downloader = updateSession.CreateUpdateDownloader()

    downloader.Updates = objCollection
    'Debug.Print "Downloading Update..."
    
    Set downloadResult = downloader.Download()
    
    Dim installer As Object
    Dim installationResult As Object
    Set installer = updateSession.CreateUpdateInstaller()
    
    'Debug.Print "Installing Update..."
    
    installer.Updates = objCollection
    Set installationResult = installer.Install()

    Select Case installationResult.ResultCode
        Case 0
            Debug.Print "Result: not started"
        Case 1
            Debug.Print "Result: in progress"
        Case 2
            Debug.Print "Result: succeeded"
        Case 3
            Debug.Print "Result: succeeded with errors"
        Case 4
            Debug.Print "Result: failed"
        Case 5
            Debug.Print "Result: aborted"
    
    End Select

SkipPast:

    Set installer = Nothing
    Set installationResult = Nothing
    
    Set downloader = Nothing
    Set downloadResult = Nothing
    
    Set updateSession = Nothing

    Set objCollection = Nothing
    Set objSearcher = Nothing
    Set objResults = Nothing
    Set colUpdates = Nothing


    cmdUpdate_Click

    MousePointer = 1
End Sub


Private Sub cmdOpenKB_Click()
    
    If Len(txtKB.Text) > 0 Then
        LaunchURLInNewBrowser "http://support.microsoft.com/default.aspx?kbid=" & txtKB.Text
    End If

End Sub


Private Sub cmdUpdate_Click()

Dim objSession As Object, objSearcher As Object
Dim colUpdates As Object, objResults As Object
Dim objCategories As Object

Dim objIdentity As Object, objInstallationBehavior As Object
Dim strInfo As Object

Dim i As Integer, x As Integer

On Error Resume Next

    lvUpdateInstalled.ListItems.Clear
    lvUpdateNotInstalled.ListItems.Clear
    lblDescription.Caption = "补丁描述:"

    MousePointer = 11
    
    'atl-ws-01 is the computer name
    'Set objSession = CreateObject("Microsoft.Update.Session", "atl-ws-01")
    
    If Len(txtRemote.Text) = 0 Then
        Set objSession = CreateObject("Microsoft.Update.Session")   'IUpdateSession
    Else
        Set objSession = CreateObject("Microsoft.Update.Session", txtRemote.Text)
    End If
    
    Set objSearcher = objSession.CreateUpdateSearcher 'IUpdateSession::CreateUpdateSearcher
            'IUpdateSearcher::Search
    Set objResults = objSearcher.Search("Type='Software'") 'ISearchResult
    Set colUpdates = objResults.Updates 'ISearchResult.Updates
            'IUpdateCollection
    
    
'try and get to IUpdate2 or IUpdateDownloadContentCollection - IUPdateDownloadContent

'http://download.microsoft.com/download/e/1/4/e14c0c02-591b-4696-8552-eb710c26a3cd/NDP1.1sp1-KB886903-X86.exe
Dim lvItem As ListItem

    For i = 0 To colUpdates.Count - 1   'IUpdate
        If colUpdates.Item(i).IsInstalled = "True" Then
            Set lvItem = frmUpdateCheck.lvUpdateInstalled.ListItems.Add(, , colUpdates.Item(i).Title, 0, 0)
            lvItem.Icon = 2
            lvItem.SmallIcon = 2
        Else
            Set lvItem = frmUpdateCheck.lvUpdateNotInstalled.ListItems.Add(, , colUpdates.Item(i).Title, 0, 0)
            lvItem.Icon = 3
            lvItem.SmallIcon = 3
        End If
        Dim UpdateState As String
        Select Case colUpdates.Item(i).MsrcSeverity
               Case "Critical"
               UpdateState = "紧急"
               Case "Important"
               UpdateState = "重要"
               Case "Moderate"
               UpdateState = "中等"
               Case ""
               UpdateState = "未知"
        End Select
                          
        lvItem.SubItems(2) = UpdateState
        
        If UpdateState = "紧急" Then
            lvItem.Icon = 4
            lvItem.SmallIcon = 4
        End If
        
        lvItem.SubItems(7) = colUpdates.Item(i).Description
        lvItem.SubItems(3) = IIf(colUpdates.Item(i).IsDownloaded = False, "未修复", "已修复")
        lvItem.SubItems(4) = colUpdates.Item(i).MaxDownloadSize
        lvItem.SubItems(5) = colUpdates.Item(i).LastDeploymentChangeTime
        lvItem.SubItems(6) = colUpdates.Item(i).Identity.UpdateID
    
    
        If colUpdates.Item(i).MoreInfoUrls.Count > 0 Then
            For x = 0 To colUpdates.Item(i).MoreInfoUrls.Count - 1
                lvItem.SubItems(1) = colUpdates.Item(i).MoreInfoUrls.Item(x)
            Next x
        End If
        
    Next i

    MousePointer = 1

ErrorHandler:
    If Err.Number > 0 Then
        MsgBox "Error:frmMain:cmdUpdate_Click:" & i & ":Line#:" & Erl & ":" & Err.Number & ":" & Err.Description
    End If
    
    Me.MousePointer = 1

    Set lvItem = Nothing
    
    Set strInfo = Nothing
    Set objSession = Nothing
    Set objSearcher = Nothing
    Set colUpdates = Nothing
    Set objResults = Nothing
    Set objCategories = Nothing
    Set objIdentity = Nothing
    Set objInstallationBehavior = Nothing

End Sub

Private Sub Form_Load()
    
    SplitBar.Orientation = espHorizontal
    SplitBarBottom.Orientation = espHorizontal

End Sub


Private Sub lvUpdateInstalled_Click()
    
    If lvUpdateInstalled.SelectedItem Is Nothing Then Exit Sub
    lblDescription.Caption = lvUpdateInstalled.SelectedItem.SubItems(7)
    
    Dim strName As String
    strName = lvUpdateInstalled.SelectedItem.Text
    If InStr(strName, "(KB") Then
        strName = Mid$(strName, InStr(strName, "(KB") + 3)
        txtKB.Text = Left$(strName, Len(strName) - 1)
    Else
        txtKB.Text = ""
    End If

End Sub

Private Sub lvUpdateInstalled_DblClick()
    
    If lvUpdateInstalled.SelectedItem Is Nothing Then Exit Sub
    
    LaunchURLInNewBrowser lvUpdateInstalled.SelectedItem.SubItems(1)

End Sub

Private Sub lvUpdateInstalled_KeyUp(KeyCode As Integer, Shift As Integer)
    
    lvUpdateInstalled_Click

End Sub

Private Sub lvUpdateNotInstalled_Click()
    If lvUpdateNotInstalled.SelectedItem Is Nothing Then Exit Sub
    lblDescription.Caption = lvUpdateNotInstalled.SelectedItem.SubItems(7)

    Dim strName As String

    strName = lvUpdateNotInstalled.SelectedItem.Text
    If InStr(strName, "(KB") Then
        strName = Mid$(strName, InStr(strName, "(KB") + 3)
        txtKB.Text = Left$(strName, Len(strName) - 1)
    Else
        txtKB.Text = ""
    End If

End Sub

Private Sub lvUpdateNotInstalled_DblClick()
    
    If lvUpdateNotInstalled.SelectedItem Is Nothing Then Exit Sub
    
    LaunchURLInNewBrowser lvUpdateNotInstalled.SelectedItem.SubItems(1)

End Sub

Private Sub lvUpdateNotInstalled_KeyUp(KeyCode As Integer, Shift As Integer)
    
    lvUpdateNotInstalled_Click

End Sub

Private Sub picBottom_Resize()
    
    lblDescription.Width = picBottom.Width - 20
    lblDescription.Height = picBottom.Height - lblDescription.Top
    Line1.X2 = picBottom.Width

End Sub

Private Sub Form_Resize()
    On Error Resume Next

    lvUpdateInstalled.Top = 0
    lvUpdateInstalled.Left = 0
    lvUpdateInstalled.Width = Me.ScaleWidth
    lvUpdateNotInstalled.Width = Me.ScaleWidth
    lvUpdateNotInstalled.Left = 0
    SplitBar.Width = Me.ScaleWidth
    SplitBarBottom.Width = Me.ScaleWidth
    lvUpdateInstalled.Height = SplitBar.Top
    lvUpdateNotInstalled.Top = SplitBar.Top + 30
    lvUpdateNotInstalled.Height = Me.ScaleHeight - 90 - SplitBar.Top - picBottom.ScaleHeight
    SplitBarBottom.Top = picBottom.Top - 45

End Sub

Private Sub SplitBar_AfterSize(newSize As Long)

    If newSize + SplitBar.Top + 2 > picBottom.Top Then Exit Sub
    If newSize + SplitBar.Top + 2 < 0 Then Exit Sub
    
    SplitBar.Top = SplitBar.Top + newSize
    Form_Resize

End Sub

Private Sub SplitBar_BeforeSize()
    
    ResizeSplitter

End Sub

Private Sub ResizeSplitter()

    Dim pRect As RECT

    GetWindowRect Me.hwnd, pRect
    SplitBar.RectLeft = pRect.Left
    SplitBar.RectRight = pRect.Right
    SplitBar.RectTop = pRect.Top + 5
    SplitBar.RectBottom = pRect.Bottom - 5

End Sub

Private Sub SplitBarBottom_AfterSize(newSize As Long)
    
    picBottom.Height = picBottom.Height - newSize
    Form_Resize

End Sub

Private Sub SplitBarBottom_BeforeSize()
    
    ResizeSplitterBottom

End Sub

Private Sub ResizeSplitterBottom()

    Dim pRect As RECT

    GetWindowRect Me.hwnd, pRect
    SplitBarBottom.RectLeft = pRect.Left
    SplitBarBottom.RectRight = pRect.Right
    SplitBarBottom.RectTop = pRect.Top + 5
    SplitBarBottom.RectBottom = pRect.Bottom - 5
End Sub