<
您还没有登录┊登录注册 当前在线:264
源码程序系统工具编程开发图形图像网络软件应用软件多媒体类娱乐休闲驱动程序各类教程各类论文文章阅读
ASPPHPJSPASP.NETVBVF百度搜索星星练题网络文摘股市消息技能习题详细分类
当前位置:首页 \ 源码程序 \ .NET
站内搜索


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

文件大小:1 k
运行平台:Windows9X/ME/NT/2000/XP
级别评定:
添加时间:2010-2-1 10:42:57
最后更新:2010-2-1 10:43:21
相关链接:无
所需金额:0 元
添加者:管理员

Download.1

/ ::软件简介:: / ::相关软件:: / ::软件点评:: /::上一个::/ ::下一个:: /
管理首页
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  


相关软件
·Visual Basic 6.0 简体中文企业版纯净版 
·VBlog_博客系统1.0
·阳光企业管理系统Vbaidu.0825
·宽带连接快速生成器VB源码
·网易邮箱登录vb程序126、163双向开通
·163和126邮箱登陆代码的VB代码
·动网论坛Dvbbs v8.2.0 Build 20090622
·动网论坛Dvbbs v8.2.0 Build 20081021
·动网论坛Dvbbs v8.2
·动网论坛Dvbbs8.2.0RC1万能通行证


1分 0
2分 0
3分 0
4分 0
5分 0
共有 0 人打分
平均得分:0


按字符查询:ABCDEFGHIJKLMNOPQRSTUVWXYZ0~9中文
下载图示: - 附汉化补丁 - 附注册 - 会员软件 - 推荐 - 最新添加
Rainight, 星旺坡 联网备案号:41092802000212 豫ICP备19032584号-1 页面执行时间: 0.36秒
业务QQ:80571569 手机:13030322310