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

2022-07-11 22:13:18 文档大全网 [ 字体：小中大 ] [ 阅读： ]

【#文档大全网# 导语】以下是®文档大全网的小编为您整理的《纯vbs实现zip压缩与unzip解压缩函数代码》，欢迎阅读！
压缩,函数,代码,实现,unzip

用VBS解压ZIP文件，网上搜到的多数是调用WinRAR，一点技术含量也没有。听说可以用纯vbs实现，特整理给大家，已经过测试。喜欢的朋友可以测试下。压缩代码: 代码如下:

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.GetExtensionName(myZipFile) <> "zip" Then Exit Sub

ElseIf fso.FolderExists(mySourceDir) Then FType = "Folder"

ElseIf fso.FileExists(mySourceDir) Then FType = "File"

FileName = fso.GetFileName(mySourceDir)

FolderPath = Left(mySourceDir, Len(mySourceDir) - Len(FileName)) Else Exit Sub End If

Set f = fso.CreateTextFile(myZipFile, True)

f.Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0)) f.Close

Set objShell = CreateObject("Shell.Application") Select Case Ftype Case "Folder"

Set objSource = objShell.NameSpace(mySourceDir) Set objFolderItem = objSource.Items() Case "File"

Set objSource = objShell.NameSpace(FolderPath) Set objFolderItem = objSource.ParseName(FileName) End Select

Set objTarget = objShell.NameSpace(myZipFile) intOptions = 256

objTarget.CopyHere objFolderItem, intOptions Do

WScript.Sleep 1000

Loop Until objTarget.Items.Count > 0 End Sub 解压缩代码: 代码如下:

UnZip "D:\test.iso", "D:\test.zip"

Msgbox "OK"

Sub CopyFolder(ByVal mySourceDir, ByVal myTargetDir) Set fso = CreateObject("Scripting.FileSystemObject") If NOT fso.FolderExists(mySourceDir) Then Exit Sub

ElseIf NOT fso.FolderExists(myTargetDir) Then fso.CreateFolder(myTargetDir) End If

Set objShell = CreateObject("Shell.Application") Set objSource = objShell.NameSpace(mySourceDir) Set objFolderItem = objSource.Items()

Set objTarget = objShell.NameSpace(myTargetDir) intOptions = 256

objTarget.CopyHere objFolderItem, intOptions End Sub

用VBS解压ZIP文件，网上搜到的多数是调用WinRAR，一点技术含量也没有。Google一下“VBS 解压ZIP”，第二是搜搜问问“vbs实现解压缩zip文件”，满意答案是“所以想用vbs来解压这两种格式的文件，至少要有两种命令行解压工具，否则是绝对不可以的”。

绝对不可以的，回答的人好自信啊，笑而不语~