主题：[分享]真正的全自动升级代码

特点：

1、升级文件所在的文件夹和升级文件的文件名都不受任何限制。

2、每天可以升级N次。

 

要求：

1、在项目属性中设置项目发布日期精确到分钟。

如：2014-09-11 19:10发布时填2014-09-11 19:30（必须大于发布的真实时间，别人才能及时更新)

2、升级时不能关闭弹出的命令窗口。

也就是说，升级完成后，《升级文件》文件夹不能有文件（否则说明命令窗口被人为强行关闭了，必须将剩余文件手工移到《数据文件》文件夹中）。

 

代码：

 

1、用到的全局代码

Public IP1 As String = "10.10.10.10" '内网

Public IP2 As String = "123.123.123.123" '外网

Public IPa As String = IP1 '采用值

Public ftpAccount As String = "ABC" '设置ftp登录用户名

Public ftppassword As String = "1234567890" '设置ftp登录密码

Public Exit0 As String = "0" '是否正常退出标识.0-非正常退出，指点屏幕右上角的X退出

Public pname As String = "考勤管理系统" '项目名称,一个项目可以有多个数据源(可以切换)

Public ename As String = "考勤管理.exe" '管理系统运行文件名

Public pfile As String = pname & ".foxdb" '开发时的项目文件名

Public dpath As String = "d:\" & pname & "\设计资料\" '开发时的项目文件位置

Public ppath As String = "d:\" & pname & "\设计资料\publish\" '项目发布后的foxtable文件位置

Public rpath As String = "d:\" & pname & "\数据文件\project" '运行时项目文件位置

Public upath As String = "\项目管理系统\数据文件\" '服务器上的项目文件路径和升级路径

Public npath As String = "d:\" & pname & "\升级文件\" '客户端的foxtable最新文件保存路径

Public datafile As String = pname & ".zip" '包含最新升级数据的文件名

 

2、AfterOpenProject事件代码

If ProjectFile <> dpath & pfile Then '这是项目开发文件名
    Dim ftp1 As new ftpclient
    ftp1.TimeOut = 20000 '用于设置尝试操作的毫秒数
    ftp1.host = ipa '设置单位ftp服务器地址，在BeforeConnectOuterDataSource事件中确定ipa

    ftp1.Account = ftpAccount '设置ftp登录用户名
    ftp1.password = ftppassword '设置ftp登录密码
    ftp1.UTF8 = True
    Dim s1 As Date = ftp1.GetFiletime(upath & datafile) '服务器上升级文件的日期时间
    If s1 > publishdate Then '如果较现在版本的日期时间新则下载并升级
        Dim s3 As String = upath & datafile '服务器上升级文件中包含升级内容的文件
        Dim s4 As String = rpath & "\" & datafile '准备保存在客户端的包含升级内容的文件
        ftp1.download(s3,s4,False) '静默下载并另存
        Dim zip As New zipFile
        zip.Open(s4) '打开升级文件
        zip.Extractall(rpath) '全部解压到客户端运行文件夹
        zip.Close() '关闭升级文件
        FileSys.deleteFile(s4,2,2) '删除升级文件
        Dim oldDate As Date = filesys.ReadAllText(rpath & "\catch\version.txt",Encoding.Default) '在用的版本日期
        Dim newdate As Date = filesys.ReadAllText(rpath & "\version.txt",Encoding.Default) '刚更新的版本日期

        '注：s3中含开发路径下的version.txt
        If oldDate = newdate Then '属于一般性版本升级
            Exit0 = "1"
            Syscmd.Project.Open(ProjectFile) '重新打开项目
        Else
            If filesys.DirectoryExists(npath) = False Then
                filesys.CreateDirectory(npath)
            End If
            ftp1.download(upath & "update.zip",npath & "update.zip",False) '静默下载并另存，update.zip见下文的“发布上传”
            zip.Open(npath & "update.zip")
            zip.ExtractAll(npath)
            zip.Close()
            FileSys.deleteFile(npath & "update.zip",2,2) '删除升级文件
            Dim s As String = rpath & "\update.bat" ’建立升级批命令文件
            If filesys.FileExists(s) Then
                filesys.DeleteFile(s)
            End If
            filesys.WriteAllText(s,"@echo off" & vbcrlf,True,Encoding.Default)
            filesys.WriteAllText(s,"taskkill /f /im foxtable.exe" & vbcrlf,True,Encoding.Default)
            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,"move /y " & npath & "*.* d:\" & pname & "\数据文件" & vbcrlf,True,Encoding.Default)
            filesys.WriteAllText(s,"start /d d:\" & pname & "\数据文件 /max " & ename & vbcrlf,True,Encoding.Default)
            filesys.WriteAllText(s,"del " & s & vbcrlf,True,Encoding.Default)
            Dim Proc As New Process '定义一个新的Process
            Proc.File = s '指定要打开的文件
            Proc.Verb = "Open" '指定动作
            Proc.Start()
            proc.WaitForExit
        End If
    Else
        Forms("用户登录").Open()
    End If
Else
    Forms("用户登录").Open()
End If

 

3、“发布上传”按钮代码

'通用-压缩项目,备份项目,发布项目,上传升级文件
Syscmd.Project.Compact(False) '压缩项目
Syscmd.Project.Backup() '备份项目
Syscmd.Project.PublishProject()'发布项目
FileSys.CopyDirectory(dpath & "Publish", "e:\" & pname & "\数据文件",True) '拷贝项目文件到E盘备份
'以下创建并上传项目升级文件
Dim zip As New zipFile
Dim zFile As String
zFile = dpath & datafile
If FileSys.FileExists(zfile) Then '如果项目升级文件已经存在
    FileSys.deletefile(zfile,2,2) '则删除之
End If
zip.Create(zFile) '创建空文件
'zip.AddFolder(dpath & "publish\project") '添加project目录下的全部文件
'zip.AddFolder(dpath & "publish\project\Attachments") '添加Attachments目录下的全部模板文件
'zip.AddFolder(dpath & "publish\project\Images") '添加Images目录下的全部图标文件
zip.AddFile(dpath & "publish\project\" & pname & ".FoxEx") '或只更新项目主文件
zip.AddFile(dpath & "publish\project\" & pname & ".chm") '帮助文件没变可以不更新
zip.AddFile(dpath & "catch\Version.txt") '开发版本日期文件
zip.Close()
Dim ftp1 As new ftpclient
ftp1.TimeOut=20000 '用于设置尝试操作的毫秒数
ftp1.host=ipa '设置单位ftp服务器地址
ftp1.Account = ftpaccount '设置ftp登录用户名
ftp1.password = ftppassword '设置ftp登录密码
ftp1.utf8 = True '选true或false由运行ftp1.OpenManager后显示汉字是否正常确定
ftp1.upload(dpath & datafile,upath & datafile,True) '上传项目升级文件
'上传系统文件升级包
Dim Result As DialogResult
Result = MessageBox.Show("是否上传系统升级文件?","提示", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
If Result = DialogResult.Yes Then
    zfile = dpath & "update.zip"
    If FileSys.FileExists(zfile) Then
        FileSys.deletefile(zfile,2,2)
    End If
    zip.Create(zFile) '创建空文件
    zip.AddFolder("d:\" & pname & "\设计资料\publish","*.*",False) '不含子目录
    zip.Close()
    ftp1.upload(zfile,upath & "update.zip",True) '上传系统文件包
    FileSys.deletefile(zfile,2,2)
End If
'在E盘生成用于分发的压缩文件(与前面错开时间)
zfile = "e:\" & pname & ".zip" '将要生成的压缩文件
If FileSys.FileExists(zfile) Then
    FileSys.deletefile(zfile,2,2)
End If
zip.Create(zFile) '创建空文件
zip.AddFolder("e:\" & pname)
zip.AddFile("E:\" & pname & "安装和登录说明.doc")
zip.Close()