http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=40763&authorid=0&page=0&star=1
跨版本升级的源码
链接ftp成功,修改了临时路径在C盘,一直无法成功升级。win7系统,电脑直邮一个C盘
错误所在事件:菜单,版本升级,Click
详细错误信息:
未将对象引用设置到对象的实例。
Dim ename As String = "数据平台.exe" '管理系统运行文件名
Dim utmp As String = "C:\UpdateTemporary" '存放升级文件的临时文件夹.【千万不要设置成磁盘的根目录!!因为升级后会删除临时文件夹!!】
Dim utmp1 As String = utmp & "\1" '存放解压Publish.zip或update.zip文件的临时文件夹
Dim upath As String '需要升级的路径,待用
Dim upathPub As String = ProjectPath & ".." '需要升级的项目Publish路径,".."表示上一级目录
Dim upathPro As String = ProjectPath '需要升级的项目Project路径
Dim dfile As String '需要下载的zip文件,待用
Dim dpath As String '需要下载的zip文件保存路径,待用
Dim vtxt As String = "Version.txt"
Dim pzip As String = "Publish.zip"
Dim utxt As String = "update.txt"
Dim uzip As String = "update.zip"
Dim uvtxt As String = utmp & "\Version.txt"
Dim upzip As String = utmp & "\Publish.zip"
Dim uutxt As String = utmp & "\update.txt"
Dim uuzip As String = utmp & "\update.zip"
Dim ftp As New FTPClient
ftp.Host = ""
ftp.Account = ""
ftp.Password = ""
ftp.RootDir = "\Update" '如果升级所需文件刚好放置在FTP的根目录下,可以不用设置此属性;否则需要设置目录路径.
'ftp.RootDir = "\升级文件所在目录"
Dim zip As New ZipFile
'连接FTP服务器--------------------
If ftp.Connected = False '如果FTP没有连接
If ftp.Connect Then '连接FTP
MessageBox.Show("FTP服务器连接成功!")
Else
MessageBox.Show("FTP服务器连接失败!")
Return
End If
End If
'检测升级所需的4个文件--------------------
If ftp.FileExists(vtxt) = False OrElse ftp.FileExists(pzip) = False OrElse ftp.FileExists(utxt) = False OrElse ftp.FileExists(uzip) = False Then
MessageBox.Show("服务器缺少升级所需文件!" & vbcrlf & vtxt & " " & pzip & " " & utxt & " " & uzip,"提示",MessageBoxButtons.OK,MessageBoxIcon.Error)
Return
End If
'校验目录--------------------
If FileSys.DirectoryExists(utmp) = False Then
FileSys.CreateDirectory(utmp)
End If
If FileSys.DirectoryExists(utmp1) = False Then
FileSys.CreateDirectory(utmp1)
End If
'升级判断--------------------
If ftp.Download(vtxt,uvtxt) And ftp.Download(utxt,uutxt) Then
MessageBox.Show(vtxt & " " & utxt & "下载完成!")
Dim sver As Date = FileSys.ReadAllText(uvtxt) '服务器Version.txt
Dim cver As Date = FileSys.ReadAllText(ProjectPath & "\Catch\Version.txt") '客户端Version.txt
Dim spub As Date = FileSys.ReadAllText(uutxt) '服务器update.txt
Dim cpub As Date = PublishDate '客户端发布日期
MessageBox.Show("服务器系统版本:" & sver & " 项目发布日期:" & spub & vbcrlf & "客户端Foxtable版本:" & cver & " 项目发布日期:" & cpub)
If sver > cver Then '如果服务器Foxtable版本大于客户端版本
MessageBox.Show("程序版本需要升级!")
upath = upathPub '项目Publish路径,项目跨版本完全升级
dfile = pzip
dpath = upzip
Else
MessageBox.Show("程序已经是最新版本!" & vbcrlf & "将检查文件版本……")
If spub > cpub Then '如果服务器项目发布日期大于客户端发布日期
MessageBox.Show("文件版本需要升级!")
upath = upathPro '项目Project路径,项目同版本升级
dfile = uzip
dpath = uuzip
Else
MessageBox.Show("您正在使用的已经是最新版本!")
FileSys.DeleteDirectory(utmp,2,2) '删除临时文件夹
Return '终止执行后续代码,直接退出
End If
End If
Else
MessageBox.Show(vtxt & " " & utxt & "下载失败!")
Return
End If
'升级处理--------------------
'下载文件&解压文件&升级文件--------------------
If ftp.Download(dfile,dpath) Then
MessageBox.Show(dfile & "下载完成!")
zip.Open(dpath)
zip.ExtractAll(utmp1)
zip.Close
MessageBox.Show(dfile & "解压完成!")
'建立升级批处理命令文件--------------------
Dim s As String = utmp & "\update.bat"
If FileSys.FileExists(s) Then
FileSys.DeleteFile(s)
End If
FileSys.WriteAllText(s,"@echo off" & vbcrlf,True,Encoding.Default)
FileSys.WriteAllText(s,"@title 自动升级..." & vbcrlf,True,Encoding.Default)
FileSys.WriteAllText(s,"taskkill /f /im foxtable.exe" & vbcrlf,True,Encoding.Default)
FileSys.WriteAllText(s,"@cls" & vbcrlf,True,Encoding.Default) '清除屏幕.清除删除 foxtable.exe 进程后屏幕反馈的信息.
FileSys.WriteAllText(s,"echo Wscript.Sleep Wscript.Arguments(0) * 1000>Delay.vbs" & vbcrlf,True,Encoding.Default)
FileSys.WriteAllText(s,"Delay.vbs 3" & vbcrlf,True,Encoding.Default)
FileSys.WriteAllText(s,"del Delay.vbs" & vbcrlf,True,Encoding.Default)
FileSys.WriteAllText(s,"xcopy /s /e /q /y " & utmp1 & "\*.* " & upath & vbcrlf,True,Encoding.Default) '复制升级文件,采用upath变量自动判断升级路径
FileSys.WriteAllText(s,"@cls" & vbcrlf,True,Encoding.Default) '清除屏幕.清除升级文件后屏幕反馈的信息.
FileSys.WriteAllText(s,"start " & ProjectPath & "..\" & ename & vbcrlf,True,Encoding.Default) '重启,"..\"表示上一级目录
FileSys.WriteAllText(s,"rd /s /q " & utmp & vbcrlf,True,Encoding.Default) '删除临时文件夹
MessageBox.Show("update.bat文件制作完成!")
Dim Proc As New Process '定义一个新的Process
Proc.File = s '指定要打开的文件
Proc.Verb = "Open" '指定动作
Proc.Start()
proc.WaitForExit
Else
MessageBox.Show(dfile & "下载失败!")
Return
End If
<!--EndFragment-->