Excel·VBA破解密码

上一篇文章《Excel·VBA数组排列函数》，实现了VBA排列功能，而排列重要应用就是破解密码

Excel密码破解

支持破解纯数字、数字字母混合、纯字母等形式的密码
因破解速度不快，支持排列分段破解

Sub excel破解密码()
    '利用排列函数破解密码，如果密码正确则打开文件，支持排列断点、正向、反向查找
    Dim arr, brr, file_name$, pw$, wb, start_t&, end_t&, step_t&, i&, j&
    tm = Timer: On Error Resume Next  '密码错误时，不加本句会弹窗报错
    file_name = "E:\测试\密码文件.xlsx"  '文件
    arr = Array(1, 2, 3, 4, 5, 6)  '可能的密码元素
    'arr = Array(0, 1, 2, 3, "a", "b", "c")  '混合密码
    brr = permut_arr(arr, 6)       '密码位数，排列
    start_t = 0: end_t = 0         '遍历排列的起止位置，1为第1个，-1为最后一个
    If start_t > 0 And end_t > 0 And start_t <= end_t Then  '起止位置>0，正向查找
        step_t = 1
    ElseIf start_t < 0 And end_t < 0 And start_t >= end_t Then  '起止位置<0，反向查找
        start_t = UBound(brr) + start_t + 1: end_t = UBound(brr) + end_t + 1: step_t = -1
    ElseIf start_t = 0 And end_t = 0 Then  '起止位=0，全部查找
        start_t = LBound(brr): end_t = UBound(brr): step_t = 1
    Else
        Debug.Print "参数错误": Exit Sub
    End If
    opened = False
    For i = start_t To end_t Step step_t
        pw = Join(brr(i), ""): j = j + 1
        Set wb = Workbooks.Open(filename:=file_name, Password:=pw)
        If TypeName(wb) = "Workbook" Then
            Debug.Print "破解完成，密码为：" & pw,
            Debug.Print "遍历" & j & "种密码，用时：" & Format(Timer - tm, "0.00")
            opened = True: Exit For  '跳过剩余密码排列
        End If
    Next
    If opened = False Then Debug.Print start_t & "-" & end_t & "序号密码排列都不对，用时：" & Format(Timer - tm, "0.00")
End Sub

破解密码测试

密码排列	6选6共720种排列	7选6共5040种排列
耗时（秒）	74.64	542.53

破解速度不到10个/秒，属实不快，如果是银行卡此类10选6的密码估计需要4.5小时，如果是数字字母混合36选8可能需要4200年，这还是没有考虑字母大小写、元素重复的情况

zip、rar密码破解

支持破解纯数字、数字字母混合、纯字母等形式的密码
因破解速度不快，支持排列分段破解
使用 Shell 函数运行 winrar.exe 程序破解密码《Office VBA 参考·Shell 函数》
《WinRAR中文版》

Sub zip破解密码()
    '利用排列函数破解密码，如果密码正确则解压文件，支持排列断点、正向、反向查找
    Dim fso, arr, file_name$, save_path$, pw$, rarexe$, rarstr$, result&
    tm = Timer: Set fso = CreateObject("Scripting.FileSystemObject")
    file_name = "E:\测试\密码987654.zip"  '压缩文件
    save_path = "E:\测试\解压成功\"  '保存路径，建议为新文件夹
    rarexe = "E:\software\winrar\winrar.exe"  'winrar程序路径
    arr = Array(4, 5, 6, 7, 8, 9)  '可能的密码元素
    brr = permut_arr(arr, 6)       '密码位数，排列
    start_t = 0: end_t = 0         '遍历排列的起止位置，1为第1个，-1为最后一个
    If start_t > 0 And end_t > 0 And start_t <= end_t Then  '起止位置>0，正向查找
        step_t = 1
    ElseIf start_t < 0 And end_t < 0 And start_t >= end_t Then  '起止位置<0，反向查找
        start_t = UBound(brr) + start_t + 1: end_t = UBound(brr) + end_t + 1: step_t = -1
    ElseIf start_t = 0 And end_t = 0 Then  '起止位=0，全部查找
        start_t = LBound(brr): end_t = UBound(brr): step_t = 1
    Else
        Debug.Print "参数错误": Exit Sub
    End If
    If fso.FolderExists(save_path) = False Then
        fso.CreateFolder (save_path)
    Else
        If Dir(save_path) <> Empty Then Debug.Print "建议保存文件夹为空，便于后续判断是否解压成功，程序终止": Exit Sub
    End If
    For i = start_t To end_t Step step_t
        pw = Join(brr(i), ""): j = j + 1
        rarstr = rarexe & " e -y -p" & pw & " " & file_name & " " & save_path  '解压命令
        result = shell(rarstr, vbHide)   'Shell函数运行命令，隐藏窗口
        If Dir(save_path) <> Empty Then  '由于解压耗时，就算解压成功也判断为空，故建议分段破解
            Debug.Print "解压成功，密码为：" & pw & "，由于解压耗时，密码也可能是本密码的前几个之一"
            Debug.Print "遍历" & j & "种密码，用时：" & Format(Timer - tm, "0.00")
            Exit For  '跳过剩余密码排列
        End If
    Next
    Set fso = Nothing  '释放内存
    If Dir(save_path) = Empty Then
        Debug.Print start_t & "-" & end_t & "序号密码排列都不对，用时：" & Format(Timer - tm, "0.00")
        Debug.Print "查看是否解压成功，由于解压耗时，密码也可能是最后几个之一"
    Else
        Debug.Print start_t & "-" & end_t & "序号中存在正确的密码，建议采用二分法查找"
    End If
End Sub

由于使用shell函数调用压缩软件的方式，无法获取返回值判断密码是否正确，故采用判断保存文件夹是否为空的方式判断是否解压成功，因而实际正确的密码可能是程序输出密码的前几个之一

破解密码测试
速度很一般，6选6共720种排列，用时32.93秒，较python破解速度近10000个/秒属于非常慢
《利用python破解zip压缩文件密码》