以文本方式查看主题 - Foxtable(狐表) (http://foxtable.net/bbs/index.asp) -- 项目发布 (http://foxtable.net/bbs/list.asp?boardid=5) ---- [原创]通用代码之全自动备份 (http://foxtable.net/bbs/dispbbs.asp?boardid=5&id=119555) |
-- 作者:lxy060669 -- 发布时间:2018/5/27 11:31:00 -- [原创]通用代码之全自动备份 在此分享一段通用代码。主要功能是通过压缩,实现系统全自动备份。在项目事件BeforeCloseProject中引用。备份的内容包括项目下的所有文件包括子文件夹下的内容,且按原路径备份。zip文件优先存盘在D:,只有C盘的,则存在我的文档下。 话不多说,贴出代码: \'------自动备份,存在D驱,则存在D盘,否则存在我的文档下. Dim zip As New zipFile Dim idx As Integer = ProjectFile.LastIndexOf(".") Dim idx1 As Integer = ProjectFile.LastIndexOf("\\") Dim proname As String = ProjectFile.SubString(idx1+1,idx-idx1-1) & "bak" Dim bakfolder As String If FileSys.DirectoryExists("D:\\") Then \'如果目录C:\\MyFolder存在 bakfolder="d:\\ftaxbak\\" & proname & "\\" Else bakfolder=SpecialFolder.MyDocuments & "\\ftaxbak\\" & proname & "\\" End If If FileSys.DirectoryExists(bakfolder)=False Then \'如果备份目录存在 FileSys.CreateDirectory(bakfolder) \'创建备份目录 End If zip.Create( bakfolder & proname & Format(now(),"yyyyMMddHHmm") & ".zip") zip.AddFile(ProjectFile) \'--添加压缩项目路径下文件 For Each File As String In FileSys.GetFiles(ProjectPath ) zip.AddFile(File,FileSys.GetName(File)) Next \'--添加压缩子文件夹下文件 For Each wjj As String In FileSys.GetDirectories(ProjectPath) Functions.Execute("zipinputfile",zip,wjj) \'递归函数的代码 \'Dim zip As zipFile = args(0) \'Dim wjj As String =args(1) \'For Each wjpath As String In FileSys.GetFiles(wjj) \'\'Output.Show( wjj.Replace(ProjectPath,"") & "\\" & FileSys.GetName(wjpath)) \'zip.AddFile(wjpath, wjj.Replace(ProjectPath,"") & "\\" & FileSys.GetName(wjpath)) \'Next \'For Each zwjj As String In FileSys.GetDirectories(wjj) \'Functions.Execute("zipinputfile",zip,zwjj) \'Next Next zip.Close() \'在程序项目退出事件中 For Each dt As DataTable In DataTables If dt.HasChanges Then dt.Save() End If Next 再给你个小技巧,将这段代码写入“代码库”中,以后每写一个新程序,只需从这里添加即可。 [此贴子已经被作者于2018/5/27 11:35:41编辑过]
|
-- 作者:lxy060669 -- 发布时间:2018/5/27 11:32:00 -- 这里上篇引用的递归函数的代码,由于一个帖子的内容超出16000字符就写不进去。所以放在这里。 \'递归函数,取名zipinputfile,拷入自定义函数,去掉注释。 \'Dim zip As zipFile = args(0)
\'Dim wjj As String =args(1) \'For Each wjpath As String In FileSys.GetFiles(wjj) \'zip.AddFile(wjpath, wjj.Replace(ProjectPath,"") & "\\" & FileSys.GetName(wjpath)) \'Next \'For Each zwjj As String In FileSys.GetDirectories(wjj) \'Functions.Execute("zipinputfile",zip,zwjj) \'Next Next zip.Close() |
-- 作者:thz706 -- 发布时间:2018/8/10 13:46:00 -- 测试了 没成功 不知道哪出问题了 |
-- 作者:旭日生 -- 发布时间:2019/3/30 19:15:00 -- 这段代码非常好,比较完美地解决了自动备份问题!谢谢lxy060669! 有大神能帮助解决吗?
|