用vbs实现zip功能的脚本
作者 佚名
来源 ASP编程
浏览
发布时间 2013-07-09
| 压缩： FunctionfZip(sSourceFolder,sTargetZIPFile) ''ThisfunctionwilladdallofthefilesinasourcefoldertoaZIPfile ''usingWindows''nativefolderZIPcapability. DimoShellApp,oFSO,iErr,sErrSource,sErrDescription SetoShellApp=CreateObject("Shell.Application") SetoFSO=CreateObject("Scripting.FileSystemObject") ''Thesourcefolderneedstohavea\ontheEnd IfRight(sSourceFolder,1)<>"\"ThensSourceFolder=sSourceFolder&"\" OnErrorResumeNext ''IfatargetZIPexistsalready,deleteit IfoFSO.FileExists(sTargetZIPFile)ThenoFSO.DeleteFilesTargetZIPFile,True iErr=Err.Number sErrSource=Err.Source sErrDescription=Err.Description OnErrorGoTo0 IfiErr<>0Then fZip=Array(iErr,sErrSource,sErrDescription) ExitFunction EndIf OnErrorResumeNext ''Writethefileheaderforablankzipfile. oFSO.OpenTextFile(sTargetZIPFile,2,True).Write"PK"&Chr(5)&Chr(6)&String(18,Chr(0)) iErr=Err.Number sErrSource=Err.Source sErrDescription=Err.Description OnErrorGoTo0 IfiErr<>0Then fZip=Array(iErr,sErrSource,sErrDescription) ExitFunction EndIf OnErrorResumeNext ''Startcopyingfilesintothezipfromthesourcefolder. oShellApp.NameSpace(sTargetZIPFile).CopyHereoShellApp.NameSpace(sSourceFolder).Items iErr=Err.Number sErrSource=Err.Source sErrDescription=Err.Description OnErrorGoTo0 IfiErr<>0Then fZip=Array(iErr,sErrSource,sErrDescription) ExitFunction EndIf ''Becausethecopyingoccursinaseparateprocess,thescriptwilljustcontinue.RunaDO...LOOPtopreventthefunction ''fromexitinguntilthefileisfinishedzipping. DoUntiloShellApp.NameSpace(sTargetZIPFile).Items.Count=oShellApp.NameSpace(sSourceFolder).Items.Count WScript.Sleep1500''如果不成功，增加一下秒数 Loop fZip=Array(0,"","") EndFunction CallfZip("C:\vbs","c:\vbs.zip") 解压缩： FunctionfUnzip(sZipFile,sTargetFolder) ''CreatetheShell.Applicationobject DimoShellApp:SetoShellApp=CreateObject("Shell.Application") ''CreatetheFileSystemobject DimoFSO:SetoFSO=CreateObject("Scripting.FileSystemObject") ''Createthetargetfolderifitisn''talreadythere IfNotoFSO.FolderExists(sTargetFolder)ThenoFSO.CreateFoldersTargetFolder ''Extractthefilesfromthezipintothefolder oShellApp.NameSpace(sTargetFolder).CopyHereoShellApp.NameSpace(sZipFile).Items ''Thisisaseperateprocess,sothescriptwouldcontinueeveniftheunzippingisnotdone ''Topreventthis,werunaDO...LOOPonceasecondcheckingtoseeifthenumberoffiles ''inthetargetfolderequalsthenumberoffilesinthezipfile.Ifso,wecontinue. Do WScript.Sleep1000‘有时需要更改 LoopWhileoFSO.GetFolder(sTargetFolder).Files.Count<oShellApp.NameSpace(sZipFile).Items.Count EndFunction |
凌众科技专业提供服务器租用、服务器托管、企业邮局、虚拟主机等服务，公司网站：http://www.lingzhong.cn 为了给广大客户了解更多的技术信息，本技术文章收集来源于网络,凌众科技尊重文章作者的版权，如果有涉及你的版权有必要删除你的文章，请和我们联系。以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢! |
你可能对下面的文章感兴趣
上一篇: vbscript 注册表脚本书写下一篇: 用vbs实现本地添加用户的脚本
关于用vbs实现zip功能的脚本的所有评论
