管理首页
VB.Net程序设计:AutoUpdater软件自动更新-源代码 Imports System.Xml    Imports System.IO    Imports System.Net    Imports System.Diagnostics    Imports System.ComponentModel    Imports System.Threading       Public Class FrmMain           Dim configFileName As String = "AutoUpdateConfig.xml"       Dim saveUpdateFolder As String = Application.StartupPath & "\Update"       Dim serverXmlFilePath As String = IO.Path.Combine(saveUpdateFolder, configFileName)        Dim localXmlFilePath As String = IO.Path.Combine(Application.StartupPath, configFileName)           Dim updateUrl As String = String.Empty           Dim LocalXmlFileS As XmlFiles = Nothing       Dim ServerXmlFileS As XmlFiles = Nothing       Dim MainAppName As String = String.Empty           Dim DeleteFileList As New List(Of DownloadFileInfo)        Dim DownLoadFileList As New List(Of DownloadFileInfo)        Dim RunOnceExeFileList As New List(Of DownloadFileInfo)        Dim RunOnceExeFileListHelp As New List(Of DownloadFileInfo)        Dim AllDownLoadFileList As New List(Of DownloadFileInfo)           '判断用户是否点击了取消按钮。        Dim isCancelDownLoad As Boolean = False       '判断下载文件任务是否完成。        Dim isFinishDownLoad As Boolean = True          Dim myWebClient As WebClient           Public Shared evtPerDonwload As ManualResetEvent           Private Delegate Sub ShowMsgCallBack(ByVal msg As String)        Private Delegate Sub SetBtnTextCallBack(ByVal text As String)           <Browsable(True), DefaultValue("AutoUpdateConfig.xml"), Description("服务器和本地机上的自动更新文件.")> _        Property AutoUpdateConfigFileName() As String           Get               Return configFileName            End Get           Set(ByVal value As String)                configFileName = value            End Set       End Property          Private Function DownLoadFile(ByVal url As String, ByVal filename As String) As Boolean           Return DownLoadFile(url, filename, String.Empty, String.Empty)        End Function          Private Function DownLoadFile(ByVal url As String, ByVal filename As String, ByVal user As String, ByVal pwd As String) As Boolean           Dim client As New WebClient()            Try               If String.IsNullOrEmpty(user) Then                   client.Credentials = CredentialCache.DefaultCredentials                Else                   client.Credentials = New NetworkCredential(user, pwd)                End If               client.DownloadFile(url, filename)                client.Dispose()                Return True           Catch ex As Exception                Return False           End Try       End Function          Private Sub loadPic()            Dim rnd As New System.Random            Select Case rnd.Next(1, 4)                Case 1                    Me.PicBox.Image = My.Resources.ImgPCArrow                Case 2                    Me.PicBox.Image = My.Resources.ImgBits                Case 3                    Me.PicBox.Image = My.Resources.ImgNetPeople            End Select       End Sub          Private Sub FrmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load            loadPic()            myWebClient = New WebClient()            '注意删除目录,也可以不删除。            If IO.Directory.Exists(saveUpdateFolder) = False Then IO.Directory.CreateDirectory(saveUpdateFolder)            'Me.PnlDownInfo.Visible = False            '检测是否有更新文件。            If CheckForUpdate() = False Then               Application.Exit()            End If       End Sub          Public Function CheckForUpdate() As Boolean           Try               '从本地读取更新配置文件信息                 LocalXmlFileS = New XmlFiles(localXmlFilePath)                MainAppName = LocalXmlFileS.GetNodeValue("//AppExeName")            Catch               MessageBox.Show("本地Xml配置文件出错!", "错误", MessageBoxButtons.OK, MessageBoxIcon.Error)                Return False           End Try           '获取服务器地址xpath //Url从匹配选择的当前节点选择文档中的节点,而不考虑它们的位置            updateUrl = LocalXmlFileS.GetNodeValue("//UpdateUrl")               '--第一种下载方法。复杂一点。            '下载服务器xml文件到serverXmlFile 可以有用户和密码下载。            'Dim loadxmlC As New LoadXmlConfig            'loadxmlC.LoadConfig(updateUrl & "/" & AutoUpdateConfigFileName, serverXmlFilePath)            'If String.Compare(loadxmlC.AppVersion, LocalXmlFileS.GetNodeValue("//AppVersion")) > 0 Then            '    Return True            'End If            'Return False            '--第二种下载方法。简单。            'Dim client As New WebClient()            'client.Credentials = CredentialCache.DefaultCredentials            'client.Credentials = New NetworkCredential("user", "pass")            'Dim strXml As String = client.DownloadString(updateUrl & "/" & AutoUpdateConfigFileName)            'Dim listRemotFile As Dictionary(Of String, RemoteFile) = ParseRemoteXml(strXml)               If DownLoadFile(updateUrl & "/" & AutoUpdateConfigFileName, serverXmlFilePath) Then               ServerXmlFileS = New XmlFiles(serverXmlFilePath)                MainAppName = ServerXmlFileS.GetNodeValue("//AppExeName")            Else               MessageBox.Show("下载服务器Xml配置文件出错!", "错误", MessageBoxButtons.OK, MessageBoxIcon.Error)                Return False           End If           If String.Compare(ServerXmlFileS.GetNodeValue("//AppVersion"), LocalXmlFileS.GetNodeValue("//AppVersion")) > 0 Then               If MessageBox.Show("发现有新版本,是否进行更新?", "自动更新程序", MessageBoxButtons.YesNo, MessageBoxIcon.Information) = Windows.Forms.DialogResult.Yes Then                   Me.LBVerInfo.Text = String.Format("新版本:{0} 更新日期:{1}", ServerXmlFileS.GetNodeValue("//AppVersion"), ServerXmlFileS.GetNodeValue("//LastUpdateTime"))                    If String.IsNullOrEmpty(ServerXmlFileS.GetNodeValue("//UpdateDescription")) = False Then Me.Text = ServerXmlFileS.GetNodeValue("//UpdateDescription")                    CheckUpdateFileList()                    Return True               Else                   Return False               End If           Else               If CheckLocalFileList() = False Then                   '这个结果表示:有文件遗漏,要重新下载文件。                    Me.LBVerInfo.Text = String.Format("新版本:{0} 更新日期:{1}", ServerXmlFileS.GetNodeValue("//AppVersion"), ServerXmlFileS.GetNodeValue("//LastUpdateTime"))                    If String.IsNullOrEmpty(ServerXmlFileS.GetNodeValue("//UpdateDescription")) = False Then Me.Text = ServerXmlFileS.GetNodeValue("//UpdateDescription")                    Return True               Else                   MessageBox.Show("当前版本已经是最新版本了", "自动更新程序", MessageBoxButtons.OK)                    Return False               End If           End If       End Function          Private Function ParseXmlFileList(ByVal xmlNodeList As XmlNodeList) As Dictionary(Of String, DownloadFileInfo)            Dim list As New Dictionary(Of String, DownloadFileInfo)            'Dictionary跟HashTable原理一样:Dictionary 类是作为一个哈希表来实现的。            'Dim ht As New Hashtable()            'ht.Add("key as object", "value as object")            'ht.Contains ,ht.ContainsKey, ht.ContainsValue            For Each node As XmlNode In xmlNodeList                list.Add(node.Attributes("Name").Value, New DownloadFileInfo(node.Attributes("Name").Value, node.Attributes("Ver").Value))            Next           Return list        End Function          Private Sub CheckUpdateFileList()            '通过对比文件列表,获取下载列表和删除本地文件列表            '如果更新文件列表有误。没办法更新。打开主程序。            If LocalXmlFileS IsNot Nothing And ServerXmlFileS IsNot Nothing Then               Dim newNodeList As XmlNodeList = ServerXmlFileS.GetNodeList("AutoUpdater/UpdateFileList")                Dim oldNodeList As XmlNodeList = LocalXmlFileS.GetNodeList("AutoUpdater/UpdateFileList")                Dim node As XmlNode                Dim fname, lastver As String                  Dim serverDirList As Dictionary(Of String, DownloadFileInfo)                serverDirList = ParseXmlFileList(newNodeList)                   If ServerXmlFileS.FindNode("AutoUpdater/RunOnceExeFileList") IsNot Nothing Then                   For Each node In ServerXmlFileS.GetNodeList("AutoUpdater/RunOnceExeFileList")                        RunOnceExeFileList.Add(New DownloadFileInfo(node.Attributes("Name").Value, node.Attributes("Ver").Value))                    Next               End If                  If ServerXmlFileS.GetNodeList("AutoUpdater/RunOnceExeFileListHelp") IsNot Nothing Then                   For Each node In ServerXmlFileS.GetNodeList("AutoUpdater/RunOnceExeFileListHelp")                        RunOnceExeFileListHelp.Add(New DownloadFileInfo(node.Attributes("Name").Value, node.Attributes("Ver").Value))                    Next               End If                  '取本地xml配置文件的每一个<File>和服务器xml配置文件的新旧。                For Each node In oldNodeList                    fname = node.Attributes("Name").Value                    lastver = node.Attributes("Ver").Value                    If serverDirList.ContainsKey(fname) Then                       '若本地<File>与服务器<File>文件同时存在。                        Dim dir As DownloadFileInfo = serverDirList(fname)                        '比较新旧版本,服务器的新就添加到下载列表中。                        If String.Compare(dir.LastVer, lastver) > 0 Then                           DownLoadFileList.Add(dir)                        End If                       '同时移出列表。                        serverDirList.Remove(fname)                    Else                       '若服务器不存在,加入到删除列表,表示系统没有用到该文件了。                        DeleteFileList.Add(New DownloadFileInfo(fname, lastver))                    End If               Next                  '添加服务器xml配置文件剩下的<File>。                For Each dFile As DownloadFileInfo In serverDirList.Values                    DownLoadFileList.Add(dFile)                Next                  '添加所有要下载的文件到列表。                AllDownLoadFileList.AddRange(DownLoadFileList)                AllDownLoadFileList.AddRange(RunOnceExeFileList)                AllDownLoadFileList.AddRange(RunOnceExeFileListHelp)                ShowDownLoadFileList()            Else               MessageBox.Show("更新文件列表有误,没办法更新。", "自动更新", MessageBoxButtons.OK)            End If       End Sub          Private Sub ShowDownLoadFileList()            Dim df As DownloadFileInfo            '显示下载文件列表。            Me.LvFiles.Items.Clear()            For Each df In AllDownLoadFileList                Dim item As New ListViewItem                item.Text = df.FileName                item.SubItems.Add(df.LastVer)                item.SubItems.Add(String.Empty)                Me.LvFiles.Items.Add(item)            Next       End Sub          Private Function CheckLocalFileList() As Boolean           '检查本地文件的完整性,如有丢失文件,加载到下载列表中,并返回true。            If LocalXmlFileS IsNot Nothing Then               Dim oldNodeList As XmlNodeList = LocalXmlFileS.GetNodeList("AutoUpdater/UpdateFileList")                Dim node As XmlNode                Dim fname, lastver As String               For Each node In oldNodeList                    fname = node.Attributes("Name").Value                    lastver = node.Attributes("Ver").Value                    If File.Exists(IO.Path.Combine(Application.StartupPath, fname)) = False Then                       DownLoadFileList.Add(New DownloadFileInfo(fname, lastver))                        AllDownLoadFileList.AddRange(DownLoadFileList)                    End If               Next               If AllDownLoadFileList.Count > 0 Then                   ShowDownLoadFileList()                    Return False               Else                   Return True               End If           Else               Return True           End If       End Function          Private Sub RunDownLoadFile()            If Me.AllDownLoadFileList.Count > 0 Then               'ShowPanel()                isFinishDownLoad = False               Dim pFolder, FileFullPath, FileUrl As String               evtPerDonwload = New ManualResetEvent(False)                Dim df As DownloadFileInfo                For Each df In AllDownLoadFileList                    If Me.isCancelDownLoad Then                       If myWebClient IsNot Nothing Then                           myWebClient.CancelAsync()                        End If                       Exit For                   End If                   FileUrl = updateUrl & "/" & df.FileName                    FileFullPath = IO.Path.Combine(saveUpdateFolder, df.FileName)                    pFolder = IO.Path.GetDirectoryName(FileFullPath)                    If IO.Directory.Exists(pFolder) = False Then                       IO.Directory.CreateDirectory(pFolder)                    End If                   'Me.SmoothProgressBar1.Value = 0                    myWebClient = New WebClient()                    AddHandler myWebClient.DownloadProgressChanged, AddressOf OnDownloadProgressChanged                    AddHandler myWebClient.DownloadFileCompleted, AddressOf OnDownloadFileCompleted                    evtPerDonwload.Reset()                    '文件保存在当前目录下.                    myWebClient.DownloadFileAsync(New Uri(FileUrl), FileFullPath, df.FileName)                    '等待下载完成                    evtPerDonwload.WaitOne()                    myWebClient.Dispose()                    myWebClient = Nothing               Next               'ShowPanel()                '这里可以不用到这个,因为每次完成下载都会设置一次。加了反而会出现bug: 无法重设。                'ResetDownLoadPrg()                If Me.isCancelDownLoad = False Then                   isFinishDownLoad = True                   ResetDownLoadBtn()                End If           End If       End Sub          Private Sub OnDownloadProgressChanged(ByVal sender As Object, ByVal e As System.Net.DownloadProgressChangedEventArgs)            '因为每一次下载一个文件时候都是New一个WebClient所以事件要动态添加到相对应的实例中。AddHandler ...OnDownloadProgressChanged            '不可以用Handles myWebClient.DownloadProgressChanged此方法只可以用在 Dim WithEvents myWebClient 相当于静态的控件               ShowMsg(String.Format("正在下载:{0},下载:{1}/{2}", e.UserState.ToString, FileHelper.FormatFileSize(e.BytesReceived), FileHelper.FormatFileSize(e.TotalBytesToReceive)))            Me.SmoothProgressBar1.Value = e.ProgressPercentage               'e.BytesReceived是接受文件的bytes            'e.TotalBytesToReceive是文件的总大小            'e.ProgressPercentage 是当前下载进度        End Sub          Private Sub OnDownloadFileCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.AsyncCompletedEventArgs)            '因为每一次下载一个文件时候都是New一个WebClient所以事件要动态添加到相对应的实例中。AddHandler ...OnDownloadFileCompleted            '不可以用Handles myWebClient.DownloadFileCompleted此方法只可以用在 Dim WithEvents myWebClient 相当于静态的控件               '发出释放同步进程信号            evtPerDonwload.Set()            '重设下载进度信息和进度条            ResetDownLoadPrg()            PerFinishDownLoad(e.UserState.ToString)            'If Me.isCancelDownLoad = False Then            '    If e.Error Is Nothing Then            '        ShowMsg("下载完毕" & e.UserState.ToString())            '    Else            '        ShowMsg("未完成下载: " & e.Error.Message)            '    End If            'End If        End Sub          Private Sub ShowPanel()            If Me.PnlDownInfo.InvokeRequired Then               Dim mi As New MethodInvoker(AddressOf ShowPanel)                Me.BeginInvoke(mi)            Else               Me.PnlDownInfo.Visible = Not Me.PnlDownInfo.Visible            End If       End Sub          Private Sub ShowMsg(ByVal msg As String)            If Me.LBDownloadInfo.InvokeRequired Then               '是的话启用delegate访问                Dim cb As New ShowMsgCallBack(AddressOf ShowMsg)                '如使用Invoke会等到函数调用结束,而BeginInvoke不会等待直接往后走                 Me.BeginInvoke(cb, New Object() {msg})            Else               Me.LBDownloadInfo.Text = msg                Me.LBDownloadInfo.Refresh()            End If       End Sub          Private Sub PerFinishDownLoad(ByVal fname As String)            If Me.LvFiles.InvokeRequired Then               Dim cb As New ShowMsgCallBack(AddressOf PerFinishDownLoad)                Me.BeginInvoke(cb, New Object() {fname})            Else               Dim item As ListViewItem                item = Me.LvFiles.FindItemWithText(fname)                If item IsNot Nothing Then                   item.SubItems(2).Text = "完成"               End If           End If       End Sub          Private Sub ResetDownLoadPrg()            If Me.InvokeRequired Then               Dim mi As New MethodInvoker(AddressOf ResetDownLoadPrg)                Me.BeginInvoke(mi)            Else               Me.SmoothProgressBar1.Value = 0                Me.LBDownloadInfo.Text = "下载信息"           End If       End Sub          Private Sub ResetDownLoadBtn()            If Me.BtnRunUpdate.InvokeRequired Or Me.BtnCancel.InvokeRequired Then               Dim mi As New MethodInvoker(AddressOf ResetDownLoadBtn)                Me.BeginInvoke(mi)            Else               Me.BtnRunUpdate.Enabled = True               Me.BtnRunUpdate.Text = "完成(&F)"               Me.BtnCancel.Enabled = False           End If       End Sub          Private Sub RunUpdate()            Dim fn As String           '下载完毕后,自动修改系统,运行更新设置,修改数据库,注册表等程序。            Dim df As DownloadFileInfo            For Each df In Me.RunOnceExeFileList                Try                   Dim f As String                   f = IO.Path.Combine(saveUpdateFolder, df.FileName)                    If IO.File.Exists(f) Then                       System.Diagnostics.Process.Start(f).WaitForExit()                    End If               Catch ex As Exception                End Try           Next                    '删除更新过程中的辅助文件:            For Each df In Me.RunOnceExeFileListHelp                fn = IO.Path.Combine(saveUpdateFolder, df.FileName)                DeleteFile(fn, DeleteType.OutOfDisk)            Next              '删除更新过程中的自动修改系统的Exe文件:            For Each df In RunOnceExeFileList                fn = IO.Path.Combine(saveUpdateFolder, df.FileName)                DeleteFile(fn, DeleteType.OutOfDisk)            Next              '再删除主程序的旧文件:            For Each df In DeleteFileList                fn = IO.Path.Combine(Application.StartupPath, df.FileName)                DeleteFile(fn, DeleteType.OutOfDisk)            Next              '退出主程序.            KillMainExe(MainAppName)               '移动新文件替换主程序的旧文件            If DownLoadFileList.Count > 0 Then               MoveFile(saveUpdateFolder, Application.StartupPath, True, True)            End If              '最后运行主程序。            RunMainExe()        End Sub          Private Sub RunMainExe()            Dim MainAppFilePath As String           MainAppFilePath = IO.Path.Combine(Application.StartupPath, MainAppName)            If CheckAppRunState(MainAppName) Then               If MessageBox.Show("检测到主程序已经运行,是否重启主程序", "是否重启主程序", MessageBoxButtons.YesNo, MessageBoxIcon.Information) = Windows.Forms.DialogResult.Yes Then                   KillMainExe(MainAppName)                    OpenFile(MainAppFilePath)                End If           Else               OpenFile(MainAppFilePath)            End If           Me.Close()        End Sub          Private Sub KillMainExe(ByVal appName As String)            If String.IsNullOrEmpty(appName) = False Then               KillProcess(IO.Path.GetFileNameWithoutExtension(appName))            End If       End Sub          Function CheckAppRunState(ByVal appName As String) As Boolean           If String.IsNullOrEmpty(appName) = False Then               appName = IO.Path.GetFileNameWithoutExtension(appName)                For Each sprocess As System.Diagnostics.Process In System.Diagnostics.Process.GetProcesses                    If sprocess.ProcessName = appName Then                       Return True                   End If               Next           End If           Return False       End Function          Private Sub BtnRunUpdate_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnRunUpdate.Click            If Me.BtnRunUpdate.Text = "开始更新(&U)" Then               Me.isCancelDownLoad = False               If Me.AllDownLoadFileList.Count > 0 Then                   Dim t As Thread = New Thread(New ThreadStart(AddressOf RunDownLoadFile))                    t.IsBackground = True                   t.Name = "RunDownLoadFile"                   t.Start()                End If           End If           If Me.BtnRunUpdate.Text = "完成(&F)" Then               If isFinishDownLoad Then                   RunUpdate()                End If           End If       End Sub          Private Sub BtnCancel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnCancel.Click            Me.isCancelDownLoad = True           Me.Close()        End Sub      End Class  
|