VBA 简单破解EXCEL工作簿数字密码的功能

 

代码1：无法实现破解密码

• 虽然加了不显示警告窗口，仍然会因为密码不对被警告
• 希望正确的时候显示密码
• 后面希望每次设置密码几位。每位密码从一个库里随机，可能效率低

 

Sub test_wb111()

Application.DisplayAlerts = False

Workbooks.Add
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "t2.xlsx", Password:=543
ActiveWorkbook.Close

'假设为3位密码以内
For i = 1 To 999
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "t2.xlsx", Password:=i

'"希望正确的时候显示密码"
'后面希望每次设置密码几位。每位密码从一个库里随机
Next

End Sub

 

代码2： 这个可以保证可以持续试错，但随即范围大了容易卡死

Sub test_wb111()

On Error Resume Next

Workbooks.Add
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "t2.xlsx", Password:=543
ActiveWorkbook.Close

'假设为3位密码以内
For i = 1 To 9
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "t2.xlsx", Password:=i

'"希望正确的时候显示密码"
'后面希望每次设置密码几位。每位密码从一个库里随机
Next

End Sub

 

代码3： 可以查出低位的数字正确密码

• 希望正确的时候显示密码，已经加载到内存则已经打开
• 加exit sub 是为了 查找到正确密码后，显示密码，且不执行后面的多余循环，否则很卡

Sub test_wb111()

On Error Resume Next

Workbooks.Add
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "t2.xlsx", Password:=23
ActiveWorkbook.Close


'假设为3位密码以内
For i = 1 To 99
   Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "t2.xlsx", Password:=i
   
   '希望正确的时候显示密码
   If ActiveWorkbook.Name = "t2.xlsx" Then
      Debug.Print "正确密码=" & i
      Exit Sub
   End If
   
Next

End Sub

 

 

代码4 ：后面希望每次设置密码几位。每位密码从一个库里随机

• 根据密码位数，1位，2位，3位，逐渐破解

• 暂时只能支持2位的数字和密码，太多位数就会卡

Sub test_wb112()

Workbooks.Add
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "t2.xlsx", Password:=32
ActiveWorkbook.Close

arr1 = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z")

On Error Resume Next

'假设为1位密码
For i = LBound(arr1) To UBound(arr1)
    Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "t2.xlsx", Password:=arr1(i)
    If ActiveWorkbook.Name = "t2.xlsx" Then
      Debug.Print "正确密码= " & arr1(i)
      Debug.Print "破解完成"
      Exit Sub
    End If
    If i = UBound(arr1) Then   '记得不是应该ubound()+1吗？ 因为这里lbound从0开始导致的?
       Debug.Print "不是1位密码"
    End If
Next

''假设为2位密码
For i = LBound(arr1) To UBound(arr1)
    For j = LBound(arr1) To UBound(arr1)
'    Debug.Print arr1(i) & arr1(j)
    Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "t2.xlsx", Password:=arr1(i) & arr1(j)
    If ActiveWorkbook.Name = "t2.xlsx" Then
      Debug.Print "正确密码= " & arr1(i) & arr1(j)
      Debug.Print "破解完成"
      Exit Sub
    End If
    Next j
    If i = UBound(arr1) Then
       Debug.Print "不是2位密码"
    End If
Next i


End Sub

 

 

代码5 ：后面是不是应该试验两分法，去尝试密码大小范围