用vbs实现zip功能的脚本

压缩： 

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