Vjmms 发表于 2019-4-28 09:40

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

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

〇、几点说明

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

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


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

二、关键代码:
调用7-ZIP的代码
   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个字符随机密码的代码
    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格式的文件,因此密码里不包含英文逗号。

选择带压缩文件目录、压缩包保存目录代码
    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


获取目录下所有子目录、文件名的代码
    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


生成密码文件代码
    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


五、运行截图


visuns 发表于 2021-3-16 18:55

上面所有链接都失效了,能重新分享一次吗?感谢感谢。

苏浅沫 发表于 2020-4-19 12:01

大佬,我用过之后有一个小点希望提建议给您
压缩软件是自动收集文件后缀的
而压缩完的文件的文件名希望能够设置成没有文件后缀的


如图,源文件的文件名被自动抓取了,所以生成的文件就变成了“源文件名+.源文件后缀+.zip”--希望大佬可以优化下不自动抓取源文件后缀的自动压缩软件,辛苦大佬了~


{:1_919:}{:1_919:}{:1_919:}

ll018213 发表于 2019-4-28 17:23

win7旗舰版运行报错

Vjmms 发表于 2019-4-28 18:07

ll018213 发表于 2019-4-28 17:23
win7旗舰版运行报错

错误信息是?

ll018213 发表于 2019-4-28 22:02

Vjmms 发表于 2019-4-28 18:07
错误信息是?

qxk器械科 发表于 2019-4-28 22:20

你好,我在下载的源码,csproj, cs 等文件的源码怎么才能编 成exe文件,直接用啊,谢谢。。。真不会,告诉下用哪个软件也行啊。

Vjmms 发表于 2019-4-28 22:37

ll018213 发表于 2019-4-28 22:02


看上去像是跑错了程序,没找到 7za.exe文件
运行 AutoZip_190427\AutoZip_190427\bin\Release 目录下的“自动压缩.exe”试试。

或者把 Release 目录下的 7z1900-extra 目录拷贝到与可执行程序相同目录下。

Vjmms 发表于 2019-4-28 22:40

qxk器械科 发表于 2019-4-28 22:20
你好,我在下载的源码,csproj, cs 等文件的源码怎么才能编 成exe文件,直接用啊,谢谢。。。真不会,告诉 ...

你说的是用 C# 开发的项目,我这个源码是用的 VB 开发的。
现在的VS版本做的项目,一般会有一个 sln 后缀的解决方案文件,你用 VS 打开这个文件,编译解决方案就可以。

可能你需要去找本 C# 开发的书或教学录像来看看。

qxk器械科 发表于 2019-4-28 22:55

Vjmms 发表于 2019-4-28 22:40
你说的是用 C# 开发的项目,我这个源码是用的 VB 开发的。
现在的VS版本做的项目,一般会有一个 sln 后 ...

谢谢,我知道怎么做了。

ll018213 发表于 2019-4-28 23:28

Vjmms 发表于 2019-4-28 22:37
看上去像是跑错了程序,没找到 7za.exe文件
运行 AutoZip_190427\AutoZip_190427\bin\Release 目录下的 ...

可以用了,就是不知道能不能用指定某个密码压缩

Vjmms 发表于 2019-4-28 23:38

ll018213 发表于 2019-4-28 23:28
可以用了,就是不知道能不能用指定某个密码压缩

原来的需求是要求密码随机。

你可以修改源程序。在生成密码那个地方,改成指定的密码。或者在界面上增加一个文本框,用于指定密码。

你若需要,我顺手帮你改一下。
页: [1] 2 3 4
查看完整版本: [VB]自动加密压缩目录下所有文件,并生成对应的密码记录文件