通过VBS实现zip压缩及加密

gareth201313 2022-04-25 08:46:20

以下代码可以不依赖rar程序,实现对文件的压缩,但无法添加压缩密封,不知有哪位大神可以实现加密码压缩,求分享!

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
Delay 1000
Loop Until objTarget.Items.Count > 0
End Sub

 

...全文
106 回复 打赏 收藏 举报
写回复
回复
切换为时间正序
请发表友善的回复…
发表回复
发帖
VB基础类

7617

社区成员

VB 基础类
社区管理员
  • VB基础类社区
加入社区
帖子事件
创建了帖子
2022-04-25 08:46
社区公告
暂无公告