自己做了软件，加了注册功能，现在想加个在线升级功能 一子被这个功能卡住几天，晚上搜索了两天没获得什么结果。好的教程不多的！郁闷的看了半天娱乐视频，玩了一会游戏！今天终于突破瓶颈，现在把我自己的成就工作余下，这个系统是在vb.net 2005上完成的，不过我觉得基本原理一样：
很多都说vb.net以后自带的clickonce简单好用，说实话，我觉得clickonce就是给那些玩家程序员弄的，根本不实际。要么是微软技术部成熟，要么就是我学得不深，反正我觉得还是自己写一个实在，做成了就是万能的。
第一步先讲解简单思路：
1、首先我们要有自己的ftp服务器，把要升级的读写挂在服务器上，本人本身是做网站的，所以已经有ftp服务器，不建议用自己电脑搭服务器测试，浪费时间。最好去买一个100m网站空间，便宜一年才89元 最好，本人就是用这家服务器2007年开始用，稳定反应快，出问题维修快。
2、启动主程序读取程序版本号，例如：1.0.0.0 。我们在自己网站上挂上最新版本html文本，里面只写个最新号版本，例如：1.0.0.9，判断版本不一样就启动 在线升级程序
update.exe，然后关闭自己的进程
3、update.exe是用vs另外创建项目做的软件，在我们主程序打包的时候，一起打包进去。
4、update.exe的工作原理。首先我们创建一个config.xml，挂在ftp上。里面包含升级的文件内容，格式如下：(我们也可以把要升级的文件放在sql里面)
<?xml version="1.0" encoding="utf-8"?>
<DoubleBall>
<dbversion id="1.0.0.0">
<filedb path="data">这个不能删除用于版本检测</filedb>
</dbversion>
<dbversion id="1.0.0.1">
<filedb path="data">bank.png</filedb>
<filedb path="data">bookmark.png</filedb>
</dbversion>
<dbversion id="1.0.0.2">
<filedb path="data">busy.png</filedb>
<filedb path="data">check.png</filedb>
</dbversion>
<otherfile>
<filedb path="">DoubleBall.exe</filedb>
<filedb path="">ssq.dll</filedb>
</otherfile>
</DoubleBall>
因为软件经常升级，所以我们把每个版本对应要升级的文件名保存在xml里面，我这边简单举例三个版本1.0.0.0-1.0.0.2，其中1.0.0.0版本没内容用于首次升级检测。otherfile下的文件是每个版本共有的文件。
update.exe启动后通过先获取主程序版本。然后 Imports System.Net.FtpWebRequest 后连接ftp下载config.xml到目录下。获取xml内容
xml原理：我们获取所有dbversion节点，用for循环检测，发现id跟我们版本一样，则开始下载版本后面的内容。而otherfile下的文件是升级必须下载的，不需要检测
假如我们现在主程序是1.0.0.1版本，那么它只更新 图片busy.png,check.png 和主程序 DoubleBall.exe 主动态库 ssq.dll。更新都是通过Imports System.Net.FtpWebRequest连接ftp下载到本地。我们下载升级程序的时候现在本地，主程序目录下创建临时文件update，文件下载都放在update下。等全部下载好，再把下载的内容复制覆盖到程序下面，以免下载一般出错什么的。覆盖完后，删除下载的临时夹update。
5 启动主程序，关闭update.exe进程
下面我贴出主要函数：
<p>Imports System.Net 'FtpWebRequest
Imports System.IO '输入输出流
Imports System.XML 'xml
Imports System.Text.RegularExpressions '正则</p><p>'常见错误：如果发现没有检测到文件，是xml出错，原因缺少对比版本1.0.0.0</p><p>Public Class Form1
Dim ftppath As String = "<a href="ftp://www.qiusheng.net/web/DoubleBall/">ftp://www.qiusheng.net/web/DoubleBall/</a>" 'ftp升级文件的,www.qiusheng.net也可以换做ip
Dim listupdate As String = ftppath & "config_db.xml" '配置文件ftp路径
Dim userID As String = "qi***g" 'ftp账户
Dim ftppw As String = "31C******b4a1" 'ftp密码
Dim softname As String = "DoubleBall.exe" '主程序
Dim startpath As String = Application.StartupPath '主程序启动的目录
Dim updatepath As String = startpath & "\update"
Dim listxml As String = startpath & "\config_db.xml"
Dim reqftp As FtpWebRequest
Dim oldversion As String
Private Delegate Sub myDelegate(ByVal myString As String) '自定义一个委托
Dim MyThread As System.Threading.Thread '定义一个线程</p><p> Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Timer1.Start()
End Sub</p><p> '中转函数
Private Sub sum()
Me.BeginInvoke(New myDelegate(AddressOf softUpdate), "") '在启动的函数内，用新委托调用 签名函数
End Sub</p><p> Private Sub softUpdate(ByVal myString As String)
If Directory.Exists(updatepath) Then
DeleteDir(updatepath)
End If</p><p> TextBox1.AppendText("创建临时更新文件夹：update" & vbCrLf)
Directory.CreateDirectory(updatepath) '创建文件夹
'下载配置文件 参数：远程路径 本地路径 现在的进度条
downfile(listupdate, listxml, ProgressBar1, "config_db.xml") '下载配置文件到本地</p><p> oldversion = "1.0.0.0" 'Getcurversion(startpath & "\" & softname)
TextBox1.AppendText(softname & "获取当前版本号：" & oldversion & vbCrLf)
Label1.Text = softname & "当前版本：" & oldversion
updateXMl(listxml) '从ftp批量下早软件</p><p> TextBox1.AppendText("覆盖原文件..." & vbCrLf)
CopyDir(updatepath, startpath)</p><p> TextBox1.AppendText("删除临时更新目录..." & vbCrLf)
DeleteDir(updatepath)</p><p> TextBox1.AppendText("升级完毕！" & vbCrLf)</p><p> '启动DoubleBall.exe主程序
Process.Start(startpath & "\" & softname)</p><p> '结束DoubleBallUpdate进程
Dim proc() As Process = Process.GetProcessesByName("DoubleBallUpdate")
Dim pro As Process
For Each pro In proc
pro.Kill()
Next
End Sub</p><p> '下载 参数：远程路径 本地路径 现在的进度条
Private Sub downfile(ByVal filepath As String, ByVal savepath As String, ByVal Prog As ProgressBar, ByVal downname As String)
TextBox1.AppendText("开始下载：" & downname)
Try
reqftp = FtpWebRequest.Create(New Uri(filepath))
reqftp.Method = WebRequestMethods.Ftp.DownloadFile '下载 '上传UploadFile
reqftp.UseBinary = True
reqftp.Credentials = New NetworkCredential(userID, ftppw)</p><p> Dim response As FtpWebResponse = reqftp.GetResponse
Dim totalBytes As Long = getFileSize(filepath)
Prog.Maximum = totalBytes
Dim totalDownloadedByte As Long = 0 '当前下载的长度</p><p> Dim outputStream As FileStream = New FileStream(savepath, FileMode.Create) '输出流
Dim ftpStream As Stream = response.GetResponseStream
Dim bufferSize As Integer = 1024
Dim buffer(bufferSize) As Byte
Dim readCount As Integer '读取的数量</p><p> readCount = ftpStream.Read(buffer, 0, bufferSize) '读取
Do While readCount > 0
totalDownloadedByte = readCount + totalDownloadedByte
Prog.Value = totalDownloadedByte '设置进度条</p><p> outputStream.Write(buffer, 0, readCount) '写入流
readCount = ftpStream.Read(buffer, 0, bufferSize) '读取
Loop
ftpStream.Close()
outputStream.Close()
response.Close()
TextBox1.AppendText(" OK!" & vbCrLf)
Catch ex As Exception
TextBox1.AppendText(" OK!" & vbCrLf)
End Try
End Sub</p><p> '获取文件大小
Private Function getFileSize(ByVal filepath As String) As Long
Try
reqftp = FtpWebRequest.Create(New Uri(filepath))
reqftp.Method = WebRequestMethods.Ftp.GetFileSize
reqftp.UseBinary = True
reqftp.Credentials = New NetworkCredential(userID, ftppw)
Dim response As FtpWebResponse = reqftp.GetResponse
getFileSize = response.ContentLength '获取文件大小
Catch ex As Exception
getFileSize = 0
End Try
End Function</p><p> '获取版本号
Private Function Getcurversion(ByVal filepath As String) As String
Dim Curversion As String
Try
Curversion = FileVersionInfo.GetVersionInfo(filepath).FileVersion.ToString
Return Curversion
Catch ex As Exception
Return Nothing
End Try
End Function</p><p>
'复制文件
Public Shared Sub CopyDir(ByVal srcPath As String, ByVal aimPath As String)
Try
' 检查目标目录是否以目录分割字符\结束,如果不是则添加之
If aimPath(aimPath.Length - 1) <> Path.DirectorySeparatorChar Then
aimPath += Path.DirectorySeparatorChar
End If
'判断源目录是否存在,不存在则退出.
If (Not Directory.Exists(srcPath)) Then Exit Sub
' 判断目标目录是否存在如果不存在则新建之
If (Not Directory.Exists(aimPath)) Then Directory.CreateDirectory(aimPath)
' 得到源目录的文件列表，该里面是包含文件以及目录路径的一个数组
' 如果你指向copy目标文件下面的文件而不包含目录请使用下面的方法
' string[] fileList = Directory.GetFiles(srcPath)；
Dim fileList() As String = Directory.GetFileSystemEntries(srcPath)
' 遍历所有的文件和目录
For Each FileName As String In fileList
' 先当作目录处理如果存在这个目录就递归Copy该目录下面的文件
If Directory.Exists(FileName) Then
CopyDir(FileName, aimPath + Path.GetFileName(FileName))
' 否则直接Copy文件
Else
File.Copy(FileName, aimPath + Path.GetFileName(FileName), True)
End If
Next
Catch ex As Exception
MessageBox.Show(ex.ToString())
End Try
End Sub</p><p> ' ======================================================
' 实现一个静态方法将指定文件夹下面的所有内容Detele
' 测试的时候要小心*作，删除之后无法恢复。
' ======================================================
Public Shared Sub DeleteDir(ByVal aimPath As String)
Try
' 检查目标目录是否以目录分割字符结束如果不是则添加之
If (aimPath(aimPath.Length - 1) <> Path.DirectorySeparatorChar) Then
aimPath += Path.DirectorySeparatorChar
End If
'判断待删除的目录是否存在,不存在则退出.
If (Not Directory.Exists(aimPath)) Then Exit Sub
' 得到源目录的文件列表，该里面是包含文件以及目录路径的一个数组
' 如果你指向Delete目标文件下面的文件而不包含目录请使用下面的方法
' string[] fileList = Directory.GetFiles(aimPath);
Dim fileList() As String = Directory.GetFileSystemEntries(aimPath)
' 遍历所有的文件和目录
For Each FileName As String In fileList
If (Directory.Exists(FileName)) Then
' 先当作目录处理如果存在这个目录就递归Delete该目录下面的文件
DeleteDir(aimPath + Path.GetFileName(FileName))
Else
' 否则直接Delete文件
File.Delete(aimPath + Path.GetFileName(FileName))
End If
Next
'删除文件夹
System.IO.Directory.Delete(aimPath, True)
Catch ex As Exception
MessageBox.Show(ex.ToString())
End Try
End Sub</p><p> Sub editone(ByVal allpaths As String, ByVal rootNames As String, ByVal paraname As String, ByVal paravalue As String)
Dim lsen() As String = {paraname} '要修改的名称，多个用逗号分开
Dim lsit() As String = {paravalue} '要修改对应的值,，多个用逗号分开
modifXML(allpaths, rootNames, lsen, lsit)
End Sub</p><p> '修改XML要修改的XML文件名,XML文件中的根元素名称,要修改的元素数组,对应于要修改的元素数组的修改文本数组</p><p> Sub modifXML(ByVal allpath As String, ByVal rootName As String, ByVal elementNameArry() As String, ByVal innerTextArry() As String)
If My.Computer.FileSystem.FileExists(allpath) Then
Dim doc As New XmlDocument
doc.Load(allpath)
Dim list As XmlNodeList = doc.SelectSingleNode(rootName).ChildNodes
For Each xn As XmlNode In list
Dim xe As XmlElement
xe = xn
Dim nls As XmlNodeList = xe.ChildNodes
For Each xn1 As XmlNode In nls
Dim xe2 As XmlElement
xe2 = xn1
For i As Integer = 0 To elementNameArry.Length - 1
If xe2.Name = elementNameArry(i) Then
xe2.InnerText = innerTextArry(i)
End If
Next
Next
Next
doc.Save(allpath)
End If
End Sub</p><p>
'读取所有XML文件 要读取的XML文件名
Sub updateXMl(ByVal allpath As String)
Dim doc As New XmlDocument
Dim xn As XmlNode
Dim IsDown As Boolean = False
Dim IsOpen As Boolean = True '是否需要继续判断版本
doc.Load(allpath)
Dim list As XmlNodeList = doc.SelectNodes("/DoubleBall/dbversion")
Dim lsftppath As String
Dim lslocalfolder As String '本地文件夹
Dim lslocalfile As String '本地文件
For Each xn In list
'判断下载是否开启
If IsDown Then
TextBox1.AppendText("更新版本：" & CType(xn, XmlElement).GetAttribute("id") & vbCrLf)
Dim nls As XmlNodeList = CType(xn, XmlElement).ChildNodes
For Each xn1 As XmlNode In nls</p><p> lslocalfolder = CType(xn1, XmlElement).GetAttribute("path") '临时本地文件夹名称
If lslocalfolder <> "" Then
'判断是否存在，如果不存在就创建
If Not Directory.Exists(updatepath & "\" & lslocalfolder) Then
Directory.CreateDirectory(updatepath & "\" & lslocalfolder) '本地创建文件夹
End If
lsftppath = ftppath & lslocalfolder & "/" & CType(xn1, XmlElement).InnerText '临时远程路径
lslocalfile = updatepath & "\" & lslocalfolder & "\" & CType(xn1, XmlElement).InnerText
Else
lsftppath = ftppath & CType(xn1, XmlElement).InnerText '临时远程路径
lslocalfile = updatepath & "\" & CType(xn1, XmlElement).InnerText
End If
downfile(lsftppath, lslocalfile, ProgressBar1, CType(xn1, XmlElement).InnerText)
Next
End If</p><p> If IsOpen Then
If CType(xn, XmlElement).GetAttribute("id") = oldversion Then
IsDown = True
IsOpen = False '不要再判断版本
End If
End If
Next</p><p> '下载其它
TextBox1.AppendText("下载其它" & vbCrLf)
Dim xn2 As XmlNode
Dim list2 As XmlNodeList = doc.SelectNodes("/DoubleBall/otherfile")
For Each xn2 In list2
Dim nls2 As XmlNodeList = CType(xn2, XmlElement).ChildNodes
For Each xn3 As XmlNode In nls2</p><p>
lslocalfolder = CType(xn3, XmlElement).GetAttribute("path") '临时本地文件夹名称
If lslocalfolder <> "" Then
'判断是否存在，如果不存在就创建
If Not Directory.Exists(updatepath & "\" & lslocalfolder) Then
Directory.CreateDirectory(updatepath & "\" & lslocalfolder) '本地创建文件夹
End If
lsftppath = ftppath & lslocalfolder & "/" & CType(xn3, XmlElement).InnerText '临时远程路径
lslocalfile = updatepath & "\" & lslocalfolder & "\" & CType(xn3, XmlElement).InnerText
Else
lsftppath = ftppath & CType(xn3, XmlElement).InnerText '临时远程路径
lslocalfile = updatepath & "\" & CType(xn3, XmlElement).InnerText
End If
downfile(lsftppath, lslocalfile, ProgressBar1, CType(xn3, XmlElement).InnerText)
Next
Next
End Sub</p><p> '读取单个XML文件
Public Function GetreadonlyXMl(ByVal allpath As String, ByVal Elementnames As String)
Dim lsgg As String = Nothing
Try
If My.Computer.FileSystem.FileExists(allpath) Then
Dim doc As New XmlDocument
doc.Load(allpath)
Dim re As XmlNodeReader = New XmlNodeReader(doc)
Dim tmpStr As String = ""
Dim name As String = Nothing</p><p> '如果还可以读取
While re.Read
'获取读取节点的类型
Select Case re.NodeType
Case XmlNodeType.Element '匹配次级元素
name = re.Name</p><p> Case XmlNodeType.Text '匹配子元素
If name.Equals(Elementnames) Then
lsgg = re.Value
Exit Select
End If
End Select
End While
End If</p><p> Catch ex As Exception
'MsgBox(ex.Message & vbCrLf & ex.StackTrace)
lsgg = ""
End Try
GetreadonlyXMl = lsgg
End Function</p><p> Private Sub LinkLabel1_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles LinkLabel1.LinkClicked
System.Diagnostics.Process.Start("<a href="http://www.sandns.net">http://www.sandns.net</a>")
End Sub</p><p> Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
MyThread = New System.Threading.Thread(AddressOf sum)
MyThread.Start()
Timer1.Stop()
End Sub
End Class
</p>
