特点:
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编辑过]