frmmain.frm

VB开发的自动更新程序

    ElseIf x = 9999 Then '---------------------- 9999 is our notification icon
        Call ListScanResults '------------------ Press-on with success or failure
        Exit Sub
    Else '-------------------------------------- Else represents all update files
        '//First update the listview icon if required
        If bUpdateIcons Then Call UpdateIcon(CInt(Identifier))
        With FileList
            Select Case Result
                Case eSUCCESS
                    .Status(x) = DOWNLOADED
                    Me.lvFiles.ListItems(x).SubItems(1) = "更新队列"
                Case eCONNECTERROR
                    Me.lvFiles.ListItems(x).SubItems(1) = "链接错误"
                    If Setup.RunMode <> eNORMAL Then
                        If .MustUpdate(x) Then
                            GoTo UnloadNow
                        Else
                            .Status(x) = ERRCONNECTING
                            Call ResetProgressBar '------ Adjust total download bytes for progress bar
                        End If
                    Else
                        '//Advise user of error and request a course of action
                        Select Case frmDLError.RequestAction(CStr(x), CONNECTERROR)
                            Case 0: '-------------------- Retry
                                .Status(x) = UPDATEREQ
                                Call ResetProgressBar '-- Adjust total download bytes for progress bar
                            Case 1: '-------------------- Continue
                                .Status(x) = ERRCONNECTING
                                With Me.lvFiles.ListItems(x)
                                    .ForeColor = 255
                                    .ListSubItems(1).ForeColor = 255
                                End With
                                Me.lvFiles.Refresh '----- Repaint lvFiles to reflect red text (found this was needed)
                                Call ResetProgressBar '-- Adjust total download bytes for progress bar
                            Case 2: '-------------------- Abort
                                .Status(x) = ERRCONNECTING
                                Call ShowLiveUpdateError(eluFILEDOWNLOADERR)
                                Exit Sub
                        End Select
                    End If
                    
                Case eTRANSFERERROR, eWRITEERROR
                    Me.lvFiles.ListItems(x).SubItems(1) = "传送错误"
                    If Setup.RunMode <> eNORMAL Then
                        If .MustUpdate(x) Then
                            GoTo UnloadNow
                        Else
                            .Status(x) = ERRTRANSFERRING
                            Call ResetProgressBar '-- Adjust total download bytes for progress bar
                        End If
                    Else
                        '//Advise user of error and request a course of action
                        Select Case frmDLError.RequestAction(CStr(x), TRANSFERERROR)
                            Case 0: '-------------------- Retry
                                FileList.Status(x) = UPDATEREQ
                                Call ResetProgressBar '-- Adjust total download bytes for progress bar
                            Case 1: '--------------------Abort
                                .Status(x) = ERRTRANSFERRING
                                Call ShowLiveUpdateError(eluFILEDOWNLOADERR)
                                Exit Sub
                            Case 2: '-------------------- Continue
                                .Status(x) = ERRTRANSFERRING
                                With Me.lvFiles.ListItems(x)
                                    .ForeColor = 255
                                    .ListSubItems(1).ForeColor = 255
                                End With
                                Me.lvFiles.Refresh '----- Repaint lvFiles to reflect red text (found this was needed)
                                Call ResetProgressBar '-- Adjust total download bytes for progress bar
                        End Select
                    End If
            End Select
        End With
    End If
    Call SequenceDownloads '----------------------------- Check for more downloads
    Exit Sub
UnloadNow:
        bJustExit = True
        Unload Me
End Sub

Private Sub ListScanResults()
'-----------------------------------------------------------------------------------------
' Purpose   : Post update list and prepare frmMain for downloading files when available.
'             Only called from ucDL_DownloadComplete when the update script is downloaded.
'-----------------------------------------------------------------------------------------
On Error GoTo Errs
Dim x               As Integer
Dim iCurrents       As Integer
Dim bProceed        As Boolean
Dim bAbort          As Boolean
    With FileList
        For x = 1 To UBound(.Description)
            '//Get an icon, hopefully from an existing file, and load into the imagelist
            If Setup.ShowFileIcons Then
                Me.iml.ListImages.Add x, x & "|", GetIcon(.InstallPath(x), SHGFI_SMALLICON)
                Me.lvFiles.ListItems.Add x, .Description(x), .Description(x), , x
            Else
                Me.lvFiles.ListItems.Add x, .Description(x), .Description(x)
            End If
            Me.lvFiles.ListItems(x).ToolTipText = .Description(x)
            If .Status(x) = UPDATEREQ Then
                lTotalDlSize = lTotalDlSize + .FileSize(x)
                Me.lvFiles.ListItems(x).SubItems(1) = "可用更新"
                bProceed = True
            ElseIf .Status(x) = FILENOTINSTALLED Then
                With Me.lvFiles.ListItems(x)
                    .SubItems(1) = "安装信息没有找到"
                    .ForeColor = 255
                    .ListSubItems(1).ForeColor = 255
                End With
                If .MustUpdate(x) Then bAbort = True
            Else
                Me.lvFiles.ListItems(x).SubItems(1) = "当前安装信息"
                iCurrents = iCurrents + 1
            End If
        Next x
    End With
    '//We are here because we have successfully downloaded the script and scanned for updates.
    '..All user privileges are good and files exist on client that must to perform updates.
    Setup.LastChecked = Date '--------------------------------- Update the "Last Checked" date.
    Call AltLVBackground(Me.lvFiles, vbWhite, oleLiteGray) '--- Draw alternating lvList colors
    If bAbort Then
        '//At least one required file was not found on client
        If Setup.RunMode <> eNORMAL Then GoTo UnloadNow '------ Bolt in NOTIFY and AUTO modes
        With Me.cmdReport
            .Caption = "报告(&R)"
            .Move Me.cmdCancel.Left, Me.cmdCancel.Top
            .Visible = True
        End With
        Me.cmdCancel.TabStop = False
        Me.lblTotal.Visible = False
        Me.lblContinue.Caption = "您可以选择报告查看详细内容或者退出更新程序."
        With Me.frmList
            .Caption = "在线更新程序下载一些有效的更新时失败."
            .ZOrder
            .Visible = True
        End With
        With Me.cmdNext
            .Caption = "退出(&E)"
            .Enabled = True
            .SetFocus
        End With
        bJustExit = True '------------------------ Skip Yes/No exit dialog
        bStep = 2
    Else
        If bProceed Then
            '//There are updates available
            Me.lblTotal.Caption = "总计下载: " & IIf(lTotalDlSize > 1000, Format(lTotalDlSize / 1000, "#,##0K"), Format(lTotalDlSize, "##0 字节"))
            With Me.cmdNext
                .Enabled = True
                If Me.Visible Then .SetFocus
            End With
            Me.lblContinue.Caption = "请单击下一步下载和安装更新..."
            With Me.cmdReport
                .Visible = True
            End With
            With Me.frmList
                .ZOrder
                .Visible = True
            End With
            bStep = 1
            If Setup.RunMode = eNOTIFY Then
                Call frmNotify.Notify
            ElseIf Setup.RunMode = eAUTO Then
                Call cmdNext_Click
            End If
        Else
            '//There are no updates available
            If Setup.RunMode <> eNORMAL Then GoTo UnloadNow
            With Me.cmdReport
                .Caption = "报告(&R)"
                .Move Me.cmdCancel.Left, Me.cmdCancel.Top
                .Visible = True
            End With
            Me.cmdCancel.TabStop = False
            With Me.cmdNext
                .Caption = "退出(&E)"
                .Enabled = True
                .SetFocus
            End With
            Me.lblTotal.Visible = False
            Me.lblContinue.Caption = "您可以选择报告查看详细内容或者退出更新程序."
            With Me.frmList
                If iCurrents = UBound(FileList.Description) Then '-- See if all files were current
                    .Caption = "此时不能更新. "
                Else
                    .Caption = "在线更新程序下载一些有效的更新时失败."
                End If
                .ZOrder
                .Visible = True
            End With
            bJustExit = True '----------------------- Skip Yes/No exit dialog
            bStep = 2
        End If
    End If
Errs_Exit:
    Screen.MousePointer = vbDefault
    Exit Sub
Errs:
    If Setup.RunMode = eNORMAL Then '---------------- Exit app if not in Normal mode
        Call ShowLiveUpdateError(eluFILEPROCESSERR)
        Resume Errs_Exit
    End If
UnloadNow:
    bJustExit = True
    Screen.MousePointer = vbDefault
    Unload Me
End Sub

Private Sub SequenceDownloads()
'-----------------------------------------------------------------------------------
' Purpose   : Recursively called from ucDL_DownloadComplete when update files
'             finish downloading (Good or Bad). Update file downloads are started
'             here, and LiveUpdate continues when there are no more UPDATEREQ flags.
'-----------------------------------------------------------------------------------
Dim x   As Long
Dim y   As Long
    With FileList '------------------------ See if there is anything left to download
        y = UBound(.Status)
        For x = 1 To y
            If .Status(x) = UPDATEREQ Then
                .Status(x) = DOWNLOADING
                Me.lvFiles.ListItems(x).SubItems(1) = "连接中"
                Me.ucDL.Download FileList.DownloadURL(x), CStr(x)
                Exit Sub '----------------- Bolt if we begin a download
            End If
        Next x
        Me.lvFiles.ListItems(1).EnsureVisible
        '//All downloads have now been attempted. Now see if any are ready to install.
        '..If none are ready it is because they failed to download successfully.
        For x = 1 To y
            If .Status(x) = DOWNLOADED Then Exit For
        Next x
    End With
    If x <= y Then
        '//Atleast one file is UPDATEREADY so lets begin installing
        Me.lblTotal.Visible = False
        Me.pbDownload.Visible = False
        Call InstallUpdates '---------------- Begin installing updates
    Else
        '//There are no updates ready to install so prepare frmMain and standby to exit
        If Setup.RunMode <> eNORMAL Then GoTo UnloadNow '-- Bolt if in auto or notify mode
        Me.frmList.Caption = "此时将准备安装这些更新..."
        Me.lblContinue.Caption = "选择退出降关闭程序."
        With Me.cmdNext
            .Caption = "退出(&E)"
            .Enabled = True
        End With
        With Me.cmdReport
            .Caption = "报告(&R)"
            .Move Me.cmdCancel.Left, Me.cmdCancel.Top
        End With
        Me.cmdCancel.TabStop = False
        bJustExit = True '------------------- Skip Yes/No exit dialog
        bStep = 2
        Me.lblTotal.Visible = False
        Me.pbDownload.Visible = False
    End If
Errs:
    Screen.MousePointer = vbDefault
    Exit Sub
UnloadNow:
    bJustExit = True
    Unload Me
End Sub

Private Sub InstallUpdates()
'---------------------------------------------------------------------------------------
' Purpose   : Check for the running app and begin installing updates if they all pass
'             the VerifyInstallReady test. Only called from the SequenceDownloads sub.
'---------------------------------------------------------------------------------------
On Error GoTo Errs
Dim x       As Long
Dim bErrors As Boolean
Dim lResult As eupdResults
    With Setup '-------------------- Check to see if program is running and act accordingly.
        If Len(.UpdateAppTitle) And .RunMode = eNORMAL Then
            If IsAppRunning(.UpdateAppTitle, .UpdateAppClass) Then
                If .UpdateAppKill Then
                    Call KillApp '------------------------ Kill app without notification
                Else
                    Call frmCloseApp.WarnAppIsRunning '--- Warn user and recommend killing app
                End If
                If Len(Setup.LaunchIfKilled) Then '------- Mark if app was killed for restarting when complete
                    Erase tRunningApps.lWndHwnd: Erase tRunningApps.lWndProcessID