VB.Net程序设计:AutoUpdater软件自动更新-源代码。

 

界面和配置文件参考：

http://blog.csdn.net/linjimu/archive/2009/10/27/4733283.aspx

 

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

XmlFiles.vb

Imports System
Imports System.IO
Imports System.Xml

Public Class XmlFiles
    Inherits XmlDocument

    Private _xmlFileName As String

    Public Property XmlFileName() As String
        Get
            Return _xmlFileName
        End Get
        Set(ByVal value As String)
            _xmlFileName = value
        End Set
    End Property

    Public Sub New(ByVal xmlFile As String)
        XmlFileName = xmlFile
        Me.Load(XmlFileName)
    End Sub

    '''<summary> 
    '''给定一个节点的xPath表达式并返回一个节点 
    '''</summary> 
    '''<param name="xPath"></param> 
    '''<returns></returns> 
    Public Function FindNode(ByVal xPath As String) As XmlNode
        Dim xmlNode As XmlNode = Me.SelectSingleNode(xPath)
        Return xmlNode
    End Function

    '''<summary> 
    '''给定一个节点的xPath表达式返回其值 
    '''</summary> 
    '''<param name="xPath"></param> 
    '''<returns></returns> 
    Public Function GetNodeValue(ByVal xPath As String) As String
        Dim xmlNode As XmlNode = Me.SelectSingleNode(xPath)
        Return xmlNode.InnerText
    End Function

    '''<summary> 
    '''给定一个节点的表达式返回此节点下的孩子节点列表 
    '''</summary> 
    '''<param name="xPath"></param> 
    '''<returns></returns> 
    Public Function GetNodeList(ByVal xPath As String) As XmlNodeList
        Dim nodeList As XmlNodeList = Me.SelectSingleNode(xPath).ChildNodes
        Return nodeList
    End Function

End Class

DownloadFileInfo.vb

Public Class DownloadFileInfo

    Private m_fileName As String = ""
    Private m_lastver As String = ""

    Public Property FileName() As String
        Get
            Return m_fileName
        End Get
        Set(ByVal value As String)
            m_fileName = value
        End Set
    End Property

    Public Property LastVer() As String
        Get
            Return m_lastver
        End Get
        Set(ByVal value As String)
            m_lastver = value
        End Set
    End Property

    Public Sub New(ByVal fname As String, ByVal fver As String)
        Me.m_fileName = fname
        Me.m_lastver = fver
    End Sub

End Class