[VB]自动加密压缩目录下所有文件，并生成对应的密码记录文件

应该有现成的、功能强大的类似工具，所以这就是一个小玩具级别的东西，见笑了。

〇、几点说明

这段代码本是悬赏求助区应助写的，那位兄弟没要求提供源码，所以就放在这边当成个新手贴了，如有违规，请版主删贴。
这个小玩具的特点就是简单，几步操作就可以完成目录下所有子目录、文件的单独加密压缩，并自动生成密码文件备忘。
没有写任何异常处理代码，所以这段程序的鲁棒性是存疑的。

压缩工具使用的是7-ZIP的免安装版，调用压缩命令的格式是这样的：
7za.exe a -tzip -p密码 压缩包文件名.zip 待压缩文件

一、操作步骤：
1、选择待压缩的文件目录。
2、选择压缩包存放目录。
3、点击开始按钮，等待完成。

二、关键代码：
调用7-ZIP的代码
[Visual Basic] 纯文本查看 复制代码 Sub ZipFile(ByVal sourceDir As String, ByVal destDir As String, ByVal fileName As String, ByRef sPassword As String)
sPassword = GeneratePassword()
Dim proc As System.Diagnostics.Process = New System.Diagnostics.Process()
proc.EnableRaisingEvents = False
proc.StartInfo.FileName = SevenZipExe
proc.StartInfo.Arguments = ZipArgs & sPassword & " " & destDir + fileName & ".zip " & sourceDir + fileName
proc.Start()
proc.WaitForExit()
End Sub

生成32个字符随机密码的代码
[Visual Basic] 纯文本查看 复制代码 Function GeneratePassword() As String
Dim sChars As String = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ~!@#$%^&*()_+=[]{}\\|;:./<>?"
Dim sPassword As String = ""
For i = 1 To 32
Dim n As Integer
Randomize(DateTime.Now.ToOADate)
n = Int(Rnd() * (sChars.Length – 1)) + 1
sPassword += Microsoft.VisualBasic.Mid(sChars, n, 1)
Next
Return sPassword
End Function

后面要将密码保存为csv格式的文件，因此密码里不包含英文逗号。

选择带压缩文件目录、压缩包保存目录代码
[Visual Basic] 纯文本查看 复制代码 Private Function SelectFolder(ByVal Describe As String, Optional ByVal ShowNewFolder As Boolean = True) As String
Using nOpen As New System.Windows.Forms.FolderBrowserDialog()
nOpen.Description = Describe
nOpen.ShowNewFolderButton = ShowNewFolder
nOpen.ShowDialog()
Return nOpen.SelectedPath
End Using
End Function

Private Sub ButtonChooseFilesPath_Click(sender As Object, e As EventArgs) Handles ButtonChooseFilesPath.Click
selectedFilesPath = SelectFolder("请选择待压缩文件路径", True)
If Microsoft.VisualBasic.Right(selectedFilesPath, 1) <> "\\" Then
selectedFilesPath += "\\"
End If
TextBoxFilesPath.Text = selectedFilesPath

End Sub
Private Sub ButtonChooseSavePath_Click(sender As Object, e As EventArgs) Handles ButtonChooseSavePath.Click
selectedSavePath = SelectFolder("请选择压缩包存放路径", True)
If Microsoft.VisualBasic.Right(selectedSavePath, 1) <> "\\" Then
selectedSavePath += "\\"
End If
TextBoxSavePath.Text = selectedSavePath
End Sub

获取目录下所有子目录、文件名的代码
[Visual Basic] 纯文本查看 复制代码 Sub GetAllFoldNames(ByVal currentPath As String, ByRef queueFoldNames As Queue(Of String))
Dim sFold As String
sFold = Dir(currentPath, FileAttribute.Directory)
Do While (sFold <> "")
If (sFold <> "." And sFold <> "..") Then
\’If (GetAttr(currentPath + sFold) And vbDirectory) Then
queueFoldNames.Enqueue(sFold)
TextBoxLog.Text += " " + sFold + Chr(13) + Chr(10)
\’End If
End If
sFold = Dir()
Loop
End Sub

生成密码文件代码
[Visual Basic] 纯文本查看 复制代码 Sub GeneratePasswordFile(ByVal fileNameWithPassword As String)
Dim path As String = Application.StartupPath()
If Microsoft.VisualBasic.Right(path, 1) <> "\\" Then
path += "\\"
End If
Dim strDate As String = Format(Date.Now, "General Date")
strDate = strDate.Replace("/", "-")
strDate = strDate.Replace(":", "-")
Dim fileName As String = path + "Password_" + strDate + ".csv"
fileNameWithPassword = "文件,密码" + Chr(13) + Chr(10) + fileNameWithPassword
FileOpen(1, fileName, OpenMode.Output)
Print(1, fileNameWithPassword)
FileClose(1)
TextBoxLog.Text += Chr(13) + Chr(10) + "密码已保存至文件：" + fileName + Chr(13) + Chr(10)
End Sub

四、源码下载

源码中带有编译好的文件及7-ZIP免安装版（在Release目录中）
链接：https://pan.baidu.com/s/13vljpJn3EJhm4sFIs1gOSw
提取码：fjr8

五、运行截图

语美@五元普通

收藏 海报 链接