用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)

相关推荐

  • 用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 = Create

  • iisvdir.vbs iis虚拟目录管理脚本使用介绍

    IIS管理器也是通过调用iisvdir.vbs来实现虚拟目录的创建和删除的.我们可以通过命令行的方式来执行iisvdir.vbs脚本 1)创建虚拟目录: cscript c:\windows\system32\iisvdir.vbs [/s server] [/u username /p password] /create [virtualRoot] Alias PhysicalPath 2)删除虚拟目录: 1cscript c:\windows\system32\iisvdir.vbs [/s

  • 用vbs实现cmd功能的代码

    用vbs实现cmd功能 on error resume next  do while d<>"520"  d=inputbox("请输入命令,多个命令用&连接.关闭该VB窗口命令520")  set q=createobject("scripting.filesystemobject")  set a=WScript.CreateObject("WScript.Shell")  a.run "%C

  • Python实现自动回复讨论功能的脚本分享

    目录 好久不见 实现过程 一步拿捏讨论 美图 好久不见 写这篇文章只是想证明一下:本博主还在呼吸 许久未更,甚是想更呐~ 这段时间生活中充斥着各种事情,感觉每天都在忙忙碌碌,偶而停下疲惫的身躯,突然抬头,却不知自己身处何方,忙了这么久,到底在忙些什么呢?找不着方向,于是开始惶恐,便又不知方向的胡乱奔走……,好吧好吧,总结两个字:迷茫,再加两个字:瞎忙…… 其实这几天一直想写博客的,想写有趣又轻松的一篇文章,但又不到写哪些内容比较好,又因还要解决各种事情,于是就搁到了现在…… 直到某天,为了完成M

  • VBS实现截图功能

    百度说,VBS很难截图,倒是有个利用第三方软件的方法,调用该软件,然后该软件会自动截图. 但这样,违背了用VBS的初衷. 用VBS就是因为它方便快捷.要是用第三方软件的话,干脆我们直接用VB写一个好了. 那么...只好调用Excel用VBA去做了. 有什么更好的方法吗? 在度娘上翻了很久,没有什么好方法,因为实现截屏原本就不是微软设计vbs的初衷,更多的扩展功能是使用者的意愿,所以才会有第三方的出现,实际vbs调用vba也是这种方式,利用的是vba能调用API的特性,查了下网上的代码,调用的是U

  • vbs实用软件自造——Windows脚本应用实例

    从Windows 98时代起,各种脚本文件不断出现,脚本文件的作用是为了实现各种脚本文件在 Windows 界面或 Dos 命令提示符下的直接运行,微软就在系统内植入了一个基于 32 位 Windows 平台.独立的脚本运行环境,并将其命名为"Windows Scripting Host(Windows 脚本宿主以下简称WSH)". WSH 诞生后,在 Windows 系列产品中很快得到了推广.除 Windows 98 外,微软在 Internet Information Server

  • 纯vbs实现zip压缩与unzip解压缩函数代码

    压缩代码: 复制代码 代码如下: Zip "D:\test.iso", "D:\test.zip" Zip "D:\test", "D:\test.zip" Msgbox "OK" Sub Zip(ByVal mySourceDir, ByVal myZipFile) Set fso = CreateObject("Scripting.FileSystemObject") If fso.

  • vbs 字符统计功能模块

    字符统计功能模块 复制代码 代码如下: Sub TongJi() Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.OpenTextFile("ok.txt", 1) strText = objFile.ReadAll All = Len(strText) S="` ~ ! @ # $ % ^ & * ( ) - _ = + \ | [ { ]

  • 用vbs实现的exe2swf工具脚本代码

    复制代码 代码如下: dim AsoR,FlashFileName  Set ArgObj = WScript.Arguments dim PositionStart,OKed,Tag,EndSize  PositionStart = 920000'flash 4的播放器的大致字节数  EndSize = 8    'exe文件结尾字节数,其它版本可以设置为0  FlashFileName = ArgObj(0)'传递路径 set AsoR=CreateObject("Adodb.Stream&

  • vbs 定时删除功能实现代码

    参考代码一: 复制代码 代码如下: Function DeleteLog( )    Dim objFSO, objFolder, strPath, targetFSO, subFSO, DirPath       DirPath = createobject("Scripting.FileSystemObject").GetFile(Wscript.ScriptFullName).ParentFolder.Path&"\Log\"    Set objFS

随机推荐