使用VBA破解Excel电子表格密码

Posted 2023-02-24

【中文标题】使用VBA破解Excel电子表格密码

【英文标题】：Excel spreadsheet password cracking using VBA

【发布时间】：2012-07-23 20:17:14

【问题描述】：

我尝试编写一个vba 密码破解器代码，类似于我用来破解 Excel 表密码的代码但我不确定我是否正确 - 当我尝试此代码时，它提示我输入密码但没有密码已在文本输入框中输入。

请指出我做错了什么。

谢谢

Sub testmacro()
Dim password
Dim a, b, c, d, e, f, g, h, i, j, k, l
SendKeys "^r"
SendKeys "PGUP"

For a = 65 To 66
    For b = 65 To 66
        For c = 65 To 66
            For d = 65 To 66
                For e = 65 To 66
                    For f = 65 To 66
                        For g = 65 To 66
                            For h = 65 To 66
                                For i = 65 To 66
                                    For j = 0 To 255
                                        password = Chr(a) & Chr(b) & Chr(c) & Chr(d) & Chr(e) & Chr(f) & Chr(g) & Chr(h) & Chr(i) & Chr(j)
                                        SendKeys "Enter", True
                                        MsgBox password
                                        SendKeys password, True
                                        SendKeys "Enter", True

                                        On Error GoTo 200
                                        MsgBox password
                                        GoTo 300
200                                         password = ""

                                    Next
                                Next
                            Next
                        Next
                    Next
                Next
            Next
        Next
    Next
Next
300 MsgBox "exited"
End Sub

【问题讨论】：

相关：***.com/q/1026483/190829

嗨，Jimmy，感谢您的更新，但问题不是使用 vbscript，而是通过一些哈希码完成的。

嗨@codeomnitrix，你能分享一下你为什么只在前8层尝试A到B的想法吗？您不想在所有图层上尝试所有可能的字符吗？

这是因为密码在内部被转换为一系列A和B。无需遍历所有字符

【参考方案1】：

您的代码未正确执行的原因是您试图在受密码保护的 execel 文件上执行宏，这是不允许的。这是因为在输入密码之前宏不会在 Excel 工作簿上执行 - 因此在执行宏代码之前会提示输入密码。

这篇 SO 文章也对此进行了更详细的解释：Excel VBA - Automatically Input Password

编辑

2003 年

---

如果您尝试访问工作簿，而不是工作表，则在 2003 版及更早版本中有多种方法。快速浏览后，这个 blogspot Code Samples 条目似乎有一个用于取消保护 2003 工作簿的工作版本。

此外，在相关说明中，如果您进一步退后并尝试解锁 VBA 项目，此SO article 似乎可以充分解决该问题。

2007 年

---

如果您只是想“蛮力”解除对客户工作簿的保护，一位名叫 Jason 的绅士有outlined such a process in his blog。

---

【讨论】：

嗨，杰克，感谢您的回复，excel 文件不受保护，而驻留在其中的 vba 项目受到保护。我需要使用这个脚本取消保护这个 vba 项目。

Codeomnitrix，感谢您的澄清。您要打开哪个版本的 excel？ 2003年有很多方法可以做到；我在 2003 年及更早的时间在我编辑的答案中链接了一个取消保护工作表的教程。

这个答案应该被编辑，因为只有这部分是相关的另外，在相关的说明中，如果你进一步退后并尝试解锁 VBA 项目，这篇 SO 文章似乎足够解决问题。

@brettdj，您是要求删除除该斜体部分之外的所有帖子，还是删除该点之后以斜体显示的所有材料？

【参考方案2】：

我在 Excel-2013 中成功地在 Excel 2003 中创建的受密码保护的工作簿上执行了此脚本。

遵循以下步骤：

开发者 --> 录制宏（给一个名字，然后点击）

宏 --> 将您创建的宏用于编辑。

用下面的整个函数替换宏：

Sub PasswordBreaker()
    'Breaks worksheet password protection.
    Dim i As Integer, j As Integer, k As Integer
    Dim l As Integer, m As Integer, n As Integer
    Dim i1 As Integer, i2 As Integer, i3 As Integer
    Dim i4 As Integer, i5 As Integer, i6 As Integer
    On Error Resume Next
    For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
    For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
    For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
    For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
    ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _
        Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
        Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
    If ActiveSheet.ProtectContents = False Then
        MsgBox "One usable password is " & Chr(i) & Chr(j) & _
            Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
            Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
         Exit Sub
    End If
    Next: Next: Next: Next: Next: Next
    Next: Next: Next: Next: Next: Next
End Sub

【讨论】：

它适用于受密码保护的工作表，而不是如果工作簿有密码可以打开它，因为在这种情况下您甚至无法添加 VBA 代码。

【参考方案3】：

您似乎正在尝试使用密码解锁工作簿以打开它？

您绝对不应该为此使用 Sendkeys。您应该只将 sendkeys 用作最后的手段。

为避免冲突，请将您的代码放在另一个工作簿中，而不是使用 sendkeys：

Workbooks.Open Filename:="C:\passtest.xls", Password:=password

如果工作簿已经打开并且工作簿受到保护或使用工作表或图表：

[object].Unprotect password

其中 [object] 是对您要取消保护的内容的引用。

如果您尝试解锁 vba 代码，请关注 JimmyPena 的评论

Here's a reference 用于使用与您的代码相似的代码来解锁活动工作表的人。

【讨论】：

嗨丹尼尔，非常感谢您的帮助，但我想您误解了我的问题，我需要破解 vba 项目文件的密码，而不是工作表的密码。而且我不知道我应该引用哪个对象来取消其密码保护。

【参考方案4】：

也许有帮助？

Option Explicit

Const PWDMaxLength = 9
Const MaxTimeInSeconds = 600    ' 10 Minutes
Const PWDWindowName = "Password"
Const TargetFile = "D:\Dropbox\Excel stuff\crack\test.xls"
Const LowerCase = "abcdefghijklmnopqrstuvwxyzæøå"
Const UpperCase = "ABCDEFGHIJKLMNOPQRSTUVWXYZÆØÅ"
Const SpesChars = "+-*@#%=?!_;./"
Const Digits = "0123456789"
Dim CrackAttempt As Long
Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long


Sub BFOpen()
On Error Resume Next
Application.DisplayAlerts = False
Workbooks.Open Filename:=TargetFile
Application.DisplayAlerts = True
On Error GoTo 0
End Sub


Sub BFCrack()
'On Error Resume Next
Dim lSta, lCur As Long, test, str, PWD As String
lSta = GetTickCount()
PWD = LowerCase & UpperCase & SpesChars & Digits
CrackAttempt = 1
test = InputBox("Insert test string for brutforce if wanted" & vbCrLf & "not more than 5 characters...", "input")
SendKeys "%TAB", 100
Do While str <> test Or FindWindow(vbNullString, PWDWindowName) And (Len(str) < PWDMaxLength <> 0 And (lCur / 1000) < MaxTimeInSeconds)
  lCur = (GetTickCount() - lSta)
  If lCur Mod 250 = 0 Then Application.StatusBar = str & " " & CrackAttempt & " " & lCur
  str = GBFS(PWD, CrackAttempt)
  If test = "" Then SendKeys str & "ENTER", 1000
  CrackAttempt = CrackAttempt + 1
Loop
Application.StatusBar = False
If str <> "" Then MsgBox str & " found in " & CStr((GetTickCount() - lSta) / 1000) & " seconds after " & CrackAttempt & " attempts", vbOKOnly + vbInformation, "Result"
On Error GoTo 0
End Sub


Function GBFS(ByVal inp As String, ByVal att As Long) As String
  Dim Base, cal As Integer, rmi, res As Long
  Base = Len(inp)
  If Base < 2 Then Exit Function
  rmi = att
  Do While rmi > 0
    res = Int(rmi / Base)
    cal = rmi - (res * Base)
    If cal = 0 Then
      cal = Base
      res = res - 1
    End If
    GBFS = Mid(inp, cal, 1) & GBFS
    rmi = res
  Loop
End Function