源码网商城,靠谱的源码在线交易网站 我的订单 购物车 帮助

源码网商城

用vbs实现zip功能的脚本

  • 时间:2022-03-09 21:59 编辑: 来源: 阅读:
  • 扫一扫,手机访问
摘要:用vbs实现zip功能的脚本
压缩:  Function fZip(sSourceFolder,sTargetZIPFile)  'This function will add all of the files in a source folder to a ZIP file  'using Windows' native folder ZIP capability.  Dim oShellApp, oFSO, iErr, sErrSource, sErrDescription  Set oShellApp = CreateObject("Shell.Application")  Set oFSO = CreateObject("Scripting.FileSystemObject")  'The source folder needs to have a \ on the End  If Right(sSourceFolder,1) <> "\" Then sSourceFolder = sSourceFolder & "\"  On Error Resume Next   'If a target ZIP exists already, delete it  If oFSO.FileExists(sTargetZIPFile) Then oFSO.DeleteFile sTargetZIPFile,True   iErr = Err.Number  sErrSource = Err.Source  sErrDescription = Err.Description  On Error GoTo 0  If iErr <> 0 Then     fZip = Array(iErr,sErrSource,sErrDescription)  Exit Function  End If  On Error Resume Next  'Write the fileheader for a blank zipfile.  oFSO.OpenTextFile(sTargetZIPFile, 2, True).Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))  iErr = Err.Number  sErrSource = Err.Source  sErrDescription = Err.Description  On Error GoTo 0  If iErr <> 0 Then     fZip = Array(iErr,sErrSource,sErrDescription)  Exit Function  End If  On Error Resume Next   'Start copying files into the zip from the source folder.  oShellApp.NameSpace(sTargetZIPFile).CopyHere oShellApp.NameSpace(sSourceFolder).Items  iErr = Err.Number  sErrSource = Err.Source  sErrDescription = Err.Description  On Error GoTo 0  If iErr <> 0 Then     fZip = Array(iErr,sErrSource,sErrDescription)  Exit Function  End If  'Because the copying occurs in a separate process, the script will just continue. Run a DO...LOOP to prevent the function  'from exiting until the file is finished zipping.  Do Until oShellApp.NameSpace(sTargetZIPFile).Items.Count = oShellApp.NameSpace(sSourceFolder).Items.Count     WScript.Sleep 1500'如果不成功,增加一下秒数  Loop  fZip = Array(0,"","")  End Function   Call fZip ("C:\vbs","c:\vbs.zip")  
解压缩:  Function fUnzip(sZipFile,sTargetFolder)  'Create the Shell.Application object  Dim oShellApp:Set oShellApp = CreateObject("Shell.Application")  'Create the File System object  Dim oFSO:Set oFSO = CreateObject("Scripting.FileSystemObject")  'Create the target folder if it isn't already there  If Not oFSO.FolderExists(sTargetFolder) Then oFSO.CreateFolder sTargetFolder  'Extract the files from the zip into the folder  oShellApp.NameSpace(sTargetFolder).CopyHere oShellApp.NameSpace(sZipFile).Items  'This is a seperate process, so the script would continue even if the unzipping is not done  'To prevent this, we run a DO...LOOP once a second checking to see if the number of files  'in the target folder equals the number of files in the zipfile. If so, we continue.  Do  WScript.Sleep 1000‘有时需要更改  Loop While oFSO.GetFolder(sTargetFolder).Files.Count < oShellApp.NameSpace(sZipFile).Items.Count  End Function 
  • 全部评论(0)
联系客服
客服电话:
400-000-3129
微信版

扫一扫进微信版
返回顶部