VB.NET实现应用程序自动更新2-CSDN博客

VB.NET实现应用程序自动更新2

2008/08/02 12:52

    Protected Overrides ReadOnly Property CreateParams() As System.Windows.Forms.CreateParams '禁用系統關閉按鈕，屏蔽ALT+F4
        Get
            Const CS_NOCLOSE As Integer = &H200
            Dim cp As CreateParams = MyBase.CreateParams
            cp.ClassStyle = cp.ClassStyle Or CS_NOCLOSE
            Return cp
        End Get
    End Property

    '载入
    Private Sub update_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        ' Dim a As String = CStr(Me.Handle.ToInt32)
        ' Dim b As Short = 0
        ' Dim flag As Object
        Dim SwfPath As String = Application.StartupPath & "/images/login.swf"
        ' Call Myapi.Disabled(CShort(a), CShort(b)) '让关闭X不可用
        Call Reset()
        Call GetAddress()
        ' MsgBox(SwfPath)

        AxWebBrowser1.Navigate(SwfPath)

        For x As Integer = 0 To 10
            Application.DoEvents()
        Next
        btnupdate_Click(New System.Object, New System.EventArgs) '執行更新

End Sub

    '还原状态
    Private Sub Reset()
        PictureBox1.Image = Image.FromFile(Ready)
        PictureBox2.Image = Image.FromFile(Ready)
        PictureBox3.Image = Image.FromFile(Ready)
        PictureBox4.Image = Image.FromFile(Ready)
        PictureBox5.Image = Image.FromFile(Ready)
        PictureBox6.Image = Image.FromFile(Ready)
        PictureBox7.Image = Image.FromFile(Ready)
        PictureBox8.Image = Image.FromFile(Ready)

    End Sub

    '让btn可用
    Private Sub Resetbtn()
        btnupdate.Enabled = True
        btnclose.Enabled = True
    End Sub

    '检测文件夹是否存在,不存在则建立
    Private Sub ChkExsitFolder(ByVal foldername As String)
        If fso.FolderExists(foldername) = False Then
            fso.CreateFolder(foldername)
        End If
    End Sub

    '检测文件是否存在，返回boolean值
    Private Function ChkExsitFile(ByVal filename As String) As Boolean
        Return fso.FileExists(filename)
    End Function

    '获取文件版本信息获取成功返回版本值,不成功返回nothing
    Private Function Getcurversion(ByVal filepath As String) As String
        Try
            Curversion = FileVersionInfo.GetVersionInfo(filepath).FileVersion.ToString
            Return Curversion
        Catch ex As Exception
            Return Nothing
        End Try
    End Function

    '获取配置文件中的地址地址最后必须加上"/"
    Private Sub GetAddress()
        Try
            Address = Func.GetKeyVal(Inipath, "serverpath", "address")
            SleepTime = Func.GetKeyVal(Inipath, "serverpath", "Time")
            RunProgrom = Func.GetKeyVal(Inipath, "serverpath", "Run")
            KillProgrom = Func.GetKeyVal(Inipath, "serverpath", "Kill")

        Catch ex As Exception
            lbl.Text = "獲取系統參數失败..."
            Resetbtn()
            Exit Sub
        End Try
    End Sub

    '测试连接到服务器并下载升级文件
    Private Sub Connectsvr()
        PictureBox1.Image = Image.FromFile(down)
        Try
            If fso.FolderExists(Tempfolder) = False Then '如果不存在临时文件夹子，则先建立
                fso.CreateFolder(Tempfolder)
            End If
            MyWebClient.DownloadFile(address & "update.XML", Tempfolder & "/update.xml")
        Catch ex As Exception
            lbl.Text = "连接服务器失败..."
            PictureBox1.Image = Image.FromFile(Err)
            Resetbtn()
            Exit Sub
        End Try
    End Sub

    '检查更新版本读取数据集如果数据集为空则失败
    Private Sub Getnewversion()
        PictureBox2.Image = Image.FromFile(down)
        Try
            UpdateDataSet.ReadXml(Tempfolder & "/update.xml")
            '   MsgBox(updateDataSet.Tables(0).Rows.Count)
            If UpdateDataSet.Tables(0).Rows.Count <= 0 Or (UpdateDataSet Is Nothing) Then
                lbl.Text = "检查可更新版本失败..."
                Reset()
            End If
        Catch ex As Exception
            lbl.Text = "检查可更新版本失败..."
            PictureBox2.Image = Image.FromFile(Err)
            Resetbtn()
            Exit Sub
        End Try
    End Sub

    '分析更新版本并获取所有要下载的字节数
    Private Sub ChkUpdate()
        PictureBox3.Image = Image.FromFile(down)
        Alldownloadbyte = 0
        ChkUpdateMethod()
        If UpdateDataSet.Tables("file").Rows.Count = 0 Then
            lbl.Text = "您目前的版本已经是最新版..."
            Resetbtn()
            System.Threading.Thread.Sleep(2000) '1.5秒后打開主程序
            RunMainProgrom()
            Exit Sub
        Else
            Call ChkAlldownloadbtye() '獲取字節數
        End If
    End Sub
    Private Sub RunMainProgrom()
        On Error Resume Next
        Call DelTmpFiles()
        System.Diagnostics.Process.Start(Application.StartupPath & "/" & RunProgrom)
        ' Me.Close()
        ' Runthread.Abort()
        Application.Exit()
    End Sub

    '分析更新版本具体方法，采用了递归
    Private Sub ChkUpdateMethod()
        Dim i As Integer
        Try
            For i = 0 To UpdateDataSet.Tables(0).Rows.Count - 1
                '分析存在性,如果不存在则是需要升级的,如果存在分析版本如果版本为空则分析最后修改时间
                If ChkExsitFile(Application.StartupPath & UpdateDataSet.Tables("file").Rows(i)("target")) = True Then
                    '如果版本号相等则删除此行
                    If Func.cdbnull(UpdateDataSet.Tables("file").Rows(i)("version")) <> "" Then
                        If Getcurversion(Application.StartupPath & UpdateDataSet.Tables("file").Rows(i)("target")) = UpdateDataSet.Tables("file").Rows(i)("version") Then
                            UpdateDataSet.Tables("file").Rows.Item(i).Delete()
                            ChkUpdateMethod()
                            Exit Sub
                            'Else
                            ' Alldownloadbyte += UpdateDataSet.Tables("file").Rows(i)("filelength")
                        End If
                    Else
                        '如果修改时间大于或者相等则删除此行
                        fl = fso.GetFile(Application.StartupPath & UpdateDataSet.Tables("file").Rows(i)("target"))
                        If fl.DateLastModified >= CType(UpdateDataSet.Tables("file").Rows(i)("lastmodifydate"), Date) Then
                            UpdateDataSet.Tables("file").Rows.Item(i).Delete()
                            ChkUpdateMethod()
                            Exit Sub
                            'Else
                            ' Alldownloadbyte += UpdateDataSet.Tables("file").Rows(i)("filelength")
                        End If
                    End If
                    'Else
                    ' Alldownloadbyte += UpdateDataSet.Tables("file").Rows(i)("filelength")
                End If
            Next
        Catch ex As Exception
            lbl.Text = "升级失败,无法分析更新版本..."
            PictureBox3.Image = Image.FromFile(Err)
            Resetbtn()
            Exit Sub
        End Try
    End Sub
    Private Sub ChkAlldownloadbtye()
        Try
            For i As Integer = 0 To UpdateDataSet.Tables("file").Rows.Count
                Alldownloadbyte += UpdateDataSet.Tables("file").Rows(i)("filelength")
            Next
        Catch ex As Exception

End Try
End Sub

    Private Sub Downfiles()
        Connectsvr()
        If btnupdate.Enabled = True Then
            Exit Sub
        End If
        Getnewversion()
        If btnupdate.Enabled = True Then
            Exit Sub
        End If
        ChkUpdate()
        If btnupdate.Enabled = True Then
            Exit Sub
        End If
        Dim i As Integer
        Dim srm As Stream = Nothing
        Dim mbyte() As Byte
        Dim allbyte As Long
        Dim startbyte As Integer
        Dim m As Integer
        Dim fs As FileStream
        Dim myre As HttpWebRequest = Nothing
        Dim mwrite As HttpWebResponse
        Dim wc As WebClient = New WebClient
        'Dim myCredential As New NetworkCredential '("pengli@triopy", "fairy")
        'wc.Credentials = myCredential
        PictureBox4.Image = Image.FromFile(down)
        Progressdownload.Position = 0 '总的进度
        Progressdownload.Properties.Maximum = Alldownloadbyte
        ' MsgBox(Alldownloadbyte)
        Try
            For i = 0 To UpdateDataSet.Tables("file").Rows.Count - 1
                GroupBox1.Text = "下载进度(" & (i + 1).ToString & "/" & UpdateDataSet.Tables("file").Rows.Count & ")"
                ProgressCdownload.Position = 0 '设置当前进度为0
                startbyte = 0 '开始下载的位置为0
                ReDim mbyte(CLng(UpdateDataSet.Tables("file").Rows(i)("filelength"))) '本也可以直接获取文件大小，但是很占用资源，干脆写在配置文件内
                ' MsgBox(UpdateDataSet.Tables("file").Rows(i)("filelength"))
                myre = CType(WebRequest.Create(UpdateDataSet.Tables("file").Rows(i)("downurl")), HttpWebRequest)
                ' MsgBox(UpdateDataSet.Tables("file").Rows(i)("downurl").ToString)
                mwrite = CType(myre.GetResponse(), HttpWebResponse)
                srm = wc.OpenRead(UpdateDataSet.Tables("file").Rows(i)("downurl"))
                allbyte = mbyte.Length
                ' MsgBox(allbyte)
                ProgressCdownload.Properties.Maximum = allbyte
                ProgressCdownload.Position = 0
                Do While UpdateDataSet.Tables("file").Rows(i)("filelength") > 0
                    m = srm.Read(mbyte, startbyte, allbyte)
                    If m = 0 Then Exit Do
                    startbyte += m
                    allbyte -= m
                    ProgressCdownload.Position += m
                    Progressdownload.Position += m
                Loop

                fs = New FileStream(Tempfolder & "/" & UpdateDataSet.Tables("file").Rows(i)("filename"), FileMode.Create)
                'Try
                fs.Write(mbyte, 0, mbyte.Length)
                'Catch ex As Exception
                '    MsgBox(ex.ToString)
                '    Resetbtn()
                'End Try

                fs.Flush()
                fs.Close()
                myre.Abort() '这里必须释放资源,否则下载多个文件出现连接超时错误
                srm.Close()
                Thread.Sleep(SleepTime) '这里每下一个文件让线程等待2秒,太快可能服务器没有响应
            Next
            Progressdownload.Position = Alldownloadbyte '防止人为写错字节数不到100的现象
        Catch ex As Exception
            lbl.Text = "下载更新文件失败..."
            PictureBox4.Image = Image.FromFile(Err)
            Resetbtn()
            myre.Abort()
            srm.Close()

            Exit Sub
        End Try
        Closeexe()
        UpdateFile()
        DelTmpFiles()
        If btnupdate.Enabled = True Then
            Exit Sub
        End If
        Startexe()
    End Sub

    '关闭应用程序
    Private Sub Closeexe()
        PictureBox5.Image = Image.FromFile(down)
        Func.killprogress(KillProgrom) '这里是我引用的一个类，用来杀进程的
    End Sub

    '更新要升级的文件
    Private Sub UpdateFile()
        PictureBox6.Image = Image.FromFile(down)
        Try
            Dim i As Integer
            ' Dim flcopy As IO.File
            For i = 0 To UpdateDataSet.Tables("file").Rows.Count - 1
                IO.File.Copy(Tempfolder & "/" & UpdateDataSet.Tables("file").Rows(i)("filename"), Application.StartupPath & UpdateDataSet.Tables("file").Rows(i)("target"), True)
            Next
        Catch ex As Exception
            lbl.Text = "升级到新版本失败,可能应用程序未关闭..."
            PictureBox6.Image = Image.FromFile(Err)
            Resetbtn()
            Exit Sub
        End Try
    End Sub

    '删除文件
    Private Sub DelTmpFiles()
        PictureBox7.Image = Image.FromFile(down)
        Try
            fso.DeleteFolder(Tempfolder, True)
        Catch ex As Exception
            PictureBox7.Image = Image.FromFile(Err)
            Exit Sub
        End Try
    End Sub

    '启动应用程序
    Private Sub Startexe()
        PictureBox8.Image = Image.FromFile(down)
        Try
            'Call DelTmpFiles()
            System.Diagnostics.Process.Start(Application.StartupPath & "/" & RunProgrom)
            ' Me.Close()
            Application.Exit()
        Catch ex As Exception
            lbl.Text = "更新成功,但未能启动应用程序,请手动启动..."
            PictureBox8.Image = Image.FromFile(Err)
        Finally
            btnclose.Enabled = True
        End Try
    End Sub

    '升级
    Private Sub btnupdate_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnupdate.Click
        ' updateDataSet.ReadXml(Application.StartupPath & "/update.xml")
        Reset()
        btnupdate.Enabled = False
        ' btnclose.Enabled = False
        GroupBox1.Text = "下载进度"
        lbl.Text = ""
        UpdateDataSet.Clear()
        Runthread = New Thread(AddressOf Downfiles) '不知道为什么，用了JOIN后将会出现卡屏，用线程池/完成事件/轮循都不行，我只有把其他事件放在这个线程里了。郁闷
        Runthread.Start()
        'runthread.Join()
    End Sub

    Private Sub btnclose_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnclose.Click
        On Error Resume Next
        Me.Hide()
        Call DelTmpFiles()
        System.Diagnostics.Process.Start(Application.StartupPath & "/" & RunProgrom)
        ' Me.Close()
        ' Runthread.Abort()
        Application.Exit()
    End Sub

    Private Sub LinkLabel1_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs)
        System.Diagnostics.Process.Start("IExplore.exe", "http://www.triopy.com/tmics/")
    End Sub
End Class

'類文件

Public Class func

Private Myapi As New Fairy4_Api.My_Api

    Public Function cdbnull(ByVal str As String) As String
        Return str.Trim
    End Function
    Public Sub killprogress(ByVal strName As String)
        Dim pProcess() As Process
        pProcess = Process.GetProcesses()
        Dim i As Integer
        For i = 0 To pProcess.Length() - 1
            If (pProcess(i).ProcessName.ToUpper = strName) Then
                pProcess(i).Kill() '關閉進程
            End If
        Next

    End Sub
    Public Function GetKeyVal(ByVal path As String, ByVal Section As String, ByVal AppName As String) As String
        GetKeyVal = Myapi.GetINI(Section, AppName, "", path)

End Function

End Class

’對原程序做了部分優化，使用比較穩定，但在調式時，易發生空間正在使用異常。這個可能是

DevExpress控件的原因。