用vbs实现zip功能的脚本

时间:2022-08-27 17:29:45

压缩: 

  1. Function fZip(sSourceFolder,sTargetZIPFile)  
  2. 'This function will add all of the files in a source folder to a ZIP file  
  3. 'using Windows' native folder ZIP capability.  
  4. Dim oShellApp, oFSO, iErr, sErrSource, sErrDescription  
  5. Set oShellApp = CreateObject("Shell.Application")  
  6. Set oFSO = CreateObject("Scripting.FileSystemObject")  
  7. 'The source folder needs to have a \ on the End  
  8. If Right(sSourceFolder,1) <> "\" Then sSourceFolder = sSourceFolder & "\"  
  9. On Error Resume Next   
  10. 'If a target ZIP exists already, delete it  
  11. If oFSO.FileExists(sTargetZIPFile) Then oFSO.DeleteFile sTargetZIPFile,True   
  12. iErr = Err.Number  
  13. sErrSource = Err.Source  
  14. sErrDescription = Err.Description  
  15. On Error GoTo 0  
  16. If iErr <> 0 Then     
  17. fZip = Array(iErr,sErrSource,sErrDescription)  
  18. Exit Function  
  19. End If  
  20. On Error Resume Next  
  21. 'Write the fileheader for a blank zipfile.  
  22. oFSO.OpenTextFile(sTargetZIPFile, 2, True).Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))  
  23. iErr = Err.Number  
  24. sErrSource = Err.Source  
  25. sErrDescription = Err.Description  
  26. On Error GoTo 0  
  27. If iErr <> 0 Then     
  28. fZip = Array(iErr,sErrSource,sErrDescription)  
  29. Exit Function  
  30. End If  
  31. On Error Resume Next   
  32. 'Start copying files into the zip from the source folder.  
  33. oShellApp.NameSpace(sTargetZIPFile).CopyHere oShellApp.NameSpace(sSourceFolder).Items  
  34. iErr = Err.Number  
  35. sErrSource = Err.Source  
  36. sErrDescription = Err.Description  
  37. On Error GoTo 0  
  38. If iErr <> 0 Then     
  39. fZip = Array(iErr,sErrSource,sErrDescription)  
  40. Exit Function  
  41. End If  
  42. 'Because the copying occurs in a separate process, the script will just continue. Run a DO...LOOP to prevent the function  
  43. 'from exiting until the file is finished zipping.  
  44. Do Until oShellApp.NameSpace(sTargetZIPFile).Items.Count = oShellApp.NameSpace(sSourceFolder).Items.Count  
  45.    WScript.Sleep 1500'如果不成功,增加一下秒数  
  46. Loop  
  47. fZip = Array(0,"","")  
  48. End Function   
  49.  
  50. Call fZip ("C:\vbs","c:\vbs.zip")   

解压缩: 
 

  1. Function fUnzip(sZipFile,sTargetFolder)  
  2. 'Create the Shell.Application object  
  3. Dim oShellApp:Set oShellApp = CreateObject("Shell.Application")  
  4. 'Create the File System object  
  5. Dim oFSO:Set oFSO = CreateObject("Scripting.FileSystemObject")  
  6. 'Create the target folder if it isn't already there  
  7. If Not oFSO.FolderExists(sTargetFolder) Then oFSO.CreateFolder sTargetFolder  
  8. 'Extract the files from the zip into the folder  
  9. oShellApp.NameSpace(sTargetFolder).CopyHere oShellApp.NameSpace(sZipFile).Items  
  10. 'This is a seperate process, so the script would continue even if the unzipping is not done  
  11. 'To prevent this, we run a DO...LOOP once a second checking to see if the number of files  
  12. 'in the target folder equals the number of files in the zipfile. If so, we continue.  
  13. Do  
  14. WScript.Sleep 1000‘有时需要更改  
  15. Loop While oFSO.GetFolder(sTargetFolder).Files.Count < oShellApp.NameSpace(sZipFile).Items.Count  
  16. End Function