用vbs实现zip

页面导航:首页 > 软件编程 > vb.net > 用vbs实现zip

用vbs实现zip

来源: 作者: 时间:2016-01-21 10:23 【

这里也提供另外一篇文章:http://www.2cto.com/200412/3263.html压缩: Function fZip(sSourceFolder,sTargetZIPFile)This function will add all of the files in a source folder to a ZIP fileusing Windows native folder ZIP

这里也提供另外一篇文章:

">http://www.2cto.com/kf/200412/3263.html

压缩:
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 oFSSet oFSO = CreateObject("Scripting.FileSystemObject")
Create the target folder if it isnt 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

Tags:

相关文章

    文章评论

    最 近 更 新
    热 点 排 行
    Js与CSS工具
    代码转换工具
    
    <