以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  [分享]真正的全自动升级代码  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=38980)

--  作者:shenyl0211
--  发布时间:2013/8/12 17:16:00
--  [分享]真正的全自动升级代码

特点:

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()

[此贴子已经被作者于2015/4/14 13:46:37编辑过]

--  作者:Bin
--  发布时间:2013/8/12 17:18:00
--  
好东西,顶一下.
--  作者:狐狸爸爸
--  发布时间:2013/8/12 17:32:00
--  

呵呵,都自己搞定了,这方面不用我动手了。

 

图片点击可在新窗口打开查看


--  作者:hudicaca
--  发布时间:2013/9/13 11:57:00
--  
我的是连局域网的电脑..直接访问ip地址的..不是ftp服务器...要怎么写啊...求教...楼主好人
--  作者:zyqzyy
--  发布时间:2013/9/14 0:45:00
--  
很厉害,顶!要是有例子就完美了!
--  作者:shenyl0211
--  发布时间:2013/9/15 10:53:00
--  
以下是引用hudicaca在2013-9-13 11:57:00的发言:
我的是连局域网的电脑..直接访问ip地址的..不是ftp服务器...要怎么写啊...求教...楼主好人

1、局域网内要共享数据,则需要服务器。

2、你的数据库应该在服务器上。

3、你的升级文件在服务器上,网管肯定给你一个端口对应升级文件夹。

4、服务器有内网的IP地址,区别于其它电脑的IP地址。

所以,代码通用。

BeforeConnectOuterDataSource事件代码:

\'通用-根据是否内部数据源以及内网和外网登录时服务器地址IP的不同,选择不同的连接字符串
Dim i As Integer = 1 \'内部数据源取0,外部数据源取1
If i = 1 Then
    Dim a As Boolean
    For i = 1 To 5 \'ping5次
        a = Network.Ping(IP1,500) \'ping内网,每次500毫秒
        If a Then \'如果ping通就退出for循环
            Exit For
        End If
    Next
    If a Then
        IPa = IP1 \'如果内网Ping通,则用内网地址
    Else
        IPa = IP2 \'否则用外网地址
    End If
    《自动生成的连接字符串》

End If

[此贴子已经被作者于2013-9-15 10:54:40编辑过]

--  作者:pc005637
--  发布时间:2013/9/16 21:19:00
--  支持分享.很好的思路.
批处理文件的写法,值得菜鸟们参考.
个人认为程序的目录如果用 ProjectPath 来作动态处理,更加好.
谢谢.以后客户端的升级不用愁了.

--  作者:Siluy_kl1017
--  发布时间:2013/9/20 21:55:00
--  

狐表自身有升级的情况下,如何自动升级应用系统?

有这个扩展就太好了!


--  作者:黄训良
--  发布时间:2014/9/11 21:48:00
--  
顶,去测试!
--  作者:方丈
--  发布时间:2014/9/11 23:34:00
--  
顶,去测试!