logo标签列表

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

excelvbapassword-recovery
5
我尝试编写一个类似于破解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
相关链接: https://dev59.com/LnNA5IYBdhLWcg3wSrqa - JimmyPena
嗨，Jimmy，感谢你的更新，但问题并不是使用VBScript，而是通过一些哈希码实现的。 - codeomnitrix
嗨@codeomnitrix，你能否分享一下你为什么只在前8层尝试A到B的想法？难道你不想在所有层上尝试所有可能的字符吗？ - lovechillcool
这是因为密码在内部被转换为一系列的A和B。无需循环遍历所有字符。 - codeomnitrix
4个回答
6
你的代码无法正常执行是因为你试图在一个密码保护的Excel文件上执行宏，这是不被允许的。这是因为宏在输入密码之前将不会在Excel工作簿上执行——因此需要在执行宏代码之前提示输入密码。
这篇SO文章也解释了这个问题，并提供了更详细的解释：Excel VBA - Automatically Input Password 编辑
对于2003年版本：
如果你正在尝试访问工作簿而不是工作表，那么在2003和更早版本中有多种方法可以使用。在快速浏览之后，这篇blogspot Code Samples的文章似乎有适用于解除2003工作簿保护的版本。
此外，在相关信息中，如果你退回到更早期并尝试解锁VBA项目，这篇SO文章似乎足以解决这个问题。
对于2007年版本：
如果你只是想“暴力”解除客户工作簿的保护，那么一位名叫Jason的先生在他的博客中概述了这样一个过程。
1
嗨，杰克，感谢您的回复，Excel文件并没有受到保护，而是其中的VBA项目受到了保护。我需要使用这个脚本来取消保护这个VBA项目。 - codeomnitrix
Codeomnitrix，感谢您的澄清。您想要打开哪个版本的Excel？在2003年有许多方法可以做到这一点；我在我的编辑答案中链接了一个解除2003年及更早版本工作表保护的教程。 - Scott Conover
此答案应进行编辑，因为只有这部分内容是相关的。另外，如果您想进一步解锁VBA项目，这篇SO文章似乎可以充分解决该问题。 - brettdj
@brettdj，您是要求删除除了斜体部分之外的所有帖子，还是删除斜体后面出现的所有材料？ - Scott Conover
3

我已经成功在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代码。 - dan
1

看起来你正在尝试使用密码解锁工作簿以打开它？

你绝对不应该使用Sendkeys来完成这个任务。你只应该在万不得已的情况下使用sendkeys。

为了避免冲突，将你的代码放在另一个工作簿中，而不是使用sendkeys，可以使用以下方法：

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

如果工作簿已经打开并且受到保护，或者其中包含工作表或图表，请使用：

[object].Unprotect password

[object]是你试图取消保护的引用。

如果您正在尝试解锁VBA代码，请按照JimmyPena的评论进行操作。

这里有一个参考链接，针对使用类似代码解锁活动工作表的人。

嗨，丹尼尔，非常感谢你的帮助，但我想你误解了我的问题，我需要破解VBA项目文件的密码，而不是表格的密码。我不知道应该引用哪个对象来取消保护密码。 - codeomnitrix
1
也许有一些帮助？
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
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接